[perl #71204] diagnostics.pm suppresses 'Use of uninitialized value in range (or...

[p5sagit/p5-mst-13.2.git] / t / comp / proto.t

diff --git a/t/comp/proto.t b/t/comp/proto.t
old mode 100755 (executable)
new mode 100644 (file)
index e317a94..734a68b
--- a/t/comp/proto.t
+++ b/t/comp/proto.t
@@ -14,9 +14,11 @@ BEGIN {
     @INC = '../lib';
 }
 
+# We need this, as in places we're testing the interaction of prototypes with
+# strict
 use strict;
 
-print "1..140\n";
+print "1..153\n";
 
 my $i = 1;
 
@@ -549,11 +551,21 @@ sub sreftest (\$$) {
 # 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 $$;$;$
@@ -585,26 +597,31 @@ print "ok ", $i++, "\n";
     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("",@_) };
   
@@ -629,3 +646,8 @@ print "ok ", $i++, "\n";
 eval "sub good (\$\t\$\n\$) { 1; }";
 print "not " if $@;
 print "ok ", $i++, "\n";
+
+# Ought to fail, doesn't in 5.8.1.
+eval 'sub bug (\[%@]) {  } my $array = [0 .. 1]; bug %$array;';
+print "not " unless $@ =~ /Not a HASH reference/;
+print "ok ", $i++, "\n";