From: Gurusamy Sarathy <gsar@cpan.org>
Date: Tue, 10 Feb 1998 18:21:37 +0000 (-0500)
Subject: [win32] fix extra LEAVE when require fails
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f46d017c815b0d11f074ad6c16247c01f8af2ece;hp=301d9039fb19ffce344369e333240632e80d95d5;p=p5sagit%2Fp5-mst-13.2.git

[win32] fix extra LEAVE when require fails
	Message-Id: <199802102321.SAA15346@aatma.engin.umich.edu>
	Subject: Re: evals and requires make seg-fault with bad require file

p4raw-id: //depot/win32/perl@498
---

diff --git a/MANIFEST b/MANIFEST
index 68708c1..c354458 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -684,6 +684,7 @@ t/comp/multiline.t	See if multiline strings work
 t/comp/package.t	See if packages work
 t/comp/proto.t		See if function prototypes work
 t/comp/redef.t		See if we get correct warnings on redefined subs
+t/comp/require.t	See if require works
 t/comp/script.t		See if script invokation works
 t/comp/term.t		See if more terms work
 t/comp/use.t		See if pragmas work
diff --git a/pp_ctl.c b/pp_ctl.c
index 33247e3..e5ddebe 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2629,6 +2629,7 @@ PP(pp_leaveeval)
     assert(CvDEPTH(compcv) == 1);
 #endif
     CvDEPTH(compcv) = 0;
+    lex_end();
 
     if (optype == OP_REQUIRE &&
 	!(gimme == G_SCALAR ? SvTRUE(*sp) : sp > newsp))
@@ -2637,13 +2638,13 @@ PP(pp_leaveeval)
 	char *name = cx->blk_eval.old_name;
 	(void)hv_delete(GvHVn(incgv), name, strlen(name), G_DISCARD);
 	retop = die("%s did not return a true value", name);
+	/* die_where() did LEAVE, or we won't be here */
+    }
+    else {
+	LEAVE;
+	if (!(save_flags & OPf_SPECIAL))
+	    sv_setpv(ERRSV,"");
     }
-
-    lex_end();
-    LEAVE;
-
-    if (!(save_flags & OPf_SPECIAL))
-	sv_setpv(ERRSV,"");
 
     RETURNOP(retop);
 }
diff --git a/scope.c b/scope.c
index 350ed30..8a7d0ce 100644
--- a/scope.c
+++ b/scope.c
@@ -258,12 +258,11 @@ void
 save_item(register SV *item)
 {
     dTHR;
-    register SV *sv;
+    register SV *sv = NEWSV(0,0);
 
+    sv_setsv(sv,item);
     SSCHECK(3);
     SSPUSHPTR(item);		/* remember the pointer */
-    sv = NEWSV(0,0);
-    sv_setsv(sv,item);
     SSPUSHPTR(sv);		/* remember the value */
     SSPUSHINT(SAVEt_ITEM);
 }
@@ -440,11 +439,11 @@ save_list(register SV **sarg, I32 maxsarg)
     register SV *sv;
     register I32 i;
 
-    SSCHECK(3 * maxsarg);
     for (i = 1; i <= maxsarg; i++) {
-	SSPUSHPTR(sarg[i]);		/* remember the pointer */
 	sv = NEWSV(0,0);
 	sv_setsv(sv,sarg[i]);
+	SSCHECK(3);
+	SSPUSHPTR(sarg[i]);		/* remember the pointer */
 	SSPUSHPTR(sv);			/* remember the value */
 	SSPUSHINT(SAVEt_ITEM);
     }
@@ -607,14 +606,14 @@ leave_scope(I32 base)
 	case SAVEt_GP:				/* scalar reference */
 	    ptr = SSPOPPTR;
 	    gv = (GV*)SSPOPPTR;
-            gp_free(gv);
-            GvGP(gv) = (GP*)ptr;
             if (SvPOK(gv) && SvLEN(gv) > 0) {
                 Safefree(SvPVX(gv));
             }
             SvPVX(gv) = (char *)SSPOPPTR;
             SvCUR(gv) = (STRLEN)SSPOPIV;
             SvLEN(gv) = (STRLEN)SSPOPIV;
+            gp_free(gv);
+            GvGP(gv) = (GP*)ptr;
 	    SvREFCNT_dec(gv);
             break;
 	case SAVEt_FREESV:
diff --git a/scope.h b/scope.h
index 4648d00..44bc435 100644
--- a/scope.h
+++ b/scope.h
@@ -39,8 +39,23 @@
 #define SAVETMPS save_int((int*)&tmps_floor), tmps_floor = tmps_ix
 #define FREETMPS if (tmps_ix > tmps_floor) free_tmps()
 
+#ifdef DEBUGGING
+#define ENTER							\
+    STMT_START {						\
+	push_scope();						\
+	DEBUG_l(deb("ENTER scope %ld at %s:%d\n",		\
+		    scopestack_ix, __FILE__, __LINE__));	\
+    } STMT_END
+#define LEAVE							\
+    STMT_START {						\
+	DEBUG_l(deb("LEAVE scope %ld at %s:%d\n",		\
+		    scopestack_ix, __FILE__, __LINE__));	\
+	pop_scope();						\
+    } STMT_END
+#else
 #define ENTER push_scope()
 #define LEAVE pop_scope()
+#endif
 #define LEAVE_SCOPE(old) if (savestack_ix > old) leave_scope(old)
 
 /*
diff --git a/t/comp/require.t b/t/comp/require.t
new file mode 100644
index 0000000..bae0712
--- /dev/null
+++ b/t/comp/require.t
@@ -0,0 +1,36 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = ('.');
+}
+
+# don't make this lexical
+$i = 1;
+print "1..3\n";
+
+sub do_require {
+    %INC = ();
+    open(REQ,">bleah.pm") or die "Can't write 'bleah.pm': $!";
+    print REQ @_;
+    close REQ;
+    eval { require "bleah.pm" };
+    my @a; # magic guard for scope violations (must be first lexical in file)
+}
+
+# run-time failure in require
+do_require "0;\n";
+print "# $@\nnot " unless $@ =~ /did not return a true/;
+print "ok ",$i++,"\n";
+
+# compile-time failure in require
+do_require "1)\n";
+print "# $@\nnot " unless $@ =~ /syntax error/;
+print "ok ",$i++,"\n";
+
+# successful require
+do_require "1";
+print "# $@\nnot " if $@;
+print "ok ",$i++,"\n";
+
+unlink 'bleah.pm';
diff --git a/toke.c b/toke.c
index 28c5a42..640ab67 100644
--- a/toke.c
+++ b/toke.c
@@ -672,7 +672,7 @@ static I32
 sublex_push(void)
 {
     dTHR;
-    push_scope();
+    ENTER;
 
     lex_state = sublex_info.super_state;
     SAVEI32(lex_dojoin);
@@ -758,7 +758,7 @@ sublex_done(void)
 	return ',';
     }
     else {
-	pop_scope();
+	LEAVE;
 	bufend = SvPVX(linestr);
 	bufend += SvCUR(linestr);
 	expect = XOPERATOR;