Re: DBD::Sybase and Sybase::CTlib build problems w/ 5.8.1, Solaris, gcc

[p5sagit/p5-mst-13.2.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index 55ec3c3..37b0a20 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -676,6 +676,7 @@ PP(pp_formline)
                    s++;
            }
            sv_chop(sv,s);
+           SvSETMAGIC(sv);
            break;
 
        case FF_LINEGLOB:
@@ -892,6 +893,7 @@ PP(pp_mapstart)
 PP(pp_mapwhile)
 {
     dSP;
+    I32 gimme = GIMME_V;
     I32 items = (SP - PL_stack_base) - *PL_markstack_ptr; /* how many new items */
     I32 count;
     I32 shift;
@@ -902,7 +904,7 @@ PP(pp_mapwhile)
     ++PL_markstack_ptr[-1];
 
     /* if there are new items, push them into the destination list */
-    if (items) {
+    if (items && gimme != G_VOID) {
        /* might need to make room back there first */
        if (items > PL_markstack_ptr[-1] - PL_markstack_ptr[-2]) {
            /* XXX this implementation is very pessimal because the stack
@@ -946,7 +948,6 @@ PP(pp_mapwhile)
 
     /* All done yet? */
     if (PL_markstack_ptr[-1] > *PL_markstack_ptr) {
-       I32 gimme = GIMME_V;
 
        (void)POPMARK;                          /* pop top */
        LEAVE;                                  /* exit outer scope */
@@ -1401,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");
            }
@@ -1730,6 +1734,11 @@ PP(pp_enteriter)
     SAVETMPS;
 
     if (PL_op->op_targ) {
+       if (PL_op->op_private & OPpLVAL_INTRO) { /* for my $x (...) */
+           SvPADSTALE_off(PAD_SVl(PL_op->op_targ));
+           SAVESETSVFLAGS(PAD_SVl(PL_op->op_targ),
+                   SVs_PADSTALE, SVs_PADSTALE);
+       }
 #ifndef USE_ITHREADS
        svp = &PAD_SVl(PL_op->op_targ);         /* "my" variable */
        SAVESPTR(*svp);
@@ -1877,6 +1886,7 @@ PP(pp_return)
     switch (CxTYPE(cx)) {
     case CXt_SUB:
        popsub2 = TRUE;
+       cxstack_ix++; /* preserve cx entry on stack for use by POPSUB */
        break;
     case CXt_EVAL:
        if (!(PL_in_eval & EVAL_KEEPERR))
@@ -1939,6 +1949,7 @@ PP(pp_return)
     LEAVE;
     /* Stack values are safe: */
     if (popsub2) {
+       cxstack_ix--;
        POPSUB(cx,sv);  /* release CV and @_ ... */
     }
     else
@@ -1979,6 +1990,7 @@ PP(pp_last)
        dounwind(cxix);
 
     POPBLOCK(cx,newpm);
+    cxstack_ix++; /* temporarily protect top context */
     mark = newsp;
     switch (CxTYPE(cx)) {
     case CXt_LOOP:
@@ -2021,6 +2033,7 @@ PP(pp_last)
     PUTBACK;
 
     LEAVE;
+    cxstack_ix--;
     /* Stack values are safe: */
     switch (pop2) {
     case CXt_LOOP:
@@ -2667,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);
     }
@@ -2700,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_op && (PL_op->op_type == OP_REGCOMP);
+    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)
@@ -2723,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;
@@ -2832,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;
        
@@ -2851,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");
        }
@@ -3039,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 */
 
@@ -3157,6 +3176,7 @@ PP(pp_require)
                                                      PERL_SCRIPT_MODE);
                            }
                        }
+                       SP--;
                    }
 
                    PUTBACK;