t/op/die_except.t

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