From: Vincent Pit <vince@profvince.com>
Date: Thu, 2 Oct 2008 20:15:35 +0000 (+0200)
Subject: Test ampersand calls
X-Git-Tag: v0.04~3
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Fsubs-auto.git;a=commitdiff_plain;h=9225a4d4d98ce59fb492c93299851d7f7a738518

Test ampersand calls
---

diff --git a/t/10-base.t b/t/10-base.t
index 33c6fb2..bd1050e 100644
--- a/t/10-base.t
+++ b/t/10-base.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 67;
+use Test::More tests => 91;
 
 my %_re = (
  bareword => sub { qr/^Bareword\s+['"]?\s*$_[0]\s*['"]?\s+not\s+allowed\s+while\s+["']?\s*strict\s+subs\s*['"]?\s+in\s+use\s+at\s+$_[1]\s+line\s+$_[2]/ },
@@ -88,17 +88,50 @@ my %h = (
 my $foo;
 our @foo;
 
-my $y = eval { foo 1, 2, \%h };
+eval { foo 1, 2, \%h };
 _got_ok('compiling to foo(1,2,\\\%h)');
 is($foo, 15, 'foo really was executed');
 
+eval { foo(3, 4, \%h) };
+_got_ok('compiling to foo(3,4,\\\%h)');
+is($foo, 19, 'foo() really was executed');
+
+eval { local @_ = (5, 6, \%h); &foo };
+_got_ok('compiling to foo(5,6,\\\%h)');
+is($foo, 23, '&foo really was executed');
+
+eval { &foo(7, 8, \%h) };
+_got_ok('compiling to foo(7,8,\\\%h)');
+is($foo, 27, '&foo() really was executed');
+
 eval { wut 13, "what" };
 _got_ok('compiling to wut(13,"what")');
 is($wut, 17, 'wut really was executed');
 
+eval { wut(17, "what") };
+_got_ok('compiling to wut(17,"what")');
+is($wut, 21, 'wut() really was executed');
+
+eval { local @_ = (21, "what"); &wut };
+_got_ok('compiling to wut(21,"what")');
+is($wut, 25, '&wut really was executed');
+
+eval { &wut(25, "what") };
+_got_ok('compiling to wut(25,"what")');
+is($wut, 29, '&wut() really was executed');
+
 eval { qux };
 _got_undefined('qux', __LINE__-1);
 
+eval { qux() };
+_got_undefined('qux', __LINE__-1);
+
+eval { &qux };
+_got_undefined('qux', __LINE__-1);
+
+eval { &qux() };
+_got_undefined('qux', __LINE__-1);
+
 {
  no strict 'refs';
  is(*{'::feh'}{CODE}, undef, 'feh isn\'t defined');
@@ -261,9 +294,30 @@ eval { foo 7, 9, { } };
 _got_ok('compiling to foo(7,9,{})');
 is($foo, 16, 'foo really was executed');
 
+eval { foo(8, 10, { }) };
+_got_ok('compiling to foo(8,10,{})');
+is($foo, 18, 'foo() really was executed');
+
+eval { local @_ = (9, 11, { }); &foo };
+_got_ok('compiling to foo(9,11,{})');
+is($foo, 20, '&foo really was executed');
+
+eval { &foo(10, 12, { }) };
+_got_ok('compiling to foo(10,12,{})');
+is($foo, 22, '&foo() really was executed');
+
 eval { blech };
 _got_undefined('blech', __LINE__-1);
 
+eval { blech() };
+_got_undefined('blech', __LINE__-1);
+
+eval { &blech };
+_got_undefined('blech', __LINE__-1);
+
+eval { &blech() };
+_got_undefined('blech', __LINE__-1);
+
 ok(-f $0 && -r _, '-X _');
 
 __DATA__
diff --git a/t/12-proto.t b/t/12-proto.t
index db7b135..10c59bb 100644
--- a/t/12-proto.t
+++ b/t/12-proto.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 7;
+use Test::More tests => 11;
 
 my $foo;
 sub foo ($) { $foo = $_[0] };
@@ -21,6 +21,10 @@ eval { my @x = (1, 5); foo @x };
 is($@, '', 'foo was compiled ok');
 is($foo, 2, 'foo was called with the right arguments');
 
+eval { my @x = (1, 5); &foo(@x) };
+is($@, '', '&foo was compiled ok');
+is($foo, 1, '&foo was called with the right arguments');
+
 my $bar;
 sub bar (\@) { $bar = 0; $bar += $_ for grep defined, @{$_[0]}  }
 
@@ -28,6 +32,10 @@ eval { my @x = (2, 3, 4); bar @x };
 is($@, '', 'bar was compiled ok');
 is($bar, 9, 'bar was called with the right arguments');
 
+eval { my @x = ([2, 3], 4); &bar(@x) };
+is($@, '', '&bar was compiled ok');
+is($bar, 5, '&bar was called with the right arguments');
+
 eval { baz 5 };
 like($@, qr/^Undefined\s+subroutine\s+&?main::baz/,'baz couldn\'t be compiled');
 is($baz, undef, 'baz can\'t be called because of the prototype mismatch');