The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!./perl
#line 3 warn.t

print "1..18\n";
my $test_num = 0;
sub ok {
    print $_[0] ? "" : "not ", "ok ", ++$test_num, "\n";
}

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 26.\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 36.\n";

@warnings = ();
$@ = "";
warn;
ok @warnings==1 &&
    $warnings[0] eq "Warning: something's wrong at warn.t line 42.\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 58.\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 68.\n";

@warnings = ();
$@ = "ERR\n";
warn;
ok @warnings==1 &&
    $warnings[0] eq "ERR\n\t...caught at warn.t line 74.\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 90.\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;

1;