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