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