[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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
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 (file)
--- 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;