X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2F11-existing.t;h=13d60530ea1cfd4972b8871cf1fdd2e836227e99;hb=0eb003f3bbeeada878cab10f7dabc020c775b666;hp=c45a71b464ca7e9dabd24ff59271964f4bb48094;hpb=ed2a5a35c26bfa677e6d2bc5586068b9a28735dc;p=perl%2Fmodules%2FSub-Op.git diff --git a/t/11-existing.t b/t/11-existing.t index c45a71b..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,6 +13,14 @@ 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; { @@ -42,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 { @@ -57,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; @@ -72,8 +89,26 @@ our $called; } } +{ + 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(); @@ -161,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 ]