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