From: Vincent Pit <vince@profvince.com>
Date: Sat, 2 Jan 2010 14:15:46 +0000 (+0100)
Subject: Test replacing an existing sub
X-Git-Tag: v0.01~9
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FSub-Op.git;a=commitdiff_plain;h=c8f39d20852c85f99aabd8c3df4fb354678c8e99

Test replacing an existing sub
---

diff --git a/MANIFEST b/MANIFEST
index 8f9a604..09fa5ce 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -10,6 +10,7 @@ ptable.h
 sub_op.h
 samples/try.pl
 t/10-base.t
+t/11-existing.t
 t/Sub-Op-Test/Makefile.PL
 t/Sub-Op-Test/Test.xs
 t/Sub-Op-Test/lib/Sub/Op/Test.pm
diff --git a/t/11-existing.t b/t/11-existing.t
new file mode 100644
index 0000000..fae36fc
--- /dev/null
+++ b/t/11-existing.t
@@ -0,0 +1,111 @@
+#!perl
+
+use strict;
+use warnings;
+
+use blib 't/Sub-Op-Test';
+
+use Test::More tests => (4 + 2 * 4) + (2 * 5);
+
+our $call_foo;
+sub foo { ok $call_foo, 'the preexistent foo was called' }
+
+our $called;
+
+{
+ local $/ = "####\n";
+ while (<DATA>) {
+  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 "@names: unable to get expected values: $@";
+   next;
+  }
+  my $calls = @exp;
+
+  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
+  }
+  $test .= "{\n$code\n}\n";
+  $test .= "}\n";
+
+  local $called = 0;
+  eval $test;
+  if ($@) {
+   fail "@names: unable to evaluate test case: $@";
+   diag $test;
+  }
+
+  is $called, $calls, "@names: the hook was called the right number of times";
+  if ($called < $calls) {
+   fail for $called + 1 .. $calls;
+  }
+ }
+}
+
+__DATA__
+foo();
+----
+foo # () # [ ]
+####
+foo;
+----
+foo # () # [ ]
+####
+foo(1);
+----
+foo # () # [ 1 ]
+####
+foo 2;
+----
+foo # () # [ 2 ]
+####
+local $call_foo = 1;
+&foo();
+----
+foo # () #
+####
+local $call_foo = 1;
+&foo;
+----
+foo # () #
+####
+local $call_foo = 1;
+&foo(3);
+----
+foo # () #
+####
+local $call_foo = 1;
+my $foo = \&foo;
+$foo->();
+----
+foo # () #
+####
+local $call_foo = 1;
+my $foo = \&foo;
+&$foo;
+----
+foo # () #