1#!./perl -w 2 3require './test.pl'; 4use strict; 5 6{ 7 package End; 8 sub DESTROY { $_[0]->() } 9 sub main::end(&) { 10 my($cleanup) = @_; 11 return bless(sub { $cleanup->() }, "End"); 12 } 13} 14 15my($val, $err); 16 17$@ = "t0\n"; 18$val = eval { 19 $@ = "t1\n"; 20 1; 21}; $err = $@; 22is($val, 1, "true return value from successful eval block"); 23is($err, "", "no exception after successful eval block"); 24 25$@ = "t0\n"; 26$val = eval { 27 $@ = "t1\n"; 28 do { 29 die "t3\n"; 30 }; 31 1; 32}; $err = $@; 33is($val, undef, "undefined return value from eval block with 'die'"); 34is($err, "t3\n", "exception after eval block with 'die'"); 35 36$@ = "t0\n"; 37$val = eval { 38 $@ = "t1\n"; 39 local $@ = "t2\n"; 40 1; 41}; $err = $@; 42is($val, 1, "true return value from successful eval block with localized \$@"); 43is($err, "", "no exception after successful eval block with localized \$@"); 44 45$@ = "t0\n"; 46$val = eval { 47 $@ = "t1\n"; 48 local $@ = "t2\n"; 49 do { 50 die "t3\n"; 51 }; 52 1; 53}; $err = $@; 54is($val, undef, 55 "undefined return value from eval block with 'die' and localized \$@"); 56is($err, "t3\n", 57 "exception after eval block with 'die' and localized \$@"); 58 59$@ = "t0\n"; 60$val = eval { 61 $@ = "t1\n"; 62 my $c = end { $@ = "t2\n"; }; 63 1; 64}; $err = $@; 65is($val, 1, "true return value from eval block with 'end'"); 66is($err, "", "no exception after eval block with 'end'"); 67 68$@ = "t0\n"; 69$val = eval { 70 $@ = "t1\n"; 71 my $c = end { $@ = "t2\n"; }; 72 do { 73 die "t3\n"; 74 }; 75 1; 76}; $err = $@; 77is($val, undef, "undefined return value from eval block with 'end' and 'die'"); 78is($err, "t3\n", "exception after eval block with 'end' and 'die'"); 79 80done_testing(); 81