xref: /openbsd-src/gnu/usr.bin/perl/t/op/catch.t (revision f2a19305cfc49ea4d1a5feb55cd6c283c6f1e031)
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
9BEGIN {
10    chdir 't' if -d 't';
11    require './test.pl';
12    set_up_inc('../lib');
13}
14
15use warnings;
16use strict;
17
18plan 12;
19
20{
21    package EvalOnFetch;
22    sub TIESCALAR { bless \(my $z = $_[1]), $_[0] }
23    sub FETCH { eval ${$_[0]} // "died" }
24}
25
26tie my $begindie, "EvalOnFetch", "BEGIN { die } 123";
27is "$begindie", "died";
28tie my $unitcheckdie, "EvalOnFetch", "UNITCHECK { die } 123";
29is "$unitcheckdie", "died";
30tie my $rundie, "EvalOnFetch", "die; 123";
31is "$rundie", "died";
32tie my $runok, "EvalOnFetch", "123";
33is "$runok", 123;
34
35eval { undef };
36is eval "BEGIN { die } 123", undef;
37is eval "UNITCHECK { die } 123", undef;
38is eval "die; 123", undef;
39is 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
47tie my $trydie, "TryOnFetch", 1;
48is "$trydie", "died";
49tie my $tryok, "TryOnFetch", 0;
50is "$tryok", 123;
51
52eval { undef };
53is do { eval { die; 123 } }, undef;
54is do { eval { undef; 123 } }, 123;
55
561;
57