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