use blib 't/Sub-Op-Test';
-use Test::More tests => 2 * 15 + 21;
+use Test::More tests => 2 * 15 + 3 * 1 + 2 * 23;
our $called;
{
local $/ = "####\n";
while (<DATA>) {
- my ($code, $params) = split /----\s*/, $_;
- my ($name, $ret, $exp) = split /\s*#\s*/, $params;
+ 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;
+ }
+
+ my $test = "{\n";
+ for my $name (@names) {
+ $test .= <<" INIT"
+ use Sub::Op::Test $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
}
- WRAPPER
+ $test .= "{\n$code\n}\n";
+ for my $name (@names) {
+ $test .= <<" CHECK_VIVID"
+ BEGIN {
+ no warnings 'uninitialized'; # Test::Builder can't get the file name
+ is *main::${name}\{CODE\}, undef, '$name: no symbol table vivification';
+ }
+ 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;
}
hash $hash{x};
----
hash # () # [ 4 ]
+####
+foo 1;
+bar 2;
+----
+foo, bar # () # [ 1 ], [ 2 ] # foo, bar