X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2F11-existing.t;h=13d60530ea1cfd4972b8871cf1fdd2e836227e99;hb=0eb003f3bbeeada878cab10f7dabc020c775b666;hp=fae36fc9bd755120e555ad6f5dd20dd0799560e3;hpb=c8f39d20852c85f99aabd8c3df4fb354678c8e99;p=perl%2Fmodules%2FSub-Op.git

diff --git a/t/11-existing.t b/t/11-existing.t
index fae36fc..13d6053 100644
--- a/t/11-existing.t
+++ b/t/11-existing.t
@@ -3,18 +3,32 @@
 use strict;
 use warnings;
 
-use blib 't/Sub-Op-Test';
+use blib 't/Sub-Op-LexicalSub';
 
-use Test::More tests => (4 + 2 * 4) + (2 * 5);
+use Test::More tests => 2 * ((2 + 2) * 4 + (1 + 2) * 5) + 2 * (2 + 2) + 4 + 4;
 
 our $call_foo;
 sub foo { ok $call_foo, 'the preexistent foo was called' }
 
+our $call_bar;
+sub bar () { ok $call_bar, 'the preexistent bar was called' }
+
+sub X () { 1 }
+
+our $call_blech;
+sub blech { ok $call_blech, 'initial blech was called' };
+
+our $wat_args;
+sub wat { is_deeply \@_, $wat_args, 'wat was called with the right arguments' }
+
 our $called;
 
 {
  local $/ = "####\n";
  while (<DATA>) {
+  chomp;
+  s/\s*$//;
+
   my ($code, $params)           = split /----\s*/, $_;
   my ($names, $ret, $exp, $seq) = split /\s*#\s*/, $params;
 
@@ -36,10 +50,10 @@ our $called;
    @seq = ($names[0]) x $calls;
   }
 
-  my $test = "{\n";
+  my $test = "{\n{\n";
   for my $name (@names) {
    $test .= <<"   INIT"
-    use Sub::Op::Test $name => sub {
+    use Sub::Op::LexicalSub $name => sub {
      ++\$called;
      my \$exp = shift \@exp;
      is_deeply \\\@_, \$exp,   '$name: arguments are correct';
@@ -51,6 +65,15 @@ our $called;
   }
   $test .= "{\n$code\n}\n";
   $test .= "}\n";
+  for my $name (grep +{ map +($_, 1), qw/foo bar blech/ }->{ $_ }, @names) {
+   $test .= <<"   CHECK_SUB"
+    {
+     local \$call_$name = 1;
+     $name();
+    }
+   CHECK_SUB
+  }
+  $test .= "}\n";
 
   local $called = 0;
   eval $test;
@@ -61,11 +84,32 @@ our $called;
 
   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;
   }
  }
 }
 
+{
+ eval <<' TEST';
+  use Sub::Op::LexicalSub what => \&wat;
+  local $wat_args = [ 1 ];
+  what 1;
+  local $wat_args = [ 2, 3 ];
+  what 2, 3;
+  local $wat_args = [ 4, 5 ];
+  sub {
+   what $_[0], 5;
+  }->(4);
+ TEST
+ is $@, '', 'what: no errors';
+}
+
+is prototype('main::foo'), undef, "foo's prototype was preserved";
+is prototype('main::bar'), '',    "bar's prototype was preserved";
+is prototype('main::X'),   '',    "X's prototype was preserved";
+ok Sub::Op::_constant_sub(do { no strict "refs"; \&{"main::X"} }),
+                                  'X is still a constant';
+
 __DATA__
 foo();
 ----
@@ -109,3 +153,58 @@ my $foo = \&foo;
 &$foo;
 ----
 foo # () #
+####
+bar();
+----
+bar # () # [ ]
+####
+bar;
+----
+bar # () # [ ]
+####
+bar(1);
+----
+bar # () # [ 1 ]
+####
+bar 2;
+----
+bar # () # [ 2 ]
+####
+local $call_bar = 1;
+&bar();
+----
+bar # () #
+####
+local $call_bar = 1;
+&bar;
+----
+bar # () #
+####
+local $call_bar = 1;
+&bar(3);
+----
+bar # () #
+####
+local $call_bar = 1;
+my $bar = \&bar;
+$bar->();
+----
+bar # () #
+####
+local $call_bar = 1;
+my $bar = \&bar;
+&$bar;
+----
+bar # () #
+####
+is X, 2, 'constant overriding';
+----
+X # 2 # [ ]
+####
+no warnings 'redefine';
+sub blech { fail 'redefined blech was called' }
+BEGIN { $call_blech = 0 }
+blech 7;
+BEGIN { $call_blech = 1 }
+----
+blech # () # [ 7 ]