1#!./perl -w 2# 3# Contributed by Graham Barr <Graham.Barr@tiuk.ti.com> 4 5BEGIN { 6 $warn = ""; 7 $SIG{__WARN__} = sub { $warn .= join("",@_) } 8} 9 10sub ok ($$) { 11 print $_[1] ? "ok " : "not ok ", $_[0], "\n"; 12} 13 14print "1..20\n"; 15 16my $NEWPROTO = 'Prototype mismatch:'; 17 18sub sub0 { 1 } 19sub sub0 { 2 } 20 21ok 1, $warn =~ s/Subroutine sub0 redefined[^\n]+\n//s; 22 23sub sub1 { 1 } 24sub sub1 () { 2 } 25 26ok 2, $warn =~ s/$NEWPROTO \Qsub main::sub1: none vs ()\E[^\n]+\n//s; 27ok 3, $warn =~ s/Subroutine sub1 redefined[^\n]+\n//s; 28 29sub sub2 { 1 } 30sub sub2 ($) { 2 } 31 32ok 4, $warn =~ s/$NEWPROTO \Qsub main::sub2: none vs ($)\E[^\n]+\n//s; 33ok 5, $warn =~ s/Subroutine sub2 redefined[^\n]+\n//s; 34 35sub sub3 () { 1 } 36sub sub3 { 2 } 37 38ok 6, $warn =~ s/$NEWPROTO \Qsub main::sub3 () vs none\E[^\n]+\n//s; 39ok 7, $warn =~ s/Constant subroutine sub3 redefined[^\n]+\n//s; 40 41sub sub4 () { 1 } 42sub sub4 () { 2 } 43 44ok 8, $warn =~ s/Constant subroutine sub4 redefined[^\n]+\n//s; 45 46sub sub5 () { 1 } 47sub sub5 ($) { 2 } 48 49ok 9, $warn =~ s/$NEWPROTO \Qsub main::sub5 () vs ($)\E[^\n]+\n//s; 50ok 10, $warn =~ s/Constant subroutine sub5 redefined[^\n]+\n//s; 51 52sub sub6 ($) { 1 } 53sub sub6 { 2 } 54 55ok 11, $warn =~ s/$NEWPROTO \Qsub main::sub6 ($) vs none\E[^\n]+\n//s; 56ok 12, $warn =~ s/Subroutine sub6 redefined[^\n]+\n//s; 57 58sub sub7 ($) { 1 } 59sub sub7 () { 2 } 60 61ok 13, $warn =~ s/$NEWPROTO \Qsub main::sub7 ($) vs ()\E[^\n]+\n//s; 62ok 14, $warn =~ s/Subroutine sub7 redefined[^\n]+\n//s; 63 64sub sub8 ($) { 1 } 65sub sub8 ($) { 2 } 66 67ok 15, $warn =~ s/Subroutine sub8 redefined[^\n]+\n//s; 68 69sub sub9 ($@) { 1 } 70sub sub9 ($) { 2 } 71 72ok 16, $warn =~ s/$NEWPROTO sub main::sub9 \(\$\Q@) vs ($)\E[^\n]+\n//s; 73ok 17, $warn =~ s/Subroutine sub9 redefined[^\n]+\n//s; 74 75BEGIN { 76 local $^W = 0; 77 eval qq(sub sub10 () {1} sub sub10 {1}); 78} 79 80ok 18, $warn =~ s/$NEWPROTO \Qsub main::sub10 () vs none\E[^\n]+\n//s; 81ok 19, $warn =~ s/Constant subroutine sub10 redefined[^\n]+\n//s; 82 83ok 20, $warn eq ''; 84 85# If we got any errors that we were not expecting, then print them 86print $warn if length $warn; 87