X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2F11-existing.t;h=2e6c6ca11a424a372f23e54c249e309926e70ad0;hb=3571f5a5bbffc758bbb91793ae256609d71945fc;hp=58e23a0a9c02e028f674db046f968171984c5b26;hpb=14a44e7b2f834cbd0d2ba8cc63deda55b3e5f0dd;p=perl%2Fmodules%2FSub-Op.git diff --git a/t/11-existing.t b/t/11-existing.t index 58e23a0..2e6c6ca 100644 --- a/t/11-existing.t +++ b/t/11-existing.t @@ -5,16 +5,24 @@ use warnings; use blib 't/Sub-Op-LexicalSub'; -use Test::More tests => (4 + 2 * 4) + (2 * 5); +use Test::More tests => 2 * ((2 + 2) * 4 + (1 + 2) * 5) + (2 + 2) + 4; our $call_foo; sub foo { ok $call_foo, 'the preexistent foo was called' } +our $call_bar; +sub bar () { ok $call_bar, 'the preexistent bar was called' } + +sub X () { 1 } + our $called; { local $/ = "####\n"; while () { + chomp; + s/\s*$//; + my ($code, $params) = split /----\s*/, $_; my ($names, $ret, $exp, $seq) = split /\s*#\s*/, $params; @@ -36,7 +44,7 @@ our $called; @seq = ($names[0]) x $calls; } - my $test = "{\n"; + my $test = "{\n{\n"; for my $name (@names) { $test .= <<" INIT" use Sub::Op::LexicalSub $name => sub { @@ -51,6 +59,15 @@ our $called; } $test .= "{\n$code\n}\n"; $test .= "}\n"; + for my $name (grep +{ map +($_, 1), qw/foo bar/ }->{ $_ }, @names) { + $test .= <<" CHECK_SUB" + { + local \$call_$name = 1; + $name(); + } + CHECK_SUB + } + $test .= "}\n"; local $called = 0; eval $test; @@ -61,11 +78,17 @@ our $called; is $called, $calls, "@names: the hook was called the right number of times"; if ($called < $calls) { - fail for $called + 1 .. $calls; + fail, fail for $called + 1 .. $calls; } } } +is prototype('main::foo'), undef, "foo's prototype was preserved"; +is prototype('main::bar'), '', "bar's prototype was preserved"; +is prototype('main::X'), '', "X's prototype was preserved"; +ok Sub::Op::_constant_sub(do { no strict "refs"; \&{"main::X"} }), + 'X is still a constant'; + __DATA__ foo(); ---- @@ -109,3 +132,50 @@ my $foo = \&foo; &$foo; ---- foo # () # +#### +bar(); +---- +bar # () # [ ] +#### +bar; +---- +bar # () # [ ] +#### +bar(1); +---- +bar # () # [ 1 ] +#### +bar 2; +---- +bar # () # [ 2 ] +#### +local $call_bar = 1; +&bar(); +---- +bar # () # +#### +local $call_bar = 1; +&bar; +---- +bar # () # +#### +local $call_bar = 1; +&bar(3); +---- +bar # () # +#### +local $call_bar = 1; +my $bar = \&bar; +$bar->(); +---- +bar # () # +#### +local $call_bar = 1; +my $bar = \&bar; +&$bar; +---- +bar # () # +#### +is X, 2, 'constant overriding'; +---- +X # 2 # [ ]