Skip processing a file if the file to be opened is '-'

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

diff --git a/pp_ctl.c b/pp_ctl.c
index 3bf4f1d..bc2a361 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -792,7 +792,7 @@ PP(pp_sort)
            kid = kUNOP->op_first;                      /* pass rv2gv */
            kid = kUNOP->op_first;                      /* pass leave */
            PL_sortcop = kid->op_next;
-           stash = PL_curcop->cop_stash;
+           stash = CopSTASH(PL_curcop);
        }
        else {
            cv = sv_2cv(*++MARK, &stash, &gv, 0);
@@ -822,7 +822,7 @@ PP(pp_sort)
     }
     else {
        PL_sortcop = Nullop;
-       stash = PL_curcop->cop_stash;
+       stash = CopSTASH(PL_curcop);
     }
 
     up = myorigmark + 1;
@@ -1392,7 +1392,7 @@ PP(pp_caller)
     PERL_SI *top_si = PL_curstackinfo;
     I32 dbcxix;
     I32 gimme;
-    HV *hv;
+    char *stashname;
     SV *sv;
     I32 count = 0;
 
@@ -1428,26 +1428,24 @@ PP(pp_caller)
            cx = &ccstack[dbcxix];
     }
 
+    stashname = CopSTASHPV(cx->blk_oldcop);
     if (GIMME != G_ARRAY) {
-       hv = cx->blk_oldcop->cop_stash;
-       if (!hv)
+       if (!stashname)
            PUSHs(&PL_sv_undef);
        else {
            dTARGET;
-           sv_setpv(TARG, HvNAME(hv));
+           sv_setpv(TARG, stashname);
            PUSHs(TARG);
        }
        RETURN;
     }
 
-    hv = cx->blk_oldcop->cop_stash;
-    if (!hv)
+    if (!stashname)
        PUSHs(&PL_sv_undef);
     else
-       PUSHs(sv_2mortal(newSVpv(HvNAME(hv), 0)));
-    PUSHs(sv_2mortal(newSVpvn(SvPVX(GvSV(cx->blk_oldcop->cop_filegv)),
-                             SvCUR(GvSV(cx->blk_oldcop->cop_filegv)))));
-    PUSHs(sv_2mortal(newSViv((I32)cx->blk_oldcop->cop_line)));
+       PUSHs(sv_2mortal(newSVpv(stashname, 0)));
+    PUSHs(sv_2mortal(newSVpv(CopFILE(cx->blk_oldcop), 0)));
+    PUSHs(sv_2mortal(newSViv((I32)CopLINE(cx->blk_oldcop))));
     if (!MAXARG)
        RETURN;
     if (CxTYPE(cx) == CXt_SUB) { /* So is ccstack[dbcxix]. */
@@ -1481,7 +1479,7 @@ PP(pp_caller)
        PUSHs(&PL_sv_undef);
     }
     if (CxTYPE(cx) == CXt_SUB && cx->blk_sub.hasargs
-       && PL_curcop->cop_stash == PL_debstash)
+       && CopSTASH_eq(PL_curcop, PL_debstash))
     {
        AV *ary = cx->blk_sub.argarray;
        int off = AvARRAY(ary) - AvALLOC(ary);
@@ -1517,7 +1515,7 @@ PP(pp_reset)
        tmps = "";
     else
        tmps = POPpx;
-    sv_reset(tmps, PL_curcop->cop_stash);
+    sv_reset(tmps, CopSTASH(PL_curcop));
     PUSHs(&PL_sv_yes);
     RETURN;
 }
@@ -2139,6 +2137,9 @@ PP(pp_goto)
                                    SvPADMY_on(sv);
                                }
                            }
