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