X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2F11-existing.t;h=13d60530ea1cfd4972b8871cf1fdd2e836227e99;hb=0eb003f3bbeeada878cab10f7dabc020c775b666;hp=0339bc850b391436f5fe1d7beb6bf97071f58562;hpb=5ae3324ff295015e051249ded13b2353ee8af258;p=perl%2Fmodules%2FSub-Op.git diff --git a/t/11-existing.t b/t/11-existing.t index 0339bc8..13d6053 100644 --- a/t/11-existing.t +++ b/t/11-existing.t @@ -5,7 +5,7 @@ use warnings; use blib 't/Sub-Op-LexicalSub'; -use Test::More tests => 2 *((4 + 2 * 4) + (2 * 5) + 1); +use Test::More tests => 2 * ((2 + 2) * 4 + (1 + 2) * 5) + 2 * (2 + 2) + 4 + 4; our $call_foo; sub foo { ok $call_foo, 'the preexistent foo was called' } @@ -13,11 +13,22 @@ 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 $call_blech; +sub blech { ok $call_blech, 'initial blech was called' }; + +our $wat_args; +sub wat { is_deeply \@_, $wat_args, 'wat was called with the right arguments' } + our $called; { local $/ = "####\n"; while () { + chomp; + s/\s*$//; + my ($code, $params) = split /----\s*/, $_; my ($names, $ret, $exp, $seq) = split /\s*#\s*/, $params; @@ -39,7 +50,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 { @@ -54,6 +65,15 @@ our $called; } $test .= "{\n$code\n}\n"; $test .= "}\n"; + for my $name (grep +{ map +($_, 1), qw/foo bar blech/ }->{ $_ }, @names) { + $test .= <<" CHECK_SUB" + { + local \$call_$name = 1; + $name(); + } + CHECK_SUB + } + $test .= "}\n"; local $called = 0; eval $test; @@ -64,13 +84,31 @@ 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; } } } +{ + eval <<' TEST'; + use Sub::Op::LexicalSub what => \&wat; + local $wat_args = [ 1 ]; + what 1; + local $wat_args = [ 2, 3 ]; + what 2, 3; + local $wat_args = [ 4, 5 ]; + sub { + what $_[0], 5; + }->(4); + TEST + is $@, '', 'what: no errors'; +} + 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(); @@ -158,3 +196,15 @@ my $bar = \&bar; &$bar; ---- bar # () # +#### +is X, 2, 'constant overriding'; +---- +X # 2 # [ ] +#### +no warnings 'redefine'; +sub blech { fail 'redefined blech was called' } +BEGIN { $call_blech = 0 } +blech 7; +BEGIN { $call_blech = 1 } +---- +blech # () # [ 7 ]