X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_ctl.c;h=37b0a20e661d8259c60e75f62aebcc79fba0e6ce;hb=9f9d9dc0a4872096e1675c61f2f645e451c07518;hp=9bacadb87f1ca3dcb49e0eefffcc250e42c500bd;hpb=f120105df5a639f1ff2bfd3294f7ac263449621f;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_ctl.c b/pp_ctl.c
index 9bacadb..37b0a20 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1402,6 +1402,9 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen)
 
 	    if (optype == OP_REQUIRE) {
 		char* msg = SvPVx(ERRSV, n_a);
+               SV *nsv = cx->blk_eval.old_namesv;
+               (void)hv_store(GvHVn(PL_incgv), SvPVX(nsv), SvCUR(nsv),
+                               &PL_sv_undef, 0);
 		DIE(aTHX_ "%sCompilation failed in require",
 		    *msg ? msg : "Unknown error\n");
 	    }
@@ -2677,7 +2680,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, PAD** padp)
     SAVETMPS;
     /* switch to eval mode */
 
-    if (PL_curcop == &PL_compiling) {
+    if (IN_PERL_COMPILETIME) {
 	SAVECOPSTASH_FREE(&PL_compiling);
 	CopSTASH_set(&PL_compiling, PL_curstash);
     }
@@ -2710,14 +2713,14 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, PAD** padp)
     PL_hints &= HINT_UTF8;
 
     /* we get here either during compilation, or via pp_regcomp at runtime */
-    runtime = (PL_curcop != &PL_compiling);
+    runtime = IN_PERL_RUNTIME;
     if (runtime)
 	runcv = find_runcv(NULL);
 
     PL_op = &dummy;
     PL_op->op_type = OP_ENTEREVAL;
     PL_op->op_flags = 0;			/* Avoid uninit warning. */
-    PUSHBLOCK(cx, CXt_EVAL|(PL_curcop == &PL_compiling ? 0 : CXp_REAL), SP);
+    PUSHBLOCK(cx, CXt_EVAL|(IN_PERL_COMPILETIME ? 0 : CXp_REAL), SP);
     PUSHEVAL(cx, 0, Nullgv);
 
     if (runtime)
@@ -2733,7 +2736,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, PAD** padp)
     /* XXX DAPM do this properly one year */
     *padp = (AV*)SvREFCNT_inc(PL_comppad);
     LEAVE;
-    if (PL_curcop == &PL_compiling)
+    if (IN_PERL_COMPILETIME)
 	PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
 #ifdef OP_IN_REGISTER
     op = PL_opsave;
@@ -2842,7 +2845,7 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
 	sv_setpv(ERRSV,"");
     if (yyparse() || PL_error_count || !PL_eval_root) {
 	SV **newsp;			/* Used by POPBLOCK. */
-	PERL_CONTEXT *cx;
+       PERL_CONTEXT *cx = &cxstack[cxstack_ix];
 	I32 optype = 0;			/* Might be reset by POPEVAL. */
 	STRLEN n_a;
 	
@@ -2861,6 +2864,9 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
 	LEAVE;
 	if (optype == OP_REQUIRE) {
 	    char* msg = SvPVx(ERRSV, n_a);
+           SV *nsv = cx->blk_eval.old_namesv;
+           (void)hv_store(GvHVn(PL_incgv), SvPVX(nsv), SvCUR(nsv),
+                          &PL_sv_undef, 0);
 	    DIE(aTHX_ "%sCompilation failed in require",
 		*msg ? msg : "Unknown error\n");
 	}
@@ -3049,9 +3055,12 @@ PP(pp_require)
 	DIE(aTHX_ "Null filename used");
     TAINT_PROPER("require");
     if (PL_op->op_type == OP_REQUIRE &&
-      (svp = hv_fetch(GvHVn(PL_incgv), name, len, 0)) &&
-      *svp != &PL_sv_undef)
-	RETPUSHYES;
+       (svp = hv_fetch(GvHVn(PL_incgv), name, len, 0))) {
+       if (*svp != &PL_sv_undef)
+           RETPUSHYES;
+       else
+           DIE(aTHX_ "Compilation failed in require");
+    }
 
     /* prepare to compile file */
 
@@ -3167,6 +3176,7 @@ PP(pp_require)
 						      PERL_SCRIPT_MODE);
 			    }
 			}
+			SP--;
 		    }
 
 		    PUTBACK;