#!./perl
#line 3 warn.t
BEGIN {
unshift @INC, 't/CORE/lib';
require 't/CORE/test.pl';
}
plan 22;
my @warnings;
my $wa = []; my $ea = [];
$SIG{__WARN__} = sub { push @warnings, $_[0] };
@warnings = ();
$@ = "";
warn "foo\n";
ok @warnings==1 && $warnings[0] eq "foo\n";
@warnings = ();
$@ = "";
warn "foo", "bar\n";
ok @warnings==1 && $warnings[0] eq "foobar\n";
@warnings = ();
$@ = "";
warn "foo";
ok @warnings==1 && $warnings[0] eq "foo at warn.t line 27.\n";
@warnings = ();
$@ = "";
warn $wa;
ok @warnings==1 && ref($warnings[0]) eq "ARRAY" && $warnings[0] == $wa;
@warnings = ();
$@ = "";
warn "";
ok @warnings==1 &&
$warnings[0] eq "Warning: something's wrong at warn.t line 37.\n";
@warnings = ();
$@ = "";
warn;
ok @warnings==1 &&
$warnings[0] eq "Warning: something's wrong at warn.t line 43.\n";
@warnings = ();
$@ = "ERR\n";
warn "foo\n";
ok @warnings==1 && $warnings[0] eq "foo\n";
@warnings = ();
$@ = "ERR\n";
warn "foo", "bar\n";
ok @warnings==1 && $warnings[0] eq "foobar\n";
@warnings = ();
$@ = "ERR\n";
warn "foo";
ok @warnings==1 && $warnings[0] eq "foo at warn.t line 59.\n";
@warnings = ();
$@ = "ERR\n";
warn $wa;
ok @warnings==1 && ref($warnings[0]) eq "ARRAY" && $warnings[0] == $wa;
@warnings = ();
$@ = "ERR\n";
warn "";
ok @warnings==1 &&
$warnings[0] eq "ERR\n\t...caught at warn.t line 69.\n";
@warnings = ();
$@ = "ERR\n";
warn;
ok @warnings==1 &&
$warnings[0] eq "ERR\n\t...caught at warn.t line 75.\n";
@warnings = ();
$@ = $ea;
warn "foo\n";
ok @warnings==1 && $warnings[0] eq "foo\n";
@warnings = ();
$@ = $ea;
warn "foo", "bar\n";
ok @warnings==1 && $warnings[0] eq "foobar\n";
@warnings = ();
$@ = $ea;
warn "foo";
ok @warnings==1 && $warnings[0] eq "foo at warn.t line 91.\n";
@warnings = ();
$@ = $ea;
warn $wa;
ok @warnings==1 && ref($warnings[0]) eq "ARRAY" && $warnings[0] == $wa;
@warnings = ();
$@ = $ea;
warn "";
ok @warnings==1 && ref($warnings[0]) eq "ARRAY" && $warnings[0] == $ea;
@warnings = ();
$@ = $ea;
warn;
ok @warnings==1 && ref($warnings[0]) eq "ARRAY" && $warnings[0] == $ea;
fresh_perl_like(
'
$a = "\xee\n";
print STDERR $a; warn $a;
utf8::upgrade($a);
print STDERR $a; warn $a;
',
qr/^\xee(?:\r?\n\xee){3}/,
# { switches => [ "-C0" ] }, # switches don't work with perlcc
'warn emits logical characters, not internal bytes [perl #45549]'
);
{
fresh_perl_like(
'
INIT { binmode(STDERR, ":utf8") }
$a = "\xee\n";
print STDERR $a; warn $a;
utf8::upgrade($a);
print STDERR $a; warn $a;
',
qr/^\xc3\xae(?:\r?\n\xc3\xae){3}/,
# { switches => ['-CE'] }, # switches don't work with perlcc
'warn respects :utf8 layer'
);
}
fresh_perl_like(
'warn chr 300',
qr/^Wide character in warn .*\n\xc4\xac at /,
{ switches => [ "-C0" ] },
'Wide character in warn (not print)'
);
fresh_perl_like(
'warn []',
qr/^ARRAY\(0x[\da-f]+\) at /a,
{ },
'warn stringifies in the absence of $SIG{__WARN__}'
);
1;