X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fcomp%2Fredef.t;h=63be16c2ff81842846d2bf3f54afb38627bfea1b;hb=1183a10042af0734ee65e252f15bd820b7bbe686;hp=6a73ae1c2e6e91ec51f90beb3f03f5650fc5abe8;hpb=760ac839baf413929cd31cc32ffd6dba6b781a81;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/t/comp/redef.t b/t/comp/redef.t
index 6a73ae1..63be16c 100644
--- a/t/comp/redef.t
+++ b/t/comp/redef.t
@@ -1,9 +1,8 @@
-#!./perl
+#!./perl -w
 #
 # Contributed by Graham Barr <Graham.Barr@tiuk.ti.com>
 
 BEGIN {
-    $^W = 1;
     $warn = "";
     $SIG{__WARN__} = sub { $warn .= join("",@_) }
 }
@@ -12,7 +11,9 @@ sub ok ($$) {
     print $_[1] ? "ok " : "not ok ", $_[0], "\n";
 }
 
-print "1..18\n";
+print "1..20\n";
+
+my $NEWPROTO = 'Prototype mismatch:';
 
 sub sub0 { 1 }
 sub sub0 { 2 }
@@ -22,19 +23,19 @@ ok 1, $warn =~ s/Subroutine sub0 redefined[^\n]+\n//s;
 sub sub1    { 1 }
 sub sub1 () { 2 }
 
-ok 2, $warn =~ s/Prototype mismatch: \Q(none) vs ()\E[^\n]+\n//s;
+ok 2, $warn =~ s/$NEWPROTO \Qsub main::sub1: none vs ()\E[^\n]+\n//s;
 ok 3, $warn =~ s/Subroutine sub1 redefined[^\n]+\n//s;
 
 sub sub2     { 1 }
 sub sub2 ($) { 2 }
 
-ok 4, $warn =~ s/Prototype mismatch: \Q(none) vs ($)\E[^\n]+\n//s;
+ok 4, $warn =~ s/$NEWPROTO \Qsub main::sub2: none vs ($)\E[^\n]+\n//s;
 ok 5, $warn =~ s/Subroutine sub2 redefined[^\n]+\n//s;
 
 sub sub3 () { 1 }
 sub sub3    { 2 }
 
-ok 6, $warn =~ s/Prototype mismatch: \Q() vs (none)\E[^\n]+\n//s;
+ok 6, $warn =~ s/$NEWPROTO \Qsub main::sub3 () vs none\E[^\n]+\n//s;
 ok 7, $warn =~ s/Constant subroutine sub3 redefined[^\n]+\n//s;
 
 sub sub4 () { 1 }
@@ -45,19 +46,19 @@ ok 8, $warn =~ s/Constant subroutine sub4 redefined[^\n]+\n//s;
 sub sub5 ()  { 1 }
 sub sub5 ($) { 2 }
 
-ok  9, $warn =~ s/Prototype mismatch: \Q() vs ($)\E[^\n]+\n//s;
+ok  9, $warn =~ s/$NEWPROTO \Qsub main::sub5 () vs ($)\E[^\n]+\n//s;
 ok 10, $warn =~ s/Constant subroutine sub5 redefined[^\n]+\n//s;
 
 sub sub6 ($) { 1 }
 sub sub6     { 2 }
 
-ok 11, $warn =~ s/Prototype mismatch: \Q($) vs (none)\E[^\n]+\n//s;
+ok 11, $warn =~ s/$NEWPROTO \Qsub main::sub6 ($) vs none\E[^\n]+\n//s;
 ok 12, $warn =~ s/Subroutine sub6 redefined[^\n]+\n//s;
 
 sub sub7 ($) { 1 }
 sub sub7 ()  { 2 }
 
-ok 13, $warn =~ s/Prototype mismatch: \Q($) vs ()\E[^\n]+\n//s;
+ok 13, $warn =~ s/$NEWPROTO \Qsub main::sub7 ($) vs ()\E[^\n]+\n//s;
 ok 14, $warn =~ s/Subroutine sub7 redefined[^\n]+\n//s;
 
 sub sub8 ($) { 1 }
@@ -68,12 +69,18 @@ ok 15, $warn =~ s/Subroutine sub8 redefined[^\n]+\n//s;
 sub sub9 ($@) { 1 }
 sub sub9 ($)  { 2 }
 
-ok 16, $warn =~ s/Prototype mismatch: \(\$\Q@) vs ($)\E[^\n]+\n//s;
+ok 16, $warn =~ s/$NEWPROTO sub main::sub9 \(\$\Q@) vs ($)\E[^\n]+\n//s;
 ok 17, $warn =~ s/Subroutine sub9 redefined[^\n]+\n//s;
 
-ok 18, $_ eq '';
+BEGIN {
+    local $^W = 0;
+    eval qq(sub sub10 () {1} sub sub10 {1});
+}
 
-# If we got any errors that we were not expecting, then print them
-print $_ if length $_;
+ok 18, $warn =~ s/$NEWPROTO \Qsub main::sub10 () vs none\E[^\n]+\n//s;
+ok 19, $warn =~ s/Constant subroutine sub10 redefined[^\n]+\n//s;
 
+ok 20, $warn eq '';
 
+# If we got any errors that we were not expecting, then print them
+print $warn if length $warn;