]> git.vpit.fr Git - perl/modules/subs-auto.git/blob - t/12-proto.t
Switch to qw<>
[perl/modules/subs-auto.git] / t / 12-proto.t
1 #!perl -T
2
3 use strict;
4 use warnings;
5
6 use Test::More tests => 11;
7
8 my $foo;
9 sub foo ($) { $foo = $_[0] };
10
11 my $baz;
12 eval q|
13  use warnings qw<FATAL redefine prototype>;
14  sub main::baz ($) { $baz = $_[0] }
15 |;
16 like($@, qr/Prototype\s+mismatch\s*:\s+sub\s+main::baz\s*:\s+none\s+vs\s+\(\$\)/, 'baz appears as prototyped');
17
18 use subs::auto;
19
20 eval { my @x = (1, 5); foo @x };
21 is($@, '', 'foo was compiled ok');
22 is($foo, 2, 'foo was called with the right arguments');
23
24 eval { my @x = (1, 5); &foo(@x) };
25 is($@, '', '&foo was compiled ok');
26 is($foo, 1, '&foo was called with the right arguments');
27
28 my $bar;
29 sub bar (\@) { $bar = 0; $bar += $_ for grep defined, @{$_[0]}  }
30
31 eval { my @x = (2, 3, 4); bar @x };
32 is($@, '', 'bar was compiled ok');
33 is($bar, 9, 'bar was called with the right arguments');
34
35 eval { my @x = ([2, 3], 4); &bar(@x) };
36 is($@, '', '&bar was compiled ok');
37 is($bar, 5, '&bar was called with the right arguments');
38
39 eval { baz 5 };
40 like($@, qr/^Undefined\s+subroutine\s+&?main::baz/,'baz couldn\'t be compiled');
41 is($baz, undef, 'baz can\'t be called because of the prototype mismatch');
42
43 no subs::auto;