6 use blib 't/Sub-Op-LexicalSub';
8 use Test::More tests => 2 * ((2 + 2) * 4 + (1 + 2) * 5) + 2 * (2 + 2) + 4;
11 sub foo { ok $call_foo, 'the preexistent foo was called' }
14 sub bar () { ok $call_bar, 'the preexistent bar was called' }
19 sub blech { ok $call_blech, 'initial blech was called' };
29 my ($code, $params) = split /----\s*/, $_;
30 my ($names, $ret, $exp, $seq) = split /\s*#\s*/, $params;
32 my @names = split /\s*,\s*/, $names;
36 fail "@names: unable to get expected values: $@";
43 s/^\s*//, s/\s*$// for $seq;
44 @seq = split /\s*,\s*/, $seq;
45 die "calls and seq length mismatch" unless @seq == $calls;
47 @seq = ($names[0]) x $calls;
51 for my $name (@names) {
53 use Sub::Op::LexicalSub $name => sub {
55 my \$exp = shift \@exp;
56 is_deeply \\\@_, \$exp, '$name: arguments are correct';
57 my \$seq = shift \@seq;
58 is \$seq, '$name', '$name: sequence is correct';
63 $test .= "{\n$code\n}\n";
65 for my $name (grep +{ map +($_, 1), qw/foo bar blech/ }->{ $_ }, @names) {
66 $test .= <<" CHECK_SUB"
68 local \$call_$name = 1;
78 fail "@names: unable to evaluate test case: $@";
82 is $called, $calls, "@names: the hook was called the right number of times";
83 if ($called < $calls) {
84 fail, fail for $called + 1 .. $calls;
89 is prototype('main::foo'), undef, "foo's prototype was preserved";
90 is prototype('main::bar'), '', "bar's prototype was preserved";
91 is prototype('main::X'), '', "X's prototype was preserved";
92 ok Sub::Op::_constant_sub(do { no strict "refs"; \&{"main::X"} }),
93 'X is still a constant';
182 is X, 2, 'constant overriding';
186 no warnings 'redefine';
187 sub blech { fail 'redefined blech was called' }
188 BEGIN { $call_blech = 0 }
190 BEGIN { $call_blech = 1 }