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

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

diff --git a/op.c b/op.c
index 806dee3..73c9634 100644 (file)
--- a/op.c
+++ b/op.c
@@ -475,13 +475,13 @@ Perl_pad_sv(pTHX_ PADOFFSET po)
     dTHR;
 #ifdef USE_THREADS
     DEBUG_X(PerlIO_printf(Perl_debug_log,
-                         "0x%"UVxf" Pad 0x%"UVxf" sv %d\n",
-                         PTR2UV(thr), PTR2UV(PL_curpad), po));
+                         "0x%"UVxf" Pad 0x%"UVxf" sv %"IVdf"\n",
+                         PTR2UV(thr), PTR2UV(PL_curpad), (IV)po));
 #else
     if (!po)
        Perl_croak(aTHX_ "panic: pad_sv po");
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" sv %d\n",
-                         PTR2UV(PL_curpad), po));
+    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" sv %"IVdf"\n",
+                         PTR2UV(PL_curpad), (IV)po));
 #endif /* USE_THREADS */
     return PL_curpad[po];              /* eventually we'll turn this into a macro */
 }
@@ -498,11 +498,11 @@ Perl_pad_free(pTHX_ PADOFFSET po)
        Perl_croak(aTHX_ "panic: pad_free po");
 #ifdef USE_THREADS
     DEBUG_X(PerlIO_printf(Perl_debug_log,
-                         "0x%"UVxf" Pad 0x%"UVxf" free %d\n",
-                         PTR2UV(thr), PTR2UV(PL_curpad), po));
+                         "0x%"UVxf" Pad 0x%"UVxf" free %"IVd"\n",
+                         PTR2UV(thr), PTR2UV(PL_curpad), (IV)po));
 #else
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" free %d\n",
-                         PTR2UV(PL_curpad), po));
+    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" free %"IVdf"\n",
+                         PTR2UV(PL_curpad), (IV)po));
 #endif /* USE_THREADS */
     if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef)
        SvPADTMP_off(PL_curpad[po]);
@@ -520,11 +520,11 @@ Perl_pad_swipe(pTHX_ PADOFFSET po)
        Perl_croak(aTHX_ "panic: pad_swipe po");
 #ifdef USE_THREADS
     DEBUG_X(PerlIO_printf(Perl_debug_log,
-                         "0x%"UVxf" Pad 0x%"UVxf" swipe %d\n",
-                         PTR2UV(thr), PTR2UV(PL_curpad), po));
+                         "0x%"UVxf" Pad 0x%"UVxf" swipe %"IVdf"\n",
+                         PTR2UV(thr), PTR2UV(PL_curpad), (IV)po));
 #else
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" swipe %d\n",
-                         PTR2UV(PL_curpad), po));
+    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" swipe %"IVdf"\n",
+                         PTR2UV(PL_curpad), (IV)po));
 #endif /* USE_THREADS */
     SvPADTMP_off(PL_curpad[po]);
     PL_curpad[po] = NEWSV(1107,0);
@@ -1326,7 +1326,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
        }
        else {                          /* lvalue subroutine call */
            o->op_private |= OPpLVAL_INTRO;
-           if (type == OP_GREPSTART || type == OP_ENTERSUB) {
+           if (type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN) {
                /* Backward compatibility mode: */
                o->op_private |= OPpENTERSUB_INARGS;
                break;
@@ -3944,10 +3944,10 @@ Perl_cv_undef(pTHX_ CV *cv)
     }
 }
 
-#ifdef DEBUGGING
 STATIC void
 S_cv_dump(pTHX_ CV *cv)
 {
+#ifdef DEBUGGING
     CV *outside = CvOUTSIDE(cv);
     AV* padlist = CvPADLIST(cv);
     AV* pad_name;
@@ -3988,8 +3988,8 @@ S_cv_dump(pTHX_ CV *cv)
                          (IV)I_32(SvNVX(pname[ix])),
                          SvIVX(pname[ix]));
     }
-}
 #endif /* DEBUGGING */
+}
 
 STATIC CV *
 S_cv_clone2(pTHX_ CV *proto, CV *outside)
@@ -4455,8 +4455,8 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
            CV *cv;
            HV *hv;
 
