Hi,
the attached patch wraps ckWARN_d around the Perl_warn calls in
threads.xs so that these default warnings can be switched off using "no
warnings 'threads'" or the -X switch. Also included the corresponding
changes to perldiag.pod.
I wasn't quite sure what to do with
Perl_warn(aTHX_ "CLONE %" SVf,obj);
For now I added ckWARN_d there, too. But I think a real and descriptive
warning message is needed there, something like "Attempt to clone
non-thread object" or so. Then again, I am not even sure this warning is
ever emitted.
Cheers,
Tassilo
--
use bigint;
$n=71423350343770280161397026330337371139054411854220053437565440;
$m=-8,;;$_=$n&(0xff)<<$m,,$_>>=$m,,print+chr,,while(($m+=8)<=200);
--- perl-current/ext/threads/threads.xs~ 2005-08-07 06:48:14.000000000
+0200
+++ perl-current/ext/threads/threads.xs 2005-08-07 06:52:15.000000000 +0200
@@ -168,8 +168,9 @@ Perl_ithread_hook(pTHX)
int veto_cleanup = 0;
MUTEX_LOCK(&create_destruct_mutex);
if (aTHX == PL_curinterp && active_threads != 1) {
- Perl_warn(aTHX_ "A thread exited while %" IVdf " threads were running",
- (IV)active_threads);
+ if (ckWARN_d(WARN_THREADS))
+ Perl_warn(aTHX_ "A thread exited while %" IVdf " threads were
running",
+ (IV)active_threads);
veto_cleanup = 1;
}
MUTEX_UNLOCK(&create_destruct_mutex);
@@ -304,7 +305,7 @@ Perl_ithread_run(void * arg) {
SV *sv = POPs;
av_store(params, i, SvREFCNT_inc(sv));
}
- if (SvTRUE(ERRSV)) {
+ if (SvTRUE(ERRSV) && ckWARN_d(WARN_THREADS)) {
Perl_warn(aTHX_ "thread failed to start: %" SVf, ERRSV);
}
FREETMPS;
@@ -566,14 +567,12 @@ Perl_ithread_self (pTHX_ SV *obj, char*
void
Perl_ithread_CLONE(pTHX_ SV *obj)
{
- if (SvROK(obj))
- {
- ithread *thread = SV_to_ithread(aTHX_ obj);
- }
- else
- {
- Perl_warn(aTHX_ "CLONE %" SVf,obj);
- }
+ if (SvROK(obj)) {
+ ithread *thread = SV_to_ithread(aTHX_ obj);
+ }
+ else if (ckWARN_d(WARN_THREADS)) {
+ Perl_warn(aTHX_ "CLONE %" SVf,obj);
+ }
}
AV*
--- perl-current/ext/threads/threads.pm~ 2005-08-07 07:07:12.000000000
+0200
+++ perl-current/ext/threads/threads.pm 2005-08-07 07:07:39.000000000 +0200
@@ -50,7 +50,7 @@ our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'
our @EXPORT = qw(
async
);
-our $VERSION = '1.06';
+our $VERSION = '1.07';
# || 0 to ensure compatibility with previous versions
--- perl-current/pod/perldiag.pod~ 2005-08-07 06:52:24.000000000 +0200
+++ perl-current/pod/perldiag.pod 2005-08-07 06:54:01.000000000 +0200
@@ -193,7 +193,7 @@ know which context to supply to the righ
=item A thread exited while %d threads were running
-(W) When using threaded Perl, a thread (not necessarily the main
+(W threads)(S) When using threaded Perl, a thread (not necessarily the main
thread) exited while there were still other threads running.
Usually it's a good idea to first collect the return values of the
created threads by joining them, and only then exit from the main
@@ -3875,7 +3875,7 @@ target of the change to
=item thread failed to start: %s
-(S) The entry point function of threads->create() failed for some reason.
+(W threads)(S) The entry point function of threads->create() failed for some
reason.
=item times not implemented
