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);
  23 is($err, "");
  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);
  34 is($err, "t3\n");
  35
  36 $@ = "t0\n";
  37 $val = eval {
  38         $@ = "t1\n";
  39         local $@ = "t2\n";
  40         1;
  41 }; $err = $@;
  42 is($val, 1);
  43 is($err, "");
  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 is($err, "t3\n");
  56
  57 $@ = "t0\n";
  58 $val = eval {
  59         $@ = "t1\n";
  60         my $c = end { $@ = "t2\n"; };
  61         1;
  62 }; $err = $@;
  63 is($val, 1);
  64 is($err, "");
  65
  66 $@ = "t0\n";
  67 $val = eval {
  68         $@ = "t1\n";
  69         my $c = end { $@ = "t2\n"; };
  70         do {
  71                 die "t3\n";
  72         };
  73         1;
  74 }; $err = $@;
  75 is($val, undef);
  76 is($err, "t3\n");
  77
  78 done_testing();