From: Perl 5 Porters <perl5-porters@africa.nicoh.com>
Date: Thu, 10 Oct 1996 02:32:22 +0000 (-0400)
Subject: perl 5.003_07: perl.c
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5dd60ef702f13979d7cdbe7873525b4e84a08924;p=p5sagit%2Fp5-mst-13.2.git

perl 5.003_07: perl.c

Date: Wed, 9 Oct 1996 19:03:41 +0000
From: Tim Bunce <Tim.Bunce@ig.co.uk>
Subject: Infinte loop with perl_destruct_level and $SIG{__WARN__}

I've just started using purify on a perl with DBD::Oracle linked in
(the number of uninitialised memory reads in the Oracle libraries
is frightning!).

If perl_destruct_level and $SIG{__WARN__} are set then I see a range
of problems typified by this example and folowed by a core dump:

Date: Wed, 9 Oct 1996 22:32:22 -0400 (EDT)
From: Ilya Zakharevich <ilya@math.ohio-state.edu>

Copywrite of OS/2 port now has \n\n.
Now deletes -e file (again!) if compilation is interrupted.
---

diff --git a/perl.c b/perl.c
index f51bdc3..b340b73 100644
--- a/perl.c
+++ b/perl.c
@@ -189,6 +189,14 @@ register PerlInterpreter *sv_interp;
 	/* The exit() function will do everything that needs doing. */
 	return;
     }
+
+    /* unhook hooks which may now point to, or use, broken code	*/
+    if (warnhook && SvREFCNT(warnhook))
+	SvREFCNT_dec(warnhook);
+    if (diehook && SvREFCNT(diehook))
+	SvREFCNT_dec(diehook);
+    if (parsehook && SvREFCNT(parsehook))
+	SvREFCNT_dec(parsehook);
     
     /* Prepare to destruct main symbol table.  */
     hv = defstash;
@@ -1294,7 +1302,7 @@ char *s;
 	printf("MS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n");
 #endif
 #ifdef OS2
-	printf("OS/2 port Copyright (c) 1990, 1991, Raymond Chen, Kai Uwe Rommel\n"
+	printf("\n\nOS/2 port Copyright (c) 1990, 1991, Raymond Chen, Kai Uwe Rommel\n"
 	    "Version 5 port Copyright (c) 1994-1996, Andreas Kaiser, Ilya Zakharevich\n");
 #endif
 #ifdef atarist
@@ -1590,6 +1598,9 @@ sed %s -e \"/^[^#]/b\" \
 	fcntl(PerlIO_fileno(rsfp),F_SETFD,1);	/* ensure close-on-exec */
 #endif
     }
+    if (e_tmpname) {
+	e_fp = rsfp;
+    }
     if ((PerlIO*)rsfp == Nullfp) {
 #ifdef DOSUID
 #ifndef IAMSUID		/* in case script is not readable before setuid */