X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2F10-base.t;h=a69a7ae1761542a23ec3df3654c6cb7fa91c79f1;hb=0eb003f3bbeeada878cab10f7dabc020c775b666;hp=86042b35120bd42d58cf9455291c36a836987844;hpb=a4ea0141e593c7b7afc86b15fb96d7f0ec5ab38a;p=perl%2Fmodules%2FSub-Op.git

diff --git a/t/10-base.t b/t/10-base.t
index 86042b3..a69a7ae 100644
--- a/t/10-base.t
+++ b/t/10-base.t
@@ -3,53 +3,75 @@
 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;
   }
  }
 }
@@ -106,6 +128,16 @@ fetch 1, do { no strict 'refs'; *{__PACKAGE__.'::fetch'}{CODE} }, 2
 ----
 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;
 ----
@@ -120,3 +152,18 @@ our %hash = (x => 4);
 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 ]