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 | ||
3b7f69a5 | 10 | plan 22; |
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 | ||
c5df3096 | 151 | 1; |