t/op/die_except.t

   1 #!./perl -w
   2
   3 require './test.pl';
   4 use 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
  15 my($val, $err);
  16
  17 $@ = "t0\n";
  18 $val = eval {
  19         $@ = "t1\n";
  20         1;
  21 }; $err = $@;
  22 is($val, 1, "true return value from successful eval block");
  23 is($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 = $@;
  33 is($val, undef, "undefined return value from eval block with 'die'");
  34 is($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 = $@;
  42 is($val, 1, "true return value from successful eval block with localized \$@");
  43 is($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 = $@;
  54 is($val, undef,
  55     "undefined return value from eval block with 'die' and localized \$@");
  56 is($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 = $@;
  65 is($val, 1, "true return value from eval block with 'end'");
  66 is($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 = $@;
  77 is($val, undef, "undefined return value from eval block with 'end' and 'die'");
  78 is($err, "t3\n", "exception after eval block with 'end' and 'die'");
  79
  80 done_testing();