I have modified the 'threads' module based upon the consensus I have
received so far. (Thanks to those that responded.)
The only problem I have left is cleaning up 'unbalanced' messages when
a thread warning handler (interacting with a thread termination
message) dies/exits. For example, this:
use threads;
threads->create(sub {
$SIG{'__WARN__'} = sub {
my $msg = $_[0];
print("WARNING: $msg");
die("__WARN__ dying\n");
};
die("Thread dying\n");
})->join();
produces:
WARNING: Thread 1 terminated abnormally: Thread dying
__WARN__ dying
Unbalanced scopes: 3 more ENTERs than LEAVEs
Unbalanced saves: 33 more saves than restores
Unbalanced tmps: 2 more allocs than frees
In threads.xs, the 'die/exit' in the warn handler is 'contained' using
a JMPENV:
/* Check for failure */
if (SvTRUE(ERRSV) && ckWARN_d(WARN_THREADS)) {
oldscope = PL_scopestack_ix;
JMPENV_PUSH(jmp_rc);
if (jmp_rc == 0) {
Perl_warn(aTHX_ "Thread %" UVuf " terminated abnormally:
%" SVf, thread->tid, ERRSV);
while (PL_scopestack_ix oldscope) {
LEAVE;
}
}
JMPENV_PP;
}
Evidently, this is not sufficient. Would someone please fill me in on
what else is needed? Attached is the version of the threads module
for your convenience.
Also attached is a script called 'nasty.pl' that tests all the various
combinations of termination methods for threads, warn handlers and die
handlers. If we can get that script to run cleanly (i.e., no
'unbalanced' messages), then we're in business.
Thanks.

Wed, 28 Jun 2006, Jerry D. Hedden wrote:
In threads.xs, the 'die/exit' in the warn handler is 'contained'
using a JMPENV:

/* Check for failure */
if (SvTRUE(ERRSV) && ckWARN_d(WARN_THREADS)) {
oldscope = PL_scopestack_ix;
JMPENV_PUSH(jmp_rc);
if (jmp_rc == 0) {
Perl_warn(aTHX_ "Thread %" UVuf " terminated
abnormally:
%" SVf, thread->tid, ERRSV);
while (PL_scopestack_ix oldscope) {
LEAVE;
}
}
JMPENV_PP;
}

Sorry, I'm still very busy and have no time to try this myself, but the
code above looks wrong. You need to do the scope cleanup when my_exit()
has been called, not in the standard code path. Something like:

oldscope = PL_scopestack_ix;
JMPENV_PUSH(rc);
if (rc == 0)
Perl_warn();
else if (rc == 2) {
/* Perl_warn() called my_exit() */
while (PL_scopestack_ix oldscope) {
LEAVE;
}
}
JMPENV_PP;

Cheers,
-Jan