6 use blib 't/Sub-Op-LexicalSub';
8 use Test::More tests => 2 * 15 + 3 * 2 + 2 * 28;
15 my ($code, $params) = split /----\s*/, $_;
16 my ($names, $ret, $exp, $seq) = split /\s*#\s*/, $params;
18 my @names = split /\s*,\s*/, $names;
22 fail "@names: unable to get expected values: $@";
29 s/^\s*//, s/\s*$// for $seq;
30 @seq = split /\s*,\s*/, $seq;
31 die "calls and seq length mismatch" unless @seq == $calls;
33 @seq = ($names[0]) x $calls;
37 for my $name (@names) {
39 use Sub::Op::LexicalSub $name => sub {
41 my \$exp = shift \@exp;
42 is_deeply \\\@_, \$exp, '$name: arguments are correct';
43 my \$seq = shift \@seq;
44 is \$seq, '$name', '$name: sequence is correct';
49 $test .= "{\n$code\n}\n";
50 for my $name (@names) {
51 $test .= <<" CHECK_VIVID"
53 no warnings 'uninitialized'; # Test::Builder can't get the file name
54 is *main::${name}\{CODE\}, undef, '$name: no symbol table vivification';
63 fail "@names: unable to evaluate test case: $@";
67 is $called, $calls, "@names: the hook was called the right number of times";
68 if ($called < $calls) {
69 fail for $called + 1 .. $calls;
98 wut # () # [ ], [ 1 ], [ 2, 3 ]
102 qux # @_ # [ 1 ], [ 1 ]
104 wat 1, wat, 2, wat(3, 4), 5
106 wat # @_ # [ ], [ 3, 4 ], [ 1, 2, 3, 4, 5 ]
108 sum sum sum(1, 2), sum(3, 4)
110 sum # do { my $s = 0; $s += $_ for @_; $s } # [ 1, 2 ], [ 3, 4 ], [ 3, 7 ], [ 10 ]
122 fetch 1, do { no strict 'refs'; *{__PACKAGE__.'::fetch'}{CODE} }, 2
124 fetch # () # [ 1, undef, 2 ]
134 array # () # [ 2, 3 ]
136 our %hash = (x => 4);
144 foo, bar # () # [ 1 ], [ 2 ] # foo, bar
146 foo 1, foo(2), 3, bar(4, foo(bar, 5), 6);
148 foo, bar # @_ # [ 2 ], [ ], [ 5 ], [ 4, 5, 6 ], [ 1, 2, 3, 4, 5, 6 ] # foo, bar, foo, bar, foo