+                           else if (IS_PADGV(oldpad[ix])) {
+                               av_store(newpad, ix, sv = SvREFCNT_inc(oldpad[ix]));
+                           }
                            else {
                                av_store(newpad, ix, sv = NEWSV(0,0));
                                SvPADTMP_on(sv);
@@ -2436,18 +2437,20 @@ S_docatch(pTHX_ OP *o)
     dTHR;
     int ret;
     OP *oldop = PL_op;
+    volatile PERL_SI *cursi = PL_curstackinfo;
+    dJMPENV;
 
 #ifdef DEBUGGING
     assert(CATCH_GET == TRUE);
 #endif
     PL_op = o;
  redo_body:
-    CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_docatch_body));
+    CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_docatch_body));
     switch (ret) {
     case 0:
        break;
     case 3:
-       if (PL_restartop) {
+       if (PL_restartop && cursi == PL_curstackinfo) {
            PL_op = PL_restartop;
            PL_restartop = 0;
            goto redo_body;
@@ -2484,14 +2487,14 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, AV** avp)
     /* switch to eval mode */
 
     if (PL_curcop == &PL_compiling) {
-       SAVESPTR(PL_compiling.cop_stash);
-       PL_compiling.cop_stash = PL_curstash;
+       SAVECOPSTASH(&PL_compiling);
+       CopSTASH_set(&PL_compiling, PL_curstash);
     }
-    SAVESPTR(PL_compiling.cop_filegv);
-    SAVEI16(PL_compiling.cop_line);
+    SAVECOPFILE(&PL_compiling);
+    SAVECOPLINE(&PL_compiling);
     sprintf(tmpbuf, "_<(%.10s_eval %lu)", code, (unsigned long)++PL_evalseq);
-    PL_compiling.cop_filegv = gv_fetchfile(tmpbuf+2);
-    PL_compiling.cop_line = 1;
+    CopFILE_set(&PL_compiling, tmpbuf+2);
+    CopLINE_set(&PL_compiling, 1);
     /* XXX For C<eval "...">s within BEGIN {} blocks, this ends up
        deleting the eval's FILEGV from the stash before gv_check() runs
        (i.e. before run-time proper). To work around the coredump that
@@ -2511,7 +2514,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, AV** avp)
     PL_op->op_type = OP_ENTEREVAL;
     PL_op->op_flags = 0;                       /* Avoid uninit warning. */
     PUSHBLOCK(cx, CXt_EVAL, SP);
-    PUSHEVAL(cx, 0, PL_compiling.cop_filegv);
+    PUSHEVAL(cx, 0, Nullgv);
     rop = doeval(G_SCALAR, startop);
     POPBLOCK(cx,PL_curpm);
     POPEVAL(cx);
@@ -2535,7 +2538,6 @@ S_doeval(pTHX_ int gimme, OP** startop)
 {
     dSP;
     OP *saveop = PL_op;
-    HV *newstash;
     CV *caller;
     AV* comppadlist;
     I32 i;
@@ -2601,10 +2603,9 @@ S_doeval(pTHX_ int gimme, OP** startop)
 
     /* make sure we compile in the right package */
 
-    newstash = PL_curcop->cop_stash;
-    if (PL_curstash != newstash) {
+    if (CopSTASH_ne(PL_curcop, PL_curstash)) {
        SAVESPTR(PL_curstash);
-       PL_curstash = newstash;
+       PL_curstash = CopSTASH(PL_curcop);
     }
     SAVESPTR(PL_beginav);
     PL_beginav = newAV();
@@ -2667,7 +2668,7 @@ S_doeval(pTHX_ int gimme, OP** startop)
     }
     SvREFCNT_dec(PL_rs);
     PL_rs = SvREFCNT_inc(PL_nrs);
-    PL_compiling.cop_line = 0;
+    CopLINE_set(&PL_compiling, 0);
     if (startop) {
        *startop = PL_eval_root;
        SvREFCNT_dec(CvOUTSIDE(PL_compcv));
@@ -2689,7 +2690,7 @@ S_doeval(pTHX_ int gimme, OP** startop)
        if (cv) {
            dSP;
            PUSHMARK(SP);
-           XPUSHs((SV*)PL_compiling.cop_filegv);
+           XPUSHs((SV*)CopFILEGV(&PL_compiling));
            PUTBACK;
            call_sv((SV*)cv, G_DISCARD);
        }
@@ -2778,21 +2779,9 @@ PP(pp_require)
 
     /* prepare to compile file */
 
-    if (*name == '/' ||
-       (*name == '.' && 
-           (name[1] == '/' ||
-            (name[1] == '.' && name[2] == '/')))
-#ifdef DOSISH
-      || (name[0] && name[1] == ':')
-#endif
-#ifdef WIN32
-      || (name[0] == '\\' && name[1] == '\\')  /* UNC path */
-#endif
-#ifdef VMS
-       || (strchr(name,':')  || ((*name == '[' || *name == '<') &&
-           (isALNUM(name[1]) || strchr("$-_]>",name[1]))))
-#endif
-    )
+    if (PERL_FILE_IS_ABSOLUTE(name)
+       || (*name == '.' && (name[1] == '/' ||
+                            (name[1] == '.' && name[2] == '/'))))
     {
        tryname = name;
        tryrsfp = doopen_pmc(name,PERL_SCRIPT_MODE);
@@ -2817,8 +2806,8 @@ PP(pp_require)
                        loader = *av_fetch((AV *)SvRV(loader), 0, TRUE);
                    }
 
-                   Perl_sv_setpvf(aTHX_ namesv, "/loader/0x%lx/%s",
-                                  SvANY(loader), name);
+                   Perl_sv_setpvf(aTHX_ namesv, "/loader/0x%"UVxf"/%s",
+                                  PTR2UV(SvANY(loader)), name);
                    tryname = SvPVX(namesv);
                    tryrsfp = 0;
 
@@ -2936,8 +2925,8 @@ PP(pp_require)
            }
        }
     }
-    SAVESPTR(PL_compiling.cop_filegv);
-    PL_compiling.cop_filegv = gv_fetchfile(tryrsfp ? tryname : name);
+    SAVECOPFILE(&PL_compiling);
+    CopFILE_set(&PL_compiling, tryrsfp ? tryname : name);
     SvREFCNT_dec(namesv);
     if (!tryrsfp) {
        if (PL_op->op_type == OP_REQUIRE) {
@@ -2972,7 +2961,7 @@ PP(pp_require)
 
     /* Assume success here to prevent recursive requirement. */
     (void)hv_store(GvHVn(PL_incgv), name, strlen(name),
-       newSVsv(GvSV(PL_compiling.cop_filegv)), 0 );
+                  newSVpv(CopFILE(&PL_compiling), 0), 0 );
 
     ENTER;
     SAVETMPS;
@@ -3004,10 +2993,10 @@ PP(pp_require)
     /* switch to eval mode */
     push_return(PL_op->op_next);
     PUSHBLOCK(cx, CXt_EVAL, SP);
-    PUSHEVAL(cx, name, PL_compiling.cop_filegv);
+    PUSHEVAL(cx, name, Nullgv);
 
-    SAVEI16(PL_compiling.cop_line);
-    PL_compiling.cop_line = 0;
+    SAVECOPLINE(&PL_compiling);
+    CopLINE_set(&PL_compiling, 0);
 
     PUTBACK;
 #ifdef USE_THREADS
@@ -3047,10 +3036,10 @@ PP(pp_entereval)
  
     /* switch to eval mode */
 
-    SAVESPTR(PL_compiling.cop_filegv);
+    SAVECOPFILE(&PL_compiling);
     sprintf(tmpbuf, "_<(eval %lu)", (unsigned long)++PL_evalseq);
-    PL_compiling.cop_filegv = gv_fetchfile(tmpbuf+2);
-    PL_compiling.cop_line = 1;
+    CopFILE_set(&PL_compiling, tmpbuf+2);
+    CopLINE_set(&PL_compiling, 1);
     /* XXX For C<eval "...">s within BEGIN {} blocks, this ends up
        deleting the eval's FILEGV from the stash before gv_check() runs
        (i.e. before run-time proper). To work around the coredump that
@@ -3068,12 +3057,12 @@ PP(pp_entereval)
 
     push_return(PL_op->op_next);
     PUSHBLOCK(cx, (CXt_EVAL|CXp_REAL), SP);
-    PUSHEVAL(cx, 0, PL_compiling.cop_filegv);
+    PUSHEVAL(cx, 0, Nullgv);
 
     /* prepare to compile string */
 
     if (PERLDB_LINE && PL_curstash != PL_debstash)
-       save_lines(GvAV(PL_compiling.cop_filegv), PL_linestr);
+       save_lines(CopFILEAV(&PL_compiling), PL_linestr);
     PUTBACK;
 #ifdef USE_THREADS
     MUTEX_LOCK(&PL_eval_mutex);
@@ -3122,6 +3111,7 @@ PP(pp_leaveeval)
            MEXTEND(mark,0);
            *MARK = &PL_sv_undef;
        }
+       SP = MARK;
     }
     else {
        /* in case LEAVE wipes old return values */
@@ -4087,7 +4077,6 @@ S_qsortsv(pTHX_ SV ** array, size_t num_elts, SVCOMPARE_t compare)
 
 
 #ifdef PERL_OBJECT
-#define NO_XSLOCKS
 #undef this
 #define this pPerl
 #include "XSUB.h"