END { kill 'INT', $$ }
sub DESTROY { print "@{$_[0]}\n"; exit(14); }
my $a = bless [1];
my $b = bless [2, $a];

##</code><code>##

sub DESTROY { print "@{$_[0]}\n"; exit(14); }
my $a = bless [1];
my $b = bless [2, $a];
my $c = bless [3, $b];

##</code><code>##

3 main=ARRAY(0x80f00c4)
1

##</code><code>##

my $cleaning_up;
sub DESTROY {
    print "DESTROY @{$_[0]}\n";
    my $id = $_[0][0];
    @{$_[0]} = ();
    print "CLEAN $id\n";
    return if $cleaning_up++;
    exit(14);
}
my $a = bless [1];
my $b = bless [2, $a];
my $c = bless [3, $b];

##</code><code>##

DESTROY 3 main=ARRAY(0x80f00c4)
DESTROY 2 main=ARRAY(0x80f01b4)
DESTROY 1
CLEAN 1

##</code><code>##

use POSIX;
{
    # Fork off a parent whose role is to convert the exit status.
    my $pid = fork;
    defined($pid) or die "Fork failed because $!";
    if($pid) {
        {
            # TBD: This really ought to be `sub { kill $_[0], $pid }'
            # instead of "IGNORE", but that does bad things on
            # ctrl-C, probably because the child gets the signal
            # twice.
            local $SIG{INT} = "IGNORE";
            waitpid($pid,0);
        }
        kill &POSIX::WTERMSIG($?), $$
          if &POSIX::WIFSIGNALED($?);
        my $status = &POSIX::WEXITSTATUS($?);
        if(0x80 < $status && $status < 0xC0) {
            kill $status - 0x80, $$;
        }
        POSIX::_exit($status);
    }
}
my $termsig;
my $cleaning_up;
our $in_dtor;
sub DESTROY {
    # NOTE: Signals that arrive in this method but outside the eval
    # are still a problem.
    my $id = $_[0][0];
    local ($@, $?);
    eval {
        my $sub_dtor = $in_dtor;
        local $in_dtor = 1;
        print "DESTROY @{$_[0]}\n";
        my $id = $_[0][0];
        @{$_[0]} = ();
        print "CLEAN $id\n";
    };
    warn "Failed to deallocate $id: $@" if $@;
    return unless $termsig;
    return if $in_dtor || $cleaning_up++;
    exit(14);
}
eval {
    local $SIG{INT} = sub { $termsig = $_[0]; die "SIG$_[0]\n" };
    {
        my $a = bless [1];
        my $b = bless [2, $a];
        my $c = bless [3, $b];
    }
    0; # Must be here to make handler go out of scope last!
};
if($@) {
    die $@ unless $@ =~ /^SIG(\w+)$/;
}
END {
    if($termsig) {
        use Config;
        my @sigs = split(' ', $Config{sig_name});
        my $i=0;
        $i++ while $sigs[$i] ne $termsig;
        $? = 0x80 + $i;
    }
}