blob: 80c4c02e9a1bc461a1936595c6b1fd4da0238787 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
#!perl -w
BEGIN {
chdir 't' if -d 't';
require './test.pl';
}
plan(24);
sub End::DESTROY { $_[0]->() }
sub end(&) {
my($c) = @_;
return bless(sub { $c->() }, "End");
}
foreach my $inx ("", "aabbcc\n", [qw(aa bb cc)]) {
foreach my $outx ("", "xxyyzz\n", [qw(xx yy zz)]) {
my $warn = "";
local $SIG{__WARN__} = sub { $warn .= $_[0] };
{
$@ = $outx;
my $e = end { die $inx if $inx };
}
ok ref($@) eq ref($outx) && $@ eq $outx;
$warn =~ s/ at [^\n]*\n\z//;
is $warn, $inx ? "\t(in cleanup) $inx" : "";
}
}
{
no warnings "misc";
my $warn = "";
local $SIG{__WARN__} = sub { $warn .= $_[0] };
{ my $e = end { no warnings "misc"; die "aa\n"; }; }
is $warn, "";
}
{
no warnings "misc";
my $warn = "";
local $SIG{__WARN__} = sub { $warn .= $_[0] };
{ my $e = end { use warnings "misc"; die "aa\n"; }; }
is $warn, "\t(in cleanup) aa\n";
}
{
my $warn = "";
local $SIG{__WARN__} = sub { $warn .= $_[0] };
{ my $e = end { no warnings "misc"; die "aa\n"; }; }
is $warn, "";
}
{
my $warn = "";
local $SIG{__WARN__} = sub { $warn .= $_[0] };
{ my $e = end { use warnings "misc"; die "aa\n"; }; }
is $warn, "\t(in cleanup) aa\n";
}
{
use warnings "misc";
my $warn = "";
local $SIG{__WARN__} = sub { $warn .= $_[0] };
{ my $e = end { no warnings "misc"; die "aa\n"; }; }
is $warn, "";
}
{
use warnings "misc";
my $warn = "";
local $SIG{__WARN__} = sub { $warn .= $_[0] };
{ my $e = end { use warnings "misc"; die "aa\n"; }; }
is $warn, "\t(in cleanup) aa\n";
}
1;
|
