use strict;
use warnings;
-use blib 't/Sub-Op-Test';
+use blib 't/Sub-Op-LexicalSub';
-use Test::More tests => 2 * 15 + 21;
+use Test::More tests => (1 + 3) * 17 + (1 + 2 * 3) * 2 + 2 * 31;
our $called;
{
local $/ = "####\n";
while (<DATA>) {
- my ($code, $params) = split /----\s*/, $_;
- my ($name, $ret, $exp) = split /\s*#\s*/, $params;
+ chomp;
+ s/\s*$//;
+
+ my ($code, $params) = split /----\s*/, $_;
+ my ($names, $ret, $exp, $seq) = split /\s*#\s*/, $params;
+
+ my @names = split /\s*,\s*/, $names;
my @exp = eval $exp;
if ($@) {
- fail "unable to get expected values: $@";
+ fail "@names: unable to get expected values: $@";
next;
}
my $calls = @exp;
- $code = <<" WRAPPER";
- {
- use Sub::Op::Test $name => sub {
- ++\$called;
- my \$exp = shift \@exp;
- is_deeply \\\@_, \$exp, '$name: arguments are correct';
- $ret;
- };
- {
- $code
- }
- BEGIN {
- no warnings 'uninitialized'; # Test::Builder can't get the file name
- is *main::${name}{CODE}, undef, '$name: no symbol table vivification';
- }
+ 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;
}
- WRAPPER
+
+ my $test = "{\n";
+ for my $name (@names) {
+ $test .= <<" INIT"
+ use Sub::Op::LexicalSub $name => sub {
+ ++\$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 $code;
+ eval $test;
if ($@) {
- fail "$name: unable to evaluate test case: $@";
- diag $code;
+ fail "@names: unable to evaluate test case: $@";
+ diag $test;
}
- is $called, $calls, "$name: the hook was called the right number of times";
+ 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;
}
}
}
----
fetch # () # [ 1, undef, 2 ]
####
+my ($cb, $err);
+BEGIN {
+ $cb = do { no strict 'refs'; \&{__PACKAGE__.'::cvref'} };
+ eval { $cb->() };
+ $err = $@ =~ /^Undefined subroutine &main::cvref/ ? undef : $@;
+}
+cvref $err;
+----
+cvref # () # [ undef ]
+####
our $scalr = 1;
scalr $scalr;
----
hash $hash{x};
----
hash # () # [ 4 ]
+####
+foo 1;
+bar 2;
+----
+foo, bar # () # [ 1 ], [ 2 ] # foo, bar
+####
+foo 1, foo(2), 3, bar(4, foo(bar, 5), 6);
+----
+foo, bar # @_ # [ 2 ], [ ], [ 5 ], [ 4, 5, 6 ], [ 1, 2, 3, 4, 5, 6 ] # foo, bar, foo, bar, foo
+####
+foo 0, sub {
+ foo $_[0], 2, $_[1]
+}->(1, 3), 4;
+----
+foo # @_ # [ 1, 2, 3 ], [ 0, 1, 2, 3, 4 ]