6 require './test.pl'; require './charset_tools.pl';
13 my $wa = []; my $ea = [];
14 $SIG{__WARN__} = sub { push @warnings, $_[0] };
19 ok @warnings==1 && $warnings[0] eq "foo\n";
24 ok @warnings==1 && $warnings[0] eq "foobar\n";
29 ok @warnings==1 && $warnings[0] eq "foo at warn.t line 28.\n";
34 ok @warnings==1 && ref($warnings[0]) eq "ARRAY" && $warnings[0] == $wa;
40 $warnings[0] eq "Warning: something's wrong at warn.t line 38.\n";
46 $warnings[0] eq "Warning: something's wrong at warn.t line 44.\n";
51 ok @warnings==1 && $warnings[0] eq "foo\n";
56 ok @warnings==1 && $warnings[0] eq "foobar\n";
61 ok @warnings==1 && $warnings[0] eq "foo at warn.t line 60.\n";
66 ok @warnings==1 && ref($warnings[0]) eq "ARRAY" && $warnings[0] == $wa;
72 $warnings[0] eq "ERR\n\t...caught at warn.t line 70.\n";
78 $warnings[0] eq "ERR\n\t...caught at warn.t line 76.\n";
83 ok @warnings==1 && $warnings[0] eq "foo\n";
88 ok @warnings==1 && $warnings[0] eq "foobar\n";
93 ok @warnings==1 && $warnings[0] eq "foo at warn.t line 92.\n";
98 ok @warnings==1 && ref($warnings[0]) eq "ARRAY" && $warnings[0] == $wa;
103 ok @warnings==1 && ref($warnings[0]) eq "ARRAY" && $warnings[0] == $ea;
108 ok @warnings==1 && ref($warnings[0]) eq "ARRAY" && $warnings[0] == $ea;
113 print STDERR $a; warn $a;
115 print STDERR $a; warn $a;
117 qr/^\xee(?:\r?\n\xee){3}/,
118 { switches => [ "-C0" ] },
119 'warn emits logical characters, not internal bytes [perl #45549]'
123 skip_if_miniperl('miniperl ignores -C', 1);
124 $ee = uni_to_native("\xee");
125 $bytes = byte_utf8a_to_utf8n("\xc3\xae");
129 print STDERR \$a; warn \$a;
131 print STDERR \$a; warn \$a;
133 qr/^$bytes(?:\r?\n$bytes){3}/,
134 { switches => ['-CE'] },
135 'warn respects :utf8 layer'
139 $bytes = byte_utf8a_to_utf8n("\xc4\xac");
142 qr/^Wide character in warn .*\n$bytes at /,
143 { switches => [ "-C0" ] },
144 'Wide character in warn (not print)'
149 qr/^ARRAY\(0x[\da-f]+\) at /a,
151 'warn stringifies in the absence of $SIG{__WARN__}'
155 tie $@, "Tie::StdScalar";
161 like $warnings[0], qr/^foo\n\t\.\.\.caught at warn\.t /,
162 '...caught is appended to tied $@';
167 local *{ref(tied $@) . "::STORE"} = sub {};
172 is $warnings[0], \$_, '!SvOK tied $@ that returns ref is used';
179 use overload '""' => sub { "" };
181 tie $t, Tie::StdScalar;
184 local *{ref(tied $t) . "::STORE"} = sub {};
189 object_ok $warnings[0], 'o',
190 'warn $tie_returning_object_that_stringifes_emptily';
193 eval "#line 42 Cholmondeley\n \$\@ = '3'; warn";
194 eval "#line 42 Cholmondeley\n \$\@ = 3; warn";
196 is $warnings[1], $warnings[0], 'warn treats $@=3 and $@="3" the same way';
198 fresh_perl_is(<<'EOF', "should be line 4 at - line 4.\n", {stderr => 1}, "");
201 } = "should be line 4";
206 local $::TODO = "Line numbers don't yet match up for \${ EXPR }";
207 my $expected = <<'EOF';
210 also line 4 at - line 4.
213 fresh_perl_is(<<'EOF', $expected, {stderr => 1}, "");
217 } = "line 5") && warn("line 4"); warn("also line 4");