Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

Re: Propagating a Signal from DESTROY

by dpuu (Chaplain)
on Aug 20, 2004 at 00:06 UTC ( #384500=note: print w/ replies, xml ) Need Help??


in reply to 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
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
Re^2: Propagating a Signal from DESTROY
by topnerd (Initiate) on Aug 21, 2004 at 01:27 UTC
    Executive summary: What dpuu proposes is a mess, once you get it working.

    Gory Details

    Aside from the obvious limitation that there is absolutely no way to handle the signal other than by termination, it's tricky to get this to work.

    Consider the following example:

    END { kill 'INT', $$ } sub DESTROY { print "@{$_[0]}\n"; exit(14); } my $a = bless [1]; my $b = bless [2, $a];
    This prints "2 main=ARRAY(0x80f01b4)" (or some such). Note that $a is not being destructed. Apparently, perl loses track of the fact that its reference count is going to zero before it calls the END block, and since the END block kills the process, there is no opportunity for mark-and-sweep.

    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];
    which prints:
    3 main=ARRAY(0x80f00c4) 1
    It appears that exiting during mark-and-sweep terminates garbage collection.

    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];
    which prints (under Perl 5.6.1 -- perl5.8.2 is OK):
    DESTROY 3 main=ARRAY(0x80f00c4) DESTROY 2 main=ARRAY(0x80f01b4) DESTROY 1 CLEAN 1
    The problem here is that the exit at the bottom of the call stack obliterates the stack up through destroying $c.

    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; } }

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://384500]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others perusing the Monastery: (10)
As of 2014-09-02 21:57 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite cookbook is:










    Results (31 votes), past polls