t/op/die_except.t

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