t/op/catch.t

   1 #!perl
   2
   3 # Test that exception catching is set up early enough when executing
   4 # pp_entereval() etc. There used to be a gap where an exception could
   5 # be raised before perl was ready to catch it.
   6 #
   7 # RT #105930: eval 'UNITCHECK{die}' crashes inside FETCH
   8
   9 BEGIN {
  10     chdir 't' if -d 't';
  11     require './test.pl';
  12     set_up_inc('../lib');
  13 }
  14
  15 use warnings;
  16 use strict;
  17
  18 plan 12;
  19
  20 {
  21     package EvalOnFetch;
  22     sub TIESCALAR { bless \(my $z = $_[1]), $_[0] }
  23     sub FETCH { eval ${$_[0]} // "died" }
  24 }
  25
  26 tie my $begindie, "EvalOnFetch", "BEGIN { die } 123";
  27 is "$begindie", "died";
  28 tie my $unitcheckdie, "EvalOnFetch", "UNITCHECK { die } 123";
  29 is "$unitcheckdie", "died";
  30 tie my $rundie, "EvalOnFetch", "die; 123";
  31 is "$rundie", "died";
  32 tie my $runok, "EvalOnFetch", "123";
  33 is "$runok", 123;
  34
  35 eval { undef };
  36 is eval "BEGIN { die } 123", undef;
  37 is eval "UNITCHECK { die } 123", undef;
  38 is eval "die; 123", undef;
  39 is eval "123", 123;
  40
  41 {
  42     package TryOnFetch;
  43     sub TIESCALAR { bless \(my $z = $_[1]), $_[0] }
  44     sub FETCH { eval { ${$_[0]} ? die : undef; 123 } // "died" }
  45 }
  46
  47 tie my $trydie, "TryOnFetch", 1;
  48 is "$trydie", "died";
  49 tie my $tryok, "TryOnFetch", 0;
  50 is "$tryok", 123;
  51
  52 eval { undef };
  53 is do { eval { die; 123 } }, undef;
  54 is do { eval { undef; 123 } }, 123;
  55
  56 1;