develooper Front page | perl.perl5.porters | Postings from October 1999

Re: Memory leak with tie()

Thread Previous | Thread Next
From:
Gurusamy Sarathy
Date:
October 8, 1999 03:46
Subject:
Re: Memory leak with tie()
Message ID:
199910081048.DAA11800@activestate.com
On Mon, 27 Sep 1999 14:16:00 BST, "M.J.T. Guy" wrote:
>I tried the test case under perl5.005_61  -  the leak/non-leak
>behaviour is the same.    So there's still some bug in Perl.
>
>Under 5.005_61, the leaky version generated on STDERR
>
>	(in cleanup) Not a HASH reference at temp.leak line 20, <> line 1.
>
>repeated for each line of input.   But the non-leaky version only
>generates one message
>
>	(in cleanup) Not a HASH reference at temp.leak line 20.
>
>So the cause of the leak is presumably associated with whatever is
>generating that error message.

Try this.


Sarathy
gsar@activestate.com
-----------------------------------8<-----------------------------------
Change 4316 by gsar@auger on 1999/10/08 10:26:15

	remove kludgey duplicate background error avoidance (caused
	"leaks"; %@ wasn't even user-visible under -Dusethreads);
	only repeats of most recent error are now avoided

Affected files ...

... //depot/perl/ext/Thread/Thread.xs#46 edit
... //depot/perl/perl.c#170 edit
... //depot/perl/perl.h#184 edit
... //depot/perl/pp_ctl.c#151 edit
... //depot/perl/thrdvar.h#35 edit
... //depot/perl/util.c#152 edit

Differences ...

==== //depot/perl/ext/Thread/Thread.xs#46 (text) ====
Index: perl/ext/Thread/Thread.xs
--- perl/ext/Thread/Thread.xs.~1~	Fri Oct  8 03:26:51 1999
+++ perl/ext/Thread/Thread.xs	Fri Oct  8 03:26:51 1999
@@ -159,7 +159,6 @@
     SvREFCNT_dec(thr->threadsv);
     SvREFCNT_dec(thr->specific);
     SvREFCNT_dec(thr->errsv);
-    SvREFCNT_dec(thr->errhv);
 
     /*Safefree(cxstack);*/
     while (PL_curstackinfo->si_next)

==== //depot/perl/perl.c#170 (text) ====
Index: perl/perl.c
--- perl/perl.c.~1~	Fri Oct  8 03:26:51 1999
+++ perl/perl.c	Fri Oct  8 03:26:51 1999
@@ -2920,7 +2920,6 @@
     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 */

==== //depot/perl/perl.h#184 (text) ====
Index: perl/perl.h
--- perl/perl.h.~1~	Fri Oct  8 03:26:51 1999
+++ perl/perl.h	Fri Oct  8 03:26:51 1999
@@ -684,15 +684,15 @@
 
 #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.

==== //depot/perl/pp_ctl.c#151 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c.~1~	Fri Oct  8 03:26:51 1999
+++ perl/pp_ctl.c	Fri Oct  8 03:26:51 1999
@@ -1272,26 +1272,25 @@
 
 	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

==== //depot/perl/thrdvar.h#35 (text) ====
Index: perl/thrdvar.h
--- perl/thrdvar.h.~1~	Fri Oct  8 03:26:51 1999
+++ perl/thrdvar.h	Fri Oct  8 03:26:51 1999
@@ -213,7 +213,6 @@
 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 *)

==== //depot/perl/util.c#152 (text) ====
Index: perl/util.c
--- perl/util.c.~1~	Fri Oct  8 03:26:51 1999
+++ perl/util.c	Fri Oct  8 03:26:51 1999
@@ -3393,7 +3393,6 @@
     thr->threadsv = newAV();
     thr->specific = newAV();
     thr->errsv = newSVpvn("", 0);
-    thr->errhv = newHV();
     thr->flags = THRf_R_JOINABLE;
     MUTEX_INIT(&thr->mutex);
 
End of Patch.

Thread Previous | Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About