t/10-base.t

   1 #!perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use blib 't/Sub-Op-Test';
   7
   8 use Test::More tests => 2 * 15 + 21;
   9
  10 our $called;
  11
  12 {
  13  local $/ = "####\n";
  14  while (<DATA>) {
  15   my ($code, $params)    = split /----\s*/, $_;
  16   my ($name, $ret, $exp) = split /\s*#\s*/, $params;
  17
  18   my @exp = eval $exp;
  19   if ($@) {
  20    fail "unable to get expected values: $@";
  21    next;
  22   }
  23   my $calls = @exp;
  24
  25   $code = <<"  WRAPPER";
  26   {
  27    use Sub::Op::Test $name => sub {
  28     ++\$called;
  29     my \$exp = shift \@exp;
  30     is_deeply \\\@_, \$exp, '$name: arguments are correct';
  31     $ret;
  32    };
  33    {
  34     $code
  35    }
  36    BEGIN {
  37     no warnings 'uninitialized'; # Test::Builder can't get the file name
  38     is *main::${name}{CODE}, undef, '$name: no symbol table vivification';
  39    }
  40   }
  41   WRAPPER
  42
  43   local $called = 0;
  44   eval $code;
  45   if ($@) {
  46    fail "$name: unable to evaluate test case: $@";
  47    diag $code;
  48   }
  49
  50   is $called, $calls, "$name: the hook was called the right number of times";
  51   if ($called < $calls) {
  52    fail for $called + 1 .. $calls;
  53   }
  54  }
  55 }
  56
  57 __DATA__
  58 foo();
  59 ----
  60 foo # () # [ ]
  61 ####
  62 bar;
  63 ----
  64 bar # () # [ ]
  65 ####
  66 baz(1);
  67 ----
  68 baz # () # [ 1 ]
  69 ####
  70 zap 2;
  71 ----
  72 zap # () # [ 2 ]
  73 ####
  74 package X;
  75 main::flap 7, 8;
  76 ----
  77 flap # () # [ 7, 8 ]
  78 ####
  79 wut; wut 1; wut 2, 3
  80 ----
  81 wut # () # [ ], [ 1 ], [ 2, 3 ]
  82 ####
  83 qux(qux(1));
  84 ----
  85 qux # @_ # [ 1 ], [ 1 ]
  86 ####
  87 wat 1, wat, 2, wat(3, 4), 5
  88 ----
  89 wat # @_ # [ ], [ 3, 4 ], [ 1, 2, 3, 4, 5 ]
  90 ####
  91 sum sum sum(1, 2), sum(3, 4)
  92 ----
  93 sum # do { my $s = 0; $s += $_ for @_; $s } # [ 1, 2 ], [ 3, 4 ], [ 3, 7 ], [ 10 ]
  94 ####
  95 return;
  96 my $x = \&func
  97 ----
  98 func # () # ()
  99 ####
 100 return;
 101 __PACKAGE__->meth
 102 ----
 103 meth # () # ()
 104 ####
 105 fetch 1, do { no strict 'refs'; *{__PACKAGE__.'::fetch'}{CODE} }, 2
 106 ----
 107 fetch # () # [ 1, undef, 2 ]
 108 ####
 109 our $scalr = 1;
 110 scalr $scalr;
 111 ----
 112 scalr # () # [ 1 ]
 113 ####
 114 our @array = (2, 3);
 115 array @array;
 116 ----
 117 array # () # [ 2, 3 ]
 118 ####
 119 our %hash = (x => 4);
 120 hash $hash{x};
 121 ----
 122 hash # () # [ 4 ]