Re: Propagating a Signal from DESTROY

As long as the only reason for catching the "die" is to rethrow the signal (and thus get correct error code), you could try something like this:

my $dead = 0;

END { print "END: dead=$dead\n" }

sub DESTROY {
   print "DESTROY: @{$_[0]}\n";
   return if $dead;
   print "die...\n";
   $dead = 1;
   exit(1);
}

my $a = bless [1];
{ bless [2] }
print "at end";

__END__
DESTROY: 2
die...
DESTROY: 1
END: dead=1
[download]

You can catch "exit" in the END block, and use my $dead variable as the flag that tells you that you exited with something more to do. If you wanted to continue after your "eval" catches the error though, then this wouldn't work.

--Dave
Opinions my own; statements of fact may be in error.

Comment on Re: Propagating a Signal from DESTROY Download Code

Replies are listed 'Best First'.

Re^2: Propagating a Signal from DESTROY
by topnerd (Initiate) on Aug 21, 2004 at 01:27 UTC

Executive summary:

Gory Details

Consider the following example:

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

2 main=ARRAY(0x80f01b4)

If we don't worry about propagating the status properly, then we still have problems. Consider the following:

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

3 main=ARRAY(0x80f00c4)
1
[download]

Just dying once doesn't work either:

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];
[download]

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

We can fix these problems like this (brace yourself):

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;
    }
}
[download]

[reply]
[d/l]
[select]


"be consistent"
	PerlMonks