-           Perl_sv_setpvf(aTHX_ sv, "%_:%ld-%ld",
-                          CopFILESV(PL_curcop),
+           Perl_sv_setpvf(aTHX_ sv, "%s:%ld-%ld",
+                          CopFILE(PL_curcop),
                           (long)PL_subline, (long)CopLINE(PL_curcop));
            gv_efullname3(tmpstr, gv, Nullch);
            hv_store(GvHV(PL_DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
@@ -4475,6 +4475,10 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
            s++;
        else
            s = name;
+
+       if (*s != 'B' && *s != 'E' && *s != 'S' && *s != 'I')
+           goto done;
+
        if (strEQ(s, "BEGIN")) {
            I32 oldscope = PL_scopestack_ix;
            ENTER;
@@ -4486,7 +4490,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
            if (!PL_beginav)
                PL_beginav = newAV();
            DEBUG_x( dump_sub(gv) );
-           av_push(PL_beginav, (SV *)cv);
+           av_push(PL_beginav, SvREFCNT_inc(cv));
            GvCV(gv) = 0;
            call_list(oldscope, PL_beginav);
 
@@ -4497,20 +4501,23 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        else if (strEQ(s, "END") && !PL_error_count) {
            if (!PL_endav)
                PL_endav = newAV();
+           DEBUG_x( dump_sub(gv) );
            av_unshift(PL_endav, 1);
-           av_store(PL_endav, 0, (SV *)cv);
+           av_store(PL_endav, 0, SvREFCNT_inc(cv));
            GvCV(gv) = 0;
        }
        else if (strEQ(s, "STOP") && !PL_error_count) {
            if (!PL_stopav)
                PL_stopav = newAV();
+           DEBUG_x( dump_sub(gv) );
            av_unshift(PL_stopav, 1);
-           av_store(PL_stopav, 0, (SV *)cv);
+           av_store(PL_stopav, 0, SvREFCNT_inc(cv));
            GvCV(gv) = 0;
        }
        else if (strEQ(s, "INIT") && !PL_error_count) {
            if (!PL_initav)
                PL_initav = newAV();
+           DEBUG_x( dump_sub(gv) );
            av_push(PL_initav, SvREFCNT_inc(cv));
            GvCV(gv) = 0;
        }
@@ -4614,36 +4621,41 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename)
            s++;
        else
            s = name;
+
+       if (*s != 'B' && *s != 'E' && *s != 'S' && *s != 'I')
+           goto done;
+
        if (strEQ(s, "BEGIN")) {
            if (!PL_beginav)
                PL_beginav = newAV();
-           av_push(PL_beginav, (SV *)cv);
+           av_push(PL_beginav, SvREFCNT_inc(cv));
            GvCV(gv) = 0;
        }
        else if (strEQ(s, "END")) {
            if (!PL_endav)
                PL_endav = newAV();
            av_unshift(PL_endav, 1);
-           av_store(PL_endav, 0, (SV *)cv);
+           av_store(PL_endav, 0, SvREFCNT_inc(cv));
            GvCV(gv) = 0;
        }
        else if (strEQ(s, "STOP")) {
            if (!PL_stopav)
                PL_stopav = newAV();
            av_unshift(PL_stopav, 1);
-           av_store(PL_stopav, 0, (SV *)cv);
+           av_store(PL_stopav, 0, SvREFCNT_inc(cv));
            GvCV(gv) = 0;
        }
        else if (strEQ(s, "INIT")) {
            if (!PL_initav)
                PL_initav = newAV();
-           av_push(PL_initav, (SV *)cv);
+           av_push(PL_initav, SvREFCNT_inc(cv));
            GvCV(gv) = 0;
        }
     }
     else
        CvANON_on(cv);
 
+done:
     return cv;
 }
 
@@ -5123,10 +5135,10 @@ Perl_ck_ftst(pTHX_ OP *o)
     dTHR;
     I32 type = o->op_type;
 
-    if (o->op_flags & OPf_REF)
-       return o;
-
-    if (o->op_flags & OPf_KIDS && cUNOPo->op_first->op_type != OP_STUB) {
+    if (o->op_flags & OPf_REF) {
+       /* nothing */
+    }
+    else if (o->op_flags & OPf_KIDS && cUNOPo->op_first->op_type != OP_STUB) {
        SVOP *kid = (SVOP*)cUNOPo->op_first;
 
        if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
@@ -5134,17 +5146,24 @@ Perl_ck_ftst(pTHX_ OP *o)
            OP *newop = newGVOP(type, OPf_REF,
                gv_fetchpv(SvPVx(kid->op_sv, n_a), TRUE, SVt_PVIO));
            op_free(o);
-           return newop;
+           o = newop;
        }
     }
     else {
        op_free(o);
        if (type == OP_FTTTY)
-           return newGVOP(type, OPf_REF, gv_fetchpv("main::STDIN", TRUE,
+           o =  newGVOP(type, OPf_REF, gv_fetchpv("main::STDIN", TRUE,
                                SVt_PVIO));
        else
-           return newUNOP(type, 0, newDEFSVOP());
+           o = newUNOP(type, 0, newDEFSVOP());
     }
+#ifdef USE_LOCALE
+    if (type == OP_FTTEXT || type == OP_FTBINARY) {
+       o->op_private = 0;
+       if (PL_hints & HINT_LOCALE)
+           o->op_private |= OPpLOCALE;
+    }
+#endif
     return o;
 }