+#!perl
+
+use 5.010;
+
+use strict;
+use warnings;
+
+use blib 't/Sub-Op-LexicalSub';
+
+use Test::More tests => 1 * 11 + 3 * 12 + 2 * 18 + 4;
+
+my @array = (1 .. 4);
+my %hash = (a => 'b');
+
+our $called;
+
+{
+ local $/ = "####\n";
+ while (<DATA>) {
+ chomp;
+ s/\s*$//;
+
+ my ($code, $params) = split /----\s*/, $_;
+ my ($names, $ret, $exp, $seq) = split /\s*#\s*/, $params;
+
+ my @names = split /\s*,\s*/, $names;
+ my @protos;
+ for my $i (0 .. $#names) {
+ my $name = $names[$i];
+ if ($name =~ /^\s*([^\s\(]+)\s*(\([^\)]*\))\s*$/) {
+ $names[$i] = $1;
+ $protos[$i] = $2;
+ }
+ }
+
+ my @exp = eval $exp;
+ if ($@) {
+ fail "@names: unable to get expected values: $@";
+ next;
+ }
+ my $calls = @exp;
+
+ my @seq;
+ if ($seq) {
+ s/^\s*//, s/\s*$// for $seq;
+ @seq = split /\s*,\s*/, $seq;
+ die "calls and seq length mismatch" unless @seq == $calls;
+ } else {
+ @seq = ($names[0]) x $calls;
+ }
+
+ my $test = "{\n";
+ for my $i (0 .. $#names) {
+ my $name = $names[$i];
+ my $proto = $protos[$i] // '';
+ $test .= <<" INIT"
+ use Sub::Op::LexicalSub $name => sub $proto {
+ ++\$called;
+ my \$exp = shift \@exp;
+ is_deeply \\\@_, \$exp, '$name: arguments are correct';
+ my \$seq = shift \@seq;
+ is \$seq, '$name', '$name: sequence is correct';
+ $ret;
+ };
+ INIT
+ }
+ $test .= "{\n$code\n}\n";
+ for my $name (@names) {
+ $test .= <<" CHECK_VIVID"
+ BEGIN {
+ no warnings 'uninitialized'; # Test::Builder can't get the file name
+ ok !exists &main::${name}, '$name: not stubbed';
+ ok !defined &main::${name}, '$name: body not defined';
+ is *main::${name}\{CODE\}, undef, '$name: empty symbol table entry';
+ }
+ CHECK_VIVID
+ }
+ $test .= "}\n";
+
+ local $called = 0;
+ eval $test;
+ if ($@) {
+ fail "@names: unable to evaluate test case: $@";
+ diag $test;
+ }
+
+ is $called, $calls, "@names: the hook was called the right number of times";
+ if ($called < $calls) {
+ fail, fail for $called + 1 .. $calls;
+ }
+ }
+}
+
+{
+ eval <<' TEST';
+ use Sub::Op::LexicalSub foo => sub (&) { $_[0]->() };
+ foo { pass 'block called'; };
+ TEST
+ fail $@ if $@;
+}
+
+{
+ eval <<' TEST';
+ use Sub::Op::LexicalSub foo => sub (&@) { my $cb = shift; goto &$cb };
+ foo { is_deeply \@_, [ ], 'block called without arguments' };
+ foo { is_deeply \@_, [ 1 ], 'block called without 1 argument' } 1;
+ foo { is_deeply \@_, [ 2, 3 ], 'block called without 2 argument' } 2, 3;
+ TEST
+ fail $@ if $@;
+}
+
+__DATA__
+foo();
+----
+foo() # () # [ ]
+####
+foo;
+----
+foo() # () # [ ]
+####
+foo(1);
+----
+foo($) # () # [ 1 ]
+####
+foo 2;
+----
+foo($) # () # [ 2 ]
+####
+my @stuff = (foo 3, 4);
+----
+foo($) # () # [ 3 ]
+####
+foo @array;
+----
+foo($) # () # [ scalar @array ]
+####
+my @stuff = (foo 5, 6);
+bar 7, 8;
+@stuff = (foo 9, 10);
+----
+foo($), bar($$) # () # [ 5 ], [ 7, 8 ], [ 9 ] # foo, bar, foo
+####
+foo @array;
+----
+foo(\@) # () # [ \@array ]
+####
+foo @array;
+foo %hash;
+----
+foo(\[@%]) # () # [ \@array ], [ \%hash ]
+####
+foo @array, 13;
+foo %hash, 14;
+----
+foo(\[@%]$) # () # [ \@array, 13 ], [ \%hash, 14 ]
+####
+foo @array;
+foo @array, 15;
+foo %hash;
+foo %hash, 16;
+----
+foo(\[@%];$) # () # [ \@array ], [ \@array, 15 ], [ \%hash ], [ \%hash, 16 ]