t/12-proto.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 7;
   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 my $bar;
  25 sub bar (\@) { $bar = 0; $bar += $_ for grep defined, @{$_[0]}  }
  26
  27 eval { my @x = (2, 3, 4); bar @x };
  28 is($@, '', 'bar was compiled ok');
  29 is($bar, 9, 'bar was called with the right arguments');
  30
  31 eval { baz 5 };
  32 like($@, qr/^Undefined\s+subroutine\s+&?main::baz/,'baz couldn\'t be compiled');
  33 is($baz, undef, 'baz can\'t be called because of the prototype mismatch');
  34
  35 no subs::auto;