[perl #93320] localising @DB::args leads to coredump

[perl5.git] / t / op / die_unwind.t

#!./perl -w

require './test.pl';
use strict;

#
# This test checks for $@ being set early during an exceptional
# unwinding, and that this early setting doesn't affect the late
# setting used to emit the exception from eval{}.  The early setting is
# a backward-compatibility hack to satisfy modules that were relying on
# the historical early setting in order to detect exceptional unwinding.
# This hack should be removed when a proper way to detect exceptional
# unwinding has been developed.
#

{
    package End;
    sub DESTROY { $_[0]->() }
    sub main::end(&) {
	my($cleanup) = @_;
	return bless(sub { $cleanup->() }, "End");
    }
}

my($uerr, $val, $err);

$@ = "";
$val = eval {
	my $c = end { $uerr = $@; $@ = "t2\n"; };
	1;
}; $err = $@;
is($uerr, "");
is($val, 1);
is($err, "");

$@ = "t0\n";
$val = eval {
	$@ = "t1\n";
	my $c = end { $uerr = $@; $@ = "t2\n"; };
	1;
}; $err = $@;
is($uerr, "t1\n");
is($val, 1);
is($err, "");

$@ = "";
$val = eval {
	my $c = end { $uerr = $@; $@ = "t2\n"; };
	do {
		die "t3\n";
	};
	1;
}; $err = $@;
is($uerr, "t3\n");
is($val, undef);
is($err, "t3\n");

$@ = "t0\n";
$val = eval {
	$@ = "t1\n";
	my $c = end { $uerr = $@; $@ = "t2\n"; };
	do {
		die "t3\n";
	};
	1;
}; $err = $@;
is($uerr, "t3\n");
is($val, undef);
is($err, "t3\n");

done_testing();