X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_ctl.c;h=9753fcfa76f080fc18116e88d1407f15859dd3c7;hb=1d603a678689f1e74cf73914a432b2a8d38be470;hp=9590271e8789dac05967cf4ce9e27360a970087d;hpb=93965878572d85daec78ce5ce1926f613d93803b;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_ctl.c b/pp_ctl.c
index 9590271..9753fcf 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -86,10 +86,12 @@ PP(pp_regcomp) {
     else {
 	t = SvPV(tmpstr, len);
 
-	/* JMR: Check against the last compiled regexp */
-	if ( ! pm->op_pmregexp  || ! pm->op_pmregexp->precomp
-	    || strnNE(pm->op_pmregexp->precomp, t, len) 
-	    || pm->op_pmregexp->precomp[len]) {
+	/* JMR: Check against the last compiled regexp
+	   To know for sure, we'd need the length of precomp.
+	   But we don't have it, so we must ... take a guess. */
+	if (!pm->op_pmregexp || !pm->op_pmregexp->precomp ||
+	    memNE(pm->op_pmregexp->precomp, t, len + 1))
+	{
 	    if (pm->op_pmregexp) {
 		ReREFCNT_dec(pm->op_pmregexp);
 		pm->op_pmregexp = Null(REGEXP*);	/* crucial if regcomp aborts */
@@ -547,7 +549,7 @@ PP(pp_grepstart)
     SAVETMPS;
 #ifdef USE_THREADS
     /* SAVE_DEFSV does *not* suffice here */
-    save_sptr(av_fetch(thr->threadsv, find_threadsv("_"), FALSE));
+    save_sptr(&THREADSV(0));
 #else
     SAVESPTR(GvSV(defgv));
 #endif /* USE_THREADS */
@@ -1009,7 +1011,7 @@ dounwind(I32 cxix)
     while (cxstack_ix > cxix) {
 	cx = &cxstack[cxstack_ix];
 	DEBUG_l(PerlIO_printf(Perl_debug_log, "Unwinding block %ld, type %s\n",
-			      (long) cxstack_ix+1, block_type[cx->cx_type]));
+			      (long) cxstack_ix, block_type[cx->cx_type]));
 	/* Note: we don't need to restore the base context info till the end. */
 	switch (cx->cx_type) {
 	case CXt_SUBST:
@@ -1132,6 +1134,7 @@ PP(pp_caller)
     register PERL_CONTEXT *cx;
     I32 dbcxix;
     I32 gimme;
+    HV *hv;
     SV *sv;
     I32 count = 0;
 
@@ -1161,14 +1164,22 @@ PP(pp_caller)
     }
 
     if (GIMME != G_ARRAY) {
-	dTARGET;
-
-	sv_setpv(TARG, HvNAME(cx->blk_oldcop->cop_stash));
-	PUSHs(TARG);
+	hv = cx->blk_oldcop->cop_stash;
+	if (!hv)
+	    PUSHs(&sv_undef);
+	else {
+	    dTARGET;
+	    sv_setpv(TARG, HvNAME(hv));
+	    PUSHs(TARG);
+	}
 	RETURN;
     }
 
-    PUSHs(sv_2mortal(newSVpv(HvNAME(cx->blk_oldcop->cop_stash), 0)));
+    hv = cx->blk_oldcop->cop_stash;
+    if (!hv)
+	PUSHs(&sv_undef);
+    else
+	PUSHs(sv_2mortal(newSVpv(HvNAME(hv), 0)));
     PUSHs(sv_2mortal(newSVpv(SvPVX(GvSV(cx->blk_oldcop->cop_filegv)), 0)));
     PUSHs(sv_2mortal(newSViv((I32)cx->blk_oldcop->cop_line)));
     if (!MAXARG)
@@ -1336,8 +1347,9 @@ PP(pp_enteriter)
 	SAVESPTR(*svp);
     }
     else {
-	svp = &GvSV((GV*)POPs);			/* symbol table variable */
-	SAVESPTR(*svp);
+	GV *gv = (GV*)POPs;
+	(void)save_scalar(gv);
+	svp = &GvSV(gv);			/* symbol table variable */
     }
 
     ENTER;
@@ -1710,8 +1722,11 @@ PP(pp_goto)
 	    if (cxix < cxstack_ix)
 		dounwind(cxix);
 	    TOPBLOCK(cx);
+	    if (cx->cx_type == CXt_EVAL && cx->blk_eval.old_op_type == OP_ENTEREVAL) 
+		DIE("Can't goto subroutine from an eval-string");
 	    mark = stack_sp;
-	    if (cx->blk_sub.hasargs) {   /* put @_ back onto stack */
+	    if (cx->cx_type == CXt_SUB &&
+		cx->blk_sub.hasargs) {   /* put @_ back onto stack */
 		AV* av = cx->blk_sub.argarray;
 		
 		items = AvFILLp(av) + 1;
@@ -1726,7 +1741,8 @@ PP(pp_goto)
 		AvREAL_off(av);
 		av_clear(av);
 	    }
-	    if (!(CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth))
+	    if (cx->cx_type == CXt_SUB &&
+		!(CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth))
 		SvREFCNT_dec(cx->blk_sub.cv);
 	    oldsave = scopestack[scopestack_ix - 1];
 	    LEAVE_SCOPE(oldsave);
@@ -1756,6 +1772,12 @@ PP(pp_goto)
 	    else {
 		AV* padlist = CvPADLIST(cv);
 		SV** svp = AvARRAY(padlist);
+		if (cx->cx_type == CXt_EVAL) {
+		    in_eval = cx->blk_eval.old_in_eval;
+		    eval_root = cx->blk_eval.old_eval_root;
+		    cx->cx_type = CXt_SUB;
+		    cx->blk_sub.hasargs = 0;
+		}
 		cx->blk_sub.cv = cv;
 		cx->blk_sub.olddepth = CvDEPTH(cv);
 		CvDEPTH(cv)++;
@@ -2162,6 +2184,7 @@ doeval(int gimme, OP** startop)
     HV *newstash;
     CV *caller;
     AV* comppadlist;
+    I32 i;
 
     in_eval = 1;
 
@@ -2178,6 +2201,16 @@ doeval(int gimme, OP** startop)
     SAVEI32(max_intro_pending);
 
     caller = compcv;
+    for (i = cxstack_ix - 1; i >= 0; i--) {
+	PERL_CONTEXT *cx = &cxstack[i];
+	if (cx->cx_type == CXt_EVAL)
+	    break;
+	else if (cx->cx_type == CXt_SUB) {
+	    caller = cx->blk_sub.cv;
+	    break;
+	}
+    }
+
     SAVESPTR(compcv);
     compcv = (CV*)NEWSV(1104,0);
     sv_upgrade((SV *)compcv, SVt_PVCV);
@@ -2325,6 +2358,7 @@ PP(pp_require)
     register PERL_CONTEXT *cx;
     SV *sv;
     char *name;
+    STRLEN len;
     char *tryname;
     SV *namesv = Nullsv;
     SV** svp;
@@ -2339,12 +2373,12 @@ PP(pp_require)
 		SvPV(sv,na),patchlevel);
 	RETPUSHYES;
     }
-    name = SvPV(sv, na);
-    if (!*name)
+    name = SvPV(sv, len);
+    if (!(name && len > 0 && *name))
 	DIE("Null filename used");
     TAINT_PROPER("require");
     if (op->op_type == OP_REQUIRE &&
-      (svp = hv_fetch(GvHVn(incgv), name, SvCUR(sv), 0)) &&
+      (svp = hv_fetch(GvHVn(incgv), name, len, 0)) &&
       *svp != &sv_undef)
 	RETPUSHYES;
 
@@ -2606,6 +2640,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))
@@ -2614,13 +2649,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);
 }