3 # Contributed by Graham Barr <Graham.Barr@tiuk.ti.com>
7 $SIG{__WARN__} = sub { $warn .= join("",@_) }
11 print $_[1] ? "ok " : "not ok ", $_[0], "\n";
16 my $NEWPROTO = 'Prototype mismatch:';
21 ok 1, $warn =~ s/Subroutine sub0 redefined[^\n]+\n//s;
26 ok 2, $warn =~ s/$NEWPROTO \Qsub main::sub1: none vs ()\E[^\n]+\n//s;
27 ok 3, $warn =~ s/Subroutine sub1 redefined[^\n]+\n//s;
32 ok 4, $warn =~ s/$NEWPROTO \Qsub main::sub2: none vs ($)\E[^\n]+\n//s;
33 ok 5, $warn =~ s/Subroutine sub2 redefined[^\n]+\n//s;
38 ok 6, $warn =~ s/$NEWPROTO \Qsub main::sub3 () vs none\E[^\n]+\n//s;
39 ok 7, $warn =~ s/Constant subroutine sub3 redefined[^\n]+\n//s;
44 ok 8, $warn =~ s/Constant subroutine sub4 redefined[^\n]+\n//s;
49 ok 9, $warn =~ s/$NEWPROTO \Qsub main::sub5 () vs ($)\E[^\n]+\n//s;
50 ok 10, $warn =~ s/Constant subroutine sub5 redefined[^\n]+\n//s;
55 ok 11, $warn =~ s/$NEWPROTO \Qsub main::sub6 ($) vs none\E[^\n]+\n//s;
56 ok 12, $warn =~ s/Subroutine sub6 redefined[^\n]+\n//s;
61 ok 13, $warn =~ s/$NEWPROTO \Qsub main::sub7 ($) vs ()\E[^\n]+\n//s;
62 ok 14, $warn =~ s/Subroutine sub7 redefined[^\n]+\n//s;
67 ok 15, $warn =~ s/Subroutine sub8 redefined[^\n]+\n//s;
72 ok 16, $warn =~ s/$NEWPROTO sub main::sub9 \(\$\Q@) vs ($)\E[^\n]+\n//s;
73 ok 17, $warn =~ s/Subroutine sub9 redefined[^\n]+\n//s;
77 eval qq(sub sub10 () {1} sub sub10 {1});
80 ok 18, $warn =~ s/$NEWPROTO \Qsub main::sub10 () vs none\E[^\n]+\n//s;
81 ok 19, $warn =~ s/Constant subroutine sub10 redefined[^\n]+\n//s;
85 # If we got any errors that we were not expecting, then print them
86 print $warn if length $warn;