From: Vincent Pit Date: Sat, 4 Oct 2008 12:02:05 +0000 (+0200) Subject: Test 'package A; sub foo; foo A->new' that gets deparsed as 'A->foo->new' X-Git-Tag: v0.06~2 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=f4e7787d7c015980abba9a8d76f0293f24e0ab94;p=perl%2Fmodules%2Findirect.git Test 'package A; sub foo; foo A->new' that gets deparsed as 'A->foo->new' --- diff --git a/MANIFEST b/MANIFEST index bf71375..80a5874 100644 --- a/MANIFEST +++ b/MANIFEST @@ -9,6 +9,7 @@ t/00-load.t t/10-good.t t/20-bad.t t/21-bad-fatal.t +t/22-bad-mixed.t t/30-scope.t t/90-boilerplate.t t/91-pod.t diff --git a/t/10-good.t b/t/10-good.t index b88d721..0132f45 100644 --- a/t/10-good.t +++ b/t/10-good.t @@ -1,9 +1,15 @@ #!perl -T +package Dongs; + +sub new; + +package main; + use strict; use warnings; -use Test::More tests => 36 * 2; +use Test::More tests => 36 * 4; my ($obj, $pkg, $cb, $x); sub meh; @@ -12,18 +18,28 @@ sub meh; local $/ = "####\n"; while () { chomp; + local $SIG{__WARN__} = sub { die 'warn:' . join(' ', @_) }; { use indirect; - local $SIG{__WARN__} = sub { die 'warn:' . join(' ', @_) }; eval "die qq{ok\\n}; $_"; } - is($@, "ok\n", $_); + is($@, "ok\n", "use indirect: $_"); { no indirect; - local $SIG{__WARN__} = sub { die 'warn:' . join(' ', @_) }; eval "die qq{ok\n}; $_"; } - is($@, "ok\n", $_); + is($@, "ok\n", "no indirect: $_"); + s/Hlagh/Dongs/g; + { + use indirect; + eval "die qq{ok\\n}; $_"; + } + is($@, "ok\n", "use indirect, defined: $_"); + { + no indirect; + eval "die qq{ok\\n}; $_"; + } + is($@, "ok\n", "no indirect, defined: $_"); } } diff --git a/t/20-bad.t b/t/20-bad.t index 5c57ebe..0a61cd1 100644 --- a/t/20-bad.t +++ b/t/20-bad.t @@ -1,9 +1,15 @@ #!perl -T +package Dongs; + +sub new; + +package main; + use strict; use warnings; -use Test::More tests => 30 * 2 + 2; +use Test::More tests => 33 * 4 + 2; my ($obj, $x); @@ -11,18 +17,28 @@ my ($obj, $x); local $/ = "####\n"; while () { chomp; + local $SIG{__WARN__} = sub { die 'warn:' . join(' ', @_) }; + { + use indirect; + eval "die qq{ok\\n}; $_"; + } + is($@, "ok\n", "use indirect: $_"); + { + no indirect; + eval "die qq{the code compiled but it shouldn't have\n}; $_"; + } + like($@, qr/^warn:Indirect\s+call\s+of\s+method\s+"(?:new|meh|HlaghHlagh)"\s+on\s+object\s+"(?:Hlagh|newnew|\$x|\$_)"/, "no indirect: $_"); + s/Hlagh/Dongs/g; { use indirect; - local $SIG{__WARN__} = sub { die 'warn:' . join(' ', @_) }; eval "die qq{ok\\n}; $_"; } - is($@, "ok\n", $_); + is($@, "ok\n", "use indirect, defined: $_"); { no indirect; - local $SIG{__WARN__} = sub { die 'warn:' . join(' ', @_) }; eval "die qq{the code compiled but it shouldn't have\n}; $_"; } - like($@, qr/^warn:Indirect\s+call\s+of\s+method\s+"(?:new|meh|HlaghHlagh)"\s+on\s+object\s+"(?:Hlagh|newnew|\$x|\$_)"/, $_); + like($@, qr/^warn:Indirect\s+call\s+of\s+method\s+"(?:new|meh|DongsDongs)"\s+on\s+object\s+"(?:Dongs|newnew|\$x|\$_)"/, "no indirect, defined: $_"); } } @@ -98,6 +114,12 @@ meh $x; #### meh $x, 1, 2; #### +new Hlagh->wut; +#### +new Hlagh->wut(); +#### +new Hlagh->wut, "Wut"; +#### $obj = HlaghHlagh Hlagh; #### $obj = HlaghHlagh Hlagh; # HlaghHlagh Hlagh diff --git a/t/22-bad-mixed.t b/t/22-bad-mixed.t new file mode 100644 index 0000000..bbc2f23 --- /dev/null +++ b/t/22-bad-mixed.t @@ -0,0 +1,50 @@ +#!perl -T + +package Dongs; + +sub new; + +package main; + +use strict; +use warnings; + +use Test::More tests => 3 * 4; + +sub meh; + +{ + local $/ = "####\n"; + while () { + chomp; + local $SIG{__WARN__} = sub { die 'warn:' . join(' ', @_) }; + { + use indirect; + eval "die qq{ok\\n}; $_"; + } + is($@, "ok\n", "use indirect: $_"); + { + no indirect; + eval "die qq{ok\n}; $_"; + } + is($@, "ok\n", "no indirect: $_"); + s/Hlagh/Dongs/g; + { + use indirect; + eval "die qq{ok\\n}; $_"; + } + is($@, "ok\n", "use indirect, defined: $_"); + { + no indirect; + eval "die qq{the code compiled but it shouldn't have\n}; $_"; + } + like($@, qr/^warn:Indirect\s+call\s+of\s+method\s+"meh"\s+on\s+object\s+"Dongs"/, "no indirect, defined: $_"); + } +} + +__DATA__ +meh Hlagh->new; +#### +meh Hlagh->new(); +#### +meh Hlagh->new, "Wut";