remove kludgey duplicate background error avoidance (caused

"leaks"; %@ wasn't even user-visible under -Dusethreads);
only repeats of most recent error are now avoided

p4raw-id: //depot/perl@4316

diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs
index 09d063a..a57f477 100644 (file)
--- a/ext/Thread/Thread.xs
+++ b/ext/Thread/Thread.xs
@@ -159,7 +159,6 @@ threadstart(void *arg)
     SvREFCNT_dec(thr->threadsv);
     SvREFCNT_dec(thr->specific);
     SvREFCNT_dec(thr->errsv);
-    SvREFCNT_dec(thr->errhv);
 
     /*Safefree(cxstack);*/
     while (PL_curstackinfo->si_next)

diff --git a/perl.c b/perl.c
index 436fd88..d7d7a57 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -2920,7 +2920,6 @@ S_init_main_thread(pTHX)
     thr->threadsv = newAV();
     /* thr->threadsvp is set when find_threadsv is called */
     thr->specific = newAV();
-    thr->errhv = newHV();
     thr->flags = THRf_R_JOINABLE;
     MUTEX_INIT(&thr->mutex);
     /* Handcraft thrsv similarly to mess_sv */

diff --git a/perl.h b/perl.h
index 574e7f7..60881c0 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -684,16 +684,16 @@ Free_t   Perl_mfree (Malloc_t where);
 
 #ifdef USE_THREADS
 #  define ERRSV (thr->errsv)
-#  define ERRHV (thr->errhv)
 #  define DEFSV THREADSV(0)
 #  define SAVE_DEFSV save_threadsv(0)
 #else
 #  define ERRSV GvSV(PL_errgv)
-#  define ERRHV GvHV(PL_errgv)
 #  define DEFSV GvSV(PL_defgv)
 #  define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
 #endif /* USE_THREADS */
 
+#define ERRHV GvHV(PL_errgv)   /* XXX unused, here for compatibility */
+
 #ifndef errno
        extern int errno;     /* ANSI allows errno to be an lvalue expr.
                               * For example in multithreaded environments

diff --git a/pp_ctl.c b/pp_ctl.c
index c2409ba..a2b3139 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1272,26 +1272,25 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen)
 
        if (message) {
            if (PL_in_eval & EVAL_KEEPERR) {
-               SV **svp;
-               
-               svp = hv_fetch(ERRHV, message, msglen, TRUE);
-               if (svp) {
-                   if (!SvIOK(*svp)) {
-                       static char prefix[] = "\t(in cleanup) ";
-                       SV *err = ERRSV;
-                       sv_upgrade(*svp, SVt_IV);
-                       (void)SvIOK_only(*svp);
-                       if (!SvPOK(err))
-                           sv_setpv(err,"");
-                       SvGROW(err, SvCUR(err)+sizeof(prefix)+msglen);
-                       sv_catpvn(err, prefix, sizeof(prefix)-1);
-                       sv_catpvn(err, message, msglen);
-                       if (ckWARN(WARN_UNSAFE)) {
-                           STRLEN start = SvCUR(err)-msglen-sizeof(prefix)+1;
-                           Perl_warner(aTHX_ WARN_UNSAFE, SvPVX(err)+start);
-                       }
+               static char prefix[] = "\t(in cleanup) ";
+               SV *err = ERRSV;
+               char *e = Nullch;
+               if (!SvPOK(err))
+                   sv_setpv(err,"");
+               else if (SvCUR(err) >= sizeof(prefix)+msglen-1) {
+                   e = SvPV(err, n_a);
+                   e += n_a - msglen;
+                   if (*e != *message || strNE(e,message))
+                       e = Nullch;
+               }
+               if (!e) {
+                   SvGROW(err, SvCUR(err)+sizeof(prefix)+msglen);
+                   sv_catpvn(err, prefix, sizeof(prefix)-1);
+                   sv_catpvn(err, message, msglen);
+                   if (ckWARN(WARN_UNSAFE)) {
+                       STRLEN start = SvCUR(err)-msglen-sizeof(prefix)+1;
+                       Perl_warner(aTHX_ WARN_UNSAFE, SvPVX(err)+start);
                    }
-                   sv_inc(*svp);
                }
            }
            else

diff --git a/thrdvar.h b/thrdvar.h
index 2b64b7e..d228ee2 100644 (file)
--- a/thrdvar.h
+++ b/thrdvar.h
@@ -213,7 +213,6 @@ PERLVAR(threadsv,   AV *)           /* Per-thread SVs ($_, $@ etc.) */
 PERLVAR(threadsvp,     SV **)          /* AvARRAY(threadsv) */
 PERLVAR(specific,      AV *)           /* Thread-specific user data */
 PERLVAR(errsv,         SV *)           /* Backing SV for $@ */
-PERLVAR(errhv,         HV *)           /* HV for what was %@ in pp_ctl.c */
 PERLVAR(mutex,         perl_mutex)     /* For the fields others can change */
 PERLVAR(tid,           U32)
 PERLVAR(prev,          struct perl_thread *)

diff --git a/util.c b/util.c
index d9f289b..5835556 100644 (file)
--- a/util.c
+++ b/util.c
@@ -3393,7 +3393,6 @@ Perl_new_struct_thread(pTHX_ struct perl_thread *t)
     thr->threadsv = newAV();
     thr->specific = newAV();
     thr->errsv = newSVpvn("", 0);
-    thr->errhv = newHV();
     thr->flags = THRf_R_JOINABLE;
     MUTEX_INIT(&thr->mutex);