summaryrefslogtreecommitdiff
path: root/t/comp/redef.t
blob: 6a73ae1c2e6e91ec51f90beb3f03f5650fc5abe8 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
#!./perl
#
# Contributed by Graham Barr <Graham.Barr@tiuk.ti.com>

BEGIN {
    $^W = 1;
    $warn = "";
    $SIG{__WARN__} = sub { $warn .= join("",@_) }
}

sub ok ($$) { 
    print $_[1] ? "ok " : "not ok ", $_[0], "\n";
}

print "1..18\n";

sub sub0 { 1 }
sub sub0 { 2 }

ok 1, $warn =~ s/Subroutine sub0 redefined[^\n]+\n//s;

sub sub1    { 1 }
sub sub1 () { 2 }

ok 2, $warn =~ s/Prototype mismatch: \Q(none) vs ()\E[^\n]+\n//s;
ok 3, $warn =~ s/Subroutine sub1 redefined[^\n]+\n//s;

sub sub2     { 1 }
sub sub2 ($) { 2 }

ok 4, $warn =~ s/Prototype mismatch: \Q(none) vs ($)\E[^\n]+\n//s;
ok 5, $warn =~ s/Subroutine sub2 redefined[^\n]+\n//s;

sub sub3 () { 1 }
sub sub3    { 2 }

ok 6, $warn =~ s/Prototype mismatch: \Q() vs (none)\E[^\n]+\n//s;
ok 7, $warn =~ s/Constant subroutine sub3 redefined[^\n]+\n//s;

sub sub4 () { 1 }
sub sub4 () { 2 }

ok 8, $warn =~ s/Constant subroutine sub4 redefined[^\n]+\n//s;

sub sub5 ()  { 1 }
sub sub5 ($) { 2 }

ok  9, $warn =~ s/Prototype mismatch: \Q() vs ($)\E[^\n]+\n//s;
ok 10, $warn =~ s/Constant subroutine sub5 redefined[^\n]+\n//s;

sub sub6 ($) { 1 }
sub sub6     { 2 }

ok 11, $warn =~ s/Prototype mismatch: \Q($) vs (none)\E[^\n]+\n//s;
ok 12, $warn =~ s/Subroutine sub6 redefined[^\n]+\n//s;

sub sub7 ($) { 1 }
sub sub7 ()  { 2 }

ok 13, $warn =~ s/Prototype mismatch: \Q($) vs ()\E[^\n]+\n//s;
ok 14, $warn =~ s/Subroutine sub7 redefined[^\n]+\n//s;

sub sub8 ($) { 1 }
sub sub8 ($) { 2 }

ok 15, $warn =~ s/Subroutine sub8 redefined[^\n]+\n//s;

sub sub9 ($@) { 1 }
sub sub9 ($)  { 2 }

ok 16, $warn =~ s/Prototype mismatch: \(\$\Q@) vs ($)\E[^\n]+\n//s;
ok 17, $warn =~ s/Subroutine sub9 redefined[^\n]+\n//s;

ok 18, $_ eq '';

# If we got any errors that we were not expecting, then print them
print $_ if length $_;