Commit | Line | Data |
---|---|---|
c5df3096 Z |
1 | #!./perl |
2 | #line 3 warn.t | |
3 | ||
95961f2b FC |
4 | BEGIN { |
5 | chdir 't' if -d 't'; | |
6 | @INC = '../lib'; | |
7 | require './test.pl'; | |
c5df3096 Z |
8 | } |
9 | ||
b1d0a833 | 10 | plan 30; |
95961f2b | 11 | |
c5df3096 Z |
12 | my @warnings; |
13 | my $wa = []; my $ea = []; | |
14 | $SIG{__WARN__} = sub { push @warnings, $_[0] }; | |
15 | ||
16 | @warnings = (); | |
17 | $@ = ""; | |
18 | warn "foo\n"; | |
19 | ok @warnings==1 && $warnings[0] eq "foo\n"; | |
20 | ||
21 | @warnings = (); | |
22 | $@ = ""; | |
23 | warn "foo", "bar\n"; | |
24 | ok @warnings==1 && $warnings[0] eq "foobar\n"; | |
25 | ||
26 | @warnings = (); | |
27 | $@ = ""; | |
28 | warn "foo"; | |
95961f2b | 29 | ok @warnings==1 && $warnings[0] eq "foo at warn.t line 28.\n"; |
c5df3096 Z |
30 | |
31 | @warnings = (); | |
32 | $@ = ""; | |
33 | warn $wa; | |
34 | ok @warnings==1 && ref($warnings[0]) eq "ARRAY" && $warnings[0] == $wa; | |
35 | ||
36 | @warnings = (); | |
37 | $@ = ""; | |
38 | warn ""; | |
39 | ok @warnings==1 && | |
95961f2b | 40 | $warnings[0] eq "Warning: something's wrong at warn.t line 38.\n"; |
c5df3096 Z |
41 | |
42 | @warnings = (); | |
43 | $@ = ""; | |
44 | warn; | |
45 | ok @warnings==1 && | |
95961f2b | 46 | $warnings[0] eq "Warning: something's wrong at warn.t line 44.\n"; |
c5df3096 Z |
47 | |
48 | @warnings = (); | |
49 | $@ = "ERR\n"; | |
50 | warn "foo\n"; | |
51 | ok @warnings==1 && $warnings[0] eq "foo\n"; | |
52 | ||
53 | @warnings = (); | |
54 | $@ = "ERR\n"; | |
55 | warn "foo", "bar\n"; | |
56 | ok @warnings==1 && $warnings[0] eq "foobar\n"; | |
57 | ||
58 | @warnings = (); | |
59 | $@ = "ERR\n"; | |
60 | warn "foo"; | |
95961f2b | 61 | ok @warnings==1 && $warnings[0] eq "foo at warn.t line 60.\n"; |
c5df3096 Z |
62 | |
63 | @warnings = (); | |
64 | $@ = "ERR\n"; | |
65 | warn $wa; | |
66 | ok @warnings==1 && ref($warnings[0]) eq "ARRAY" && $warnings[0] == $wa; | |
67 | ||
68 | @warnings = (); | |
69 | $@ = "ERR\n"; | |
70 | warn ""; | |
71 | ok @warnings==1 && | |
95961f2b | 72 | $warnings[0] eq "ERR\n\t...caught at warn.t line 70.\n"; |
c5df3096 Z |
73 | |
74 | @warnings = (); | |
75 | $@ = "ERR\n"; | |
76 | warn; | |
77 | ok @warnings==1 && | |
95961f2b | 78 | $warnings[0] eq "ERR\n\t...caught at warn.t line 76.\n"; |
c5df3096 Z |
79 | |
80 | @warnings = (); | |
81 | $@ = $ea; | |
82 | warn "foo\n"; | |
83 | ok @warnings==1 && $warnings[0] eq "foo\n"; | |
84 | ||
85 | @warnings = (); | |
86 | $@ = $ea; | |
87 | warn "foo", "bar\n"; | |
88 | ok @warnings==1 && $warnings[0] eq "foobar\n"; | |
89 | ||
90 | @warnings = (); | |
91 | $@ = $ea; | |
92 | warn "foo"; | |
95961f2b | 93 | ok @warnings==1 && $warnings[0] eq "foo at warn.t line 92.\n"; |
c5df3096 Z |
94 | |
95 | @warnings = (); | |
96 | $@ = $ea; | |
97 | warn $wa; | |
98 | ok @warnings==1 && ref($warnings[0]) eq "ARRAY" && $warnings[0] == $wa; | |
99 | ||
100 | @warnings = (); | |
101 | $@ = $ea; | |
102 | warn ""; | |
103 | ok @warnings==1 && ref($warnings[0]) eq "ARRAY" && $warnings[0] == $ea; | |
104 | ||
105 | @warnings = (); | |
106 | $@ = $ea; | |
107 | warn; | |
108 | ok @warnings==1 && ref($warnings[0]) eq "ARRAY" && $warnings[0] == $ea; | |
109 | ||
83c55556 FC |
110 | fresh_perl_like( |
111 | ' | |
112 | $a = "\xee\n"; | |
113 | print STDERR $a; warn $a; | |
114 | utf8::upgrade($a); | |
115 | print STDERR $a; warn $a; | |
116 | ', | |
117 | qr/^\xee(?:\r?\n\xee){3}/, | |
6e4e3658 | 118 | { switches => [ "-C0" ] }, |
83c55556 FC |
119 | 'warn emits logical characters, not internal bytes [perl #45549]' |
120 | ); | |
121 | ||
3a5f098b NC |
122 | SKIP: { |
123 | skip_if_miniperl('miniperl ignores -C', 1); | |
83c55556 FC |
124 | fresh_perl_like( |
125 | ' | |
126 | $a = "\xee\n"; | |
127 | print STDERR $a; warn $a; | |
128 | utf8::upgrade($a); | |
129 | print STDERR $a; warn $a; | |
130 | ', | |
131 | qr/^\xc3\xae(?:\r?\n\xc3\xae){3}/, | |
132 | { switches => ['-CE'] }, | |
133 | 'warn respects :utf8 layer' | |
134 | ); | |
3a5f098b | 135 | } |
83c55556 | 136 | |
eb06eac9 FC |
137 | fresh_perl_like( |
138 | 'warn chr 300', | |
139 | qr/^Wide character in warn .*\n\xc4\xac at /, | |
6e4e3658 | 140 | { switches => [ "-C0" ] }, |
eb06eac9 FC |
141 | 'Wide character in warn (not print)' |
142 | ); | |
143 | ||
3b7f69a5 FC |
144 | fresh_perl_like( |
145 | 'warn []', | |
146 | qr/^ARRAY\(0x[\da-f]+\) at /a, | |
147 | { }, | |
148 | 'warn stringifies in the absence of $SIG{__WARN__}' | |
149 | ); | |
150 | ||
ef5fe392 FC |
151 | use Tie::Scalar; |
152 | tie $@, "Tie::StdScalar"; | |
153 | ||
154 | $@ = "foo\n"; | |
155 | @warnings = (); | |
156 | warn; | |
157 | is @warnings, 1; | |
158 | like $warnings[0], qr/^foo\n\t\.\.\.caught at warn\.t /, | |
159 | '...caught is appended to tied $@'; | |
160 | ||
161 | $@ = \$_; | |
162 | @warnings = (); | |
163 | { | |
164 | local *{ref(tied $@) . "::STORE"} = sub {}; | |
165 | undef $@; | |
166 | } | |
167 | warn; | |
168 | is @warnings, 1; | |
169 | is $warnings[0], \$_, '!SvOK tied $@ that returns ref is used'; | |
170 | ||
171 | untie $@; | |
172 | ||
173 | @warnings = (); | |
174 | { | |
175 | package o; | |
176 | use overload '""' => sub { "" }; | |
177 | } | |
178 | tie $t, Tie::StdScalar; | |
179 | $t = bless [], o; | |
180 | { | |
181 | local *{ref(tied $t) . "::STORE"} = sub {}; | |
182 | undef $t; | |
183 | } | |
184 | warn $t; | |
185 | is @warnings, 1; | |
186 | object_ok $warnings[0], 'o', | |
187 | 'warn $tie_returning_object_that_stringifes_emptily'; | |
188 | ||
b1d0a833 FC |
189 | @warnings = (); |
190 | eval "#line 42 Cholmondeley\n \$\@ = '3'; warn"; | |
191 | eval "#line 42 Cholmondeley\n \$\@ = 3; warn"; | |
192 | is @warnings, 2; | |
193 | is $warnings[1], $warnings[0], 'warn treats $@=3 and $@="3" the same way'; | |
194 | ||
c5df3096 | 195 | 1; |