Commit | Line | Data |
---|---|---|
197afce1 MT |
1 | #!./perl |
2 | ||
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
5 | @INC = qw(. ../lib); | |
6 | } | |
7 | ||
8 | use strict; | |
9 | use warnings; | |
10 | ||
11 | BEGIN { | |
12 | require 'test.pl'; | |
13 | plan( tests => 12 ); | |
14 | } | |
15 | ||
16 | use vars qw{ @warnings $sub $warn }; | |
17 | ||
18 | BEGIN { | |
19 | $warn = 'Illegal character in prototype'; | |
20 | } | |
21 | ||
22 | sub one_warning_ok { | |
23 | cmp_ok(scalar(@warnings), '==', 1, 'One warning'); | |
24 | cmp_ok(substr($warnings[0],0,length($warn)),'eq',$warn,'warning message'); | |
25 | @warnings = (); | |
26 | } | |
27 | ||
28 | sub no_warnings_ok { | |
29 | cmp_ok(scalar(@warnings), '==', 0, 'No warnings'); | |
30 | @warnings = (); | |
31 | } | |
32 | ||
33 | BEGIN { | |
34 | $SIG{'__WARN__'} = sub { push @warnings, @_ }; | |
35 | $| = 1; | |
36 | } | |
37 | ||
38 | BEGIN { @warnings = () } | |
39 | ||
40 | $sub = sub (x) { }; | |
41 | ||
42 | BEGIN { | |
43 | one_warning_ok; | |
44 | } | |
45 | ||
46 | { | |
47 | no warnings 'syntax'; | |
48 | $sub = sub (x) { }; | |
49 | } | |
50 | ||
51 | BEGIN { | |
52 | no_warnings_ok; | |
53 | } | |
54 | ||
55 | { | |
56 | no warnings 'illegalproto'; | |
57 | $sub = sub (x) { }; | |
58 | } | |
59 | ||
60 | BEGIN { | |
61 | no_warnings_ok; | |
62 | } | |
63 | ||
64 | { | |
65 | no warnings 'syntax'; | |
66 | use warnings 'illegalproto'; | |
67 | $sub = sub (x) { }; | |
68 | } | |
69 | ||
70 | BEGIN { | |
71 | one_warning_ok; | |
72 | } | |
73 | ||
74 | BEGIN { | |
75 | $warn = q{Prototype after '@' for}; | |
76 | } | |
77 | ||
78 | $sub = sub (@$) { }; | |
79 | ||
80 | BEGIN { | |
81 | one_warning_ok; | |
82 | } | |
83 | ||
84 | { | |
85 | no warnings 'syntax'; | |
86 | $sub = sub (@$) { }; | |
87 | } | |
88 | ||
89 | BEGIN { | |
90 | no_warnings_ok; | |
91 | } | |
92 | ||
93 | { | |
94 | no warnings 'illegalproto'; | |
95 | $sub = sub (@$) { }; | |
96 | } | |
97 | ||
98 | BEGIN { | |
99 | no_warnings_ok; | |
100 | } | |
101 | ||
102 | { | |
103 | no warnings 'syntax'; | |
104 | use warnings 'illegalproto'; | |
105 | $sub = sub (@$) { }; | |
106 | } | |
107 | ||
108 | BEGIN { | |
109 | one_warning_ok; | |
110 | } |