@INC = '../lib';
}
+# We need this, as in places we're testing the interaction of prototypes with
+# strict
use strict;
-print "1..141\n";
+print "1..153\n";
my $i = 1;
# string "parse error".
#
for my $p ( "", qw{ () ($) ($@) ($%) ($;$) (&) (&\@) (&@) (%) (\%) (\@) } ) {
- no warnings 'prototype';
+ my $warn = "";
+ local $SIG{__WARN__} = sub {
+ my $thiswarn = join("",@_);
+ return if $thiswarn =~ /^Prototype mismatch: sub main::evaled_subroutine/;
+ $warn .= $thiswarn;
+ };
my $eval = "sub evaled_subroutine $p { &void *; }";
eval $eval;
print "# eval[$eval]\nnot " unless $@ && $@ =~ /(parse|syntax) error/i;
print "ok ", $i++, "\n";
+ if ($warn eq '') {
+ print "ok ", $i++, "\n";
+ } else {
+ print "not ok ", $i++, "# $warn \n";
+ }
}
# Not $$;$;$
print "ok ", $i++, "\n";
eval q/sub multi1 (\[%@]) { 1 } multi1 $myvar;/;
- print "not " unless $@ =~ /Type of arg 1 to main::multi1 must be one of/;
+ print "not "
+ unless $@ =~ /Type of arg 1 to main::multi1 must be one of \[%\@\] /;
print "ok ", $i++, "\n";
eval q/sub multi2 (\[$*&]) { 1 } multi2 @myarray;/;
- print "not " unless $@ =~ /Type of arg 1 to main::multi2 must be one of/;
+ print "not "
+ unless $@ =~ /Type of arg 1 to main::multi2 must be one of \[\$\*&\] /;
print "ok ", $i++, "\n";
eval q/sub multi3 (\[$@]) { 1 } multi3 %myhash;/;
- print "not " unless $@ =~ /Type of arg 1 to main::multi3 must be one of/;
+ print "not "
+ unless $@ =~ /Type of arg 1 to main::multi3 must be one of \[\$\@\] /;
print "ok ", $i++, "\n";
eval q/sub multi4 ($\[%]) { 1 } multi4 1, &mysub;/;
- print "not " unless $@ =~ /Type of arg 2 to main::multi4 must be one of/;
+ print "not "
+ unless $@ =~ /Type of arg 2 to main::multi4 must be one of \[%\] /;
print "ok ", $i++, "\n";
eval q/sub multi5 (\[$@]$) { 1 } multi5 *myglob;/;
- print "not " unless $@ =~ /Type of arg 1 to main::multi5 must be one of/
- && $@ =~ /Not enough arguments/;
+ print "not "
+ unless $@ =~ /Type of arg 1 to main::multi5 must be one of \[\$\@\] /
+ && $@ =~ /Not enough arguments/;
print "ok ", $i++, "\n";
}
# check that obviously bad prototypes are getting warnings
{
- use warnings 'syntax';
+ local $^W = 1;
my $warn = "";
local $SIG{__WARN__} = sub { $warn .= join("",@_) };