Change to use $^O and &Cwd:cwd

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

diff --git a/pp_hot.c b/pp_hot.c
index 13e7c25..63362c4 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -76,6 +76,64 @@ PP(pp_gv)
     RETURN;
 }
 
+PP(pp_gelem)
+{
+    GV *gv;
+    SV *sv;
+    SV *ref;
+    char *elem;
+    dSP;
+
+    sv = POPs;
+    elem = SvPV(sv, na);
+    gv = (GV*)POPs;
+    ref = Nullsv;
+    sv = Nullsv;
+    switch (elem ? *elem : '\0')
+    {
+    case 'A':
+       if (strEQ(elem, "ARRAY"))
+           ref = (SV*)GvAV(gv);
+       break;
+    case 'C':
+       if (strEQ(elem, "CODE"))
+           ref = (SV*)GvCV(gv);
+       break;
+    case 'F':
+       if (strEQ(elem, "FILEHANDLE"))
+           ref = (SV*)GvIOp(gv);
+       break;
+    case 'G':
+       if (strEQ(elem, "GLOB"))
+           ref = (SV*)gv;
+       break;
+    case 'H':
+       if (strEQ(elem, "HASH"))
+           ref = (SV*)GvHV(gv);
+       break;
+    case 'N':
+       if (strEQ(elem, "NAME"))
+           sv = newSVpv(GvNAME(gv), GvNAMELEN(gv));
+       break;
+    case 'P':
+       if (strEQ(elem, "PACKAGE"))
+           sv = newSVpv(HvNAME(GvSTASH(gv)), 0);
+       break;
+    case 'S':
+       if (strEQ(elem, "SCALAR"))
+           ref = GvSV(gv);
+       break;
+    }
+    if (ref)
+       sv = newRV(ref);
+    if (sv)
+       sv_2mortal(sv);
+    else
+       sv = &sv_undef;
+    XPUSHs(sv);
+    RETURN;
+}
+
 PP(pp_and)
 {
     dSP;
@@ -144,12 +202,12 @@ PP(pp_concat)
     dPOPTOPssrl;
     STRLEN len;
     char *s;
-    if (SvGMAGICAL(left))
-        mg_get(left);
     if (TARG != left) {
        s = SvPV(left,len);
        sv_setpvn(TARG,s,len);
     }
+    else if (SvGMAGICAL(TARG))
+       mg_get(TARG);
     else if (!SvOK(TARG)) {
        s = SvPV_force(TARG, len);
        sv_setpv(TARG, "");     /* Suppress warning. */
@@ -168,20 +226,8 @@ PP(pp_padsv)
     if (op->op_flags & OPf_MOD) {
        if (op->op_private & OPpLVAL_INTRO)
            SAVECLEARSV(curpad[op->op_targ]);
-        else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV)) {
-           SV* sv = curpad[op->op_targ];
-            if (SvGMAGICAL(sv))
-                mg_get(sv);
-            if (!SvOK(sv)) {
-                if (SvREADONLY(sv))
-                    croak(no_modify);
-                (void)SvUPGRADE(sv, SVt_RV);
-                SvRV(sv) = (op->op_private & OPpDEREF_HV ?
-                            (SV*)newHV() : (SV*)newAV());
-                SvROK_on(sv);
-                SvSETMAGIC(sv);
-            }
-        }
+        else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV))
+           provide_ref(op, curpad[op->op_targ]);
     }
     RETURN;
 }
@@ -327,7 +373,7 @@ PP(pp_print)
                    goto just_say_no;
 
            if (IoFLAGS(io) & IOf_FLUSH)
-               if (fflush(fp) == EOF)
+               if (Fflush(fp) == EOF)
                    goto just_say_no;
        }
     }
@@ -984,6 +1030,10 @@ do_readline()
                        if (ok && sts != RMS$_NMF &&
                            sts != RMS$_DNF && sts != RMS$_FNF) ok = 0;
                        if (!ok) {
+                           if (!(sts & 1)) {
+                             SETERRNO((sts == RMS$_SYN ? EINVAL : EVMSERR),sts);
+                           }
+                           fclose(tmpfp);
                            fp = NULL;
                        }
                        else {
@@ -1014,7 +1064,8 @@ do_readline()
 #endif
 #endif /* !CSH */
 #endif /* !MSDOS */
-               (void)do_open(last_in_gv, SvPVX(tmpcmd), SvCUR(tmpcmd),Nullfp);
+               (void)do_open(last_in_gv, SvPVX(tmpcmd), SvCUR(tmpcmd),
+                             FALSE, 0, 0, Nullfp);
                fp = IoIFP(io);
 #endif /* !VMS */
                LEAVE;
@@ -1075,12 +1126,13 @@ do_readline()
        if (type == OP_GLOB) {
            char *tmps;
 
-           if (SvCUR(sv) > 0)
-               SvCUR(sv)--;
-           if (*SvEND(sv) == rschar)
-               *SvEND(sv) = '\0';
-           else
-               SvCUR(sv)++;
+           if (SvCUR(sv) > 0 && SvCUR(rs) > 0) {
+               tmps = SvEND(sv) - 1;
+               if (*tmps == *SvPVX(rs)) {
+                   *tmps = '\0';
+                   SvCUR(sv)--;
+               }
+           }
            for (tmps = SvPVX(sv); *tmps; tmps++)
                if (!isALPHA(*tmps) && !isDIGIT(*tmps) &&
                    strchr("$&*(){}[]'\";\\|?<>~`", *tmps))
@@ -1154,18 +1206,8 @@ PP(pp_helem)
            DIE(no_helem, key);
        if (op->op_private & OPpLVAL_INTRO)
            save_svref(svp);
-       else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV)) {
-           SV* sv = *svp;
-           if (SvGMAGICAL(sv))
-               mg_get(sv);
-           if (!SvOK(sv)) {
-               (void)SvUPGRADE(sv, SVt_RV);
-               SvRV(sv) = (op->op_private & OPpDEREF_HV ?
-                           (SV*)newHV() : (SV*)newAV());
-               SvROK_on(sv);
-               SvSETMAGIC(sv);
-           }
-       }
+       else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV))
+           provide_ref(op, *svp);
     }
     PUSHs(svp ? *svp : &sv_undef);
     RETURN;
@@ -1664,6 +1706,8 @@ PP(pp_entersub)
            if (ngv && ngv != gv && (cv = GvCV(ngv))) { /* One more chance... */
                gv = ngv;
                sv_setsv(GvSV(CvGV(cv)), tmpstr);       /* Set CV's $AUTOLOAD */
+               if (tainting)
+                   sv_unmagic(GvSV(CvGV(cv)), 't');
                goto retry;
            }
            else
@@ -1673,11 +1717,13 @@ PP(pp_entersub)
     }
 
     gimme = GIMME;
-    if ((op->op_private & OPpDEREF_DB) && !CvXSUB(cv)) {
+    if ((op->op_private & OPpENTERSUB_DB) && !CvXSUB(cv)) {
        sv = GvSV(DBsub);
        save_item(sv);
-       if (SvFLAGS(cv) & (SVpcv_ANON | SVpcv_CLONED)) /* Is GV potentially non-unique? */
+       if (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED)) {
+           /* GV is potentially non-unique */
            sv_setsv(sv, newRV((SV*)cv));
+       }
        else {
            gv = CvGV(cv);
            gv_efullname(sv,gv);
@@ -1832,23 +1878,31 @@ PP(pp_aelem)
            DIE(no_aelem, elem);
        if (op->op_private & OPpLVAL_INTRO)
            save_svref(svp);
-       else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV)) {
-           SV* sv = *svp;
-           if (SvGMAGICAL(sv))
-               mg_get(sv);
-           if (!SvOK(sv)) {
-               (void)SvUPGRADE(sv, SVt_RV);
-               SvRV(sv) = (op->op_private & OPpDEREF_HV ?
-                           (SV*)newHV() : (SV*)newAV());
-               SvROK_on(sv);
-               SvSETMAGIC(sv);
-           }
-       }
+       else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV))
+           provide_ref(op, *svp);
     }
     PUSHs(svp ? *svp : &sv_undef);
     RETURN;
 }
 
+void
+provide_ref(op, sv)
+OP* op;
+SV* sv;
+{
+    if (SvGMAGICAL(sv))
+       mg_get(sv);
+    if (!SvOK(sv)) {
+       if (SvREADONLY(sv))
+           croak(no_modify);
+       (void)SvUPGRADE(sv, SVt_RV);
+       SvRV(sv) = (op->op_private & OPpDEREF_HV ?
+                   (SV*)newHV() : (SV*)newAV());
+       SvROK_on(sv);
+       SvSETMAGIC(sv);
+    }
+}
+
 PP(pp_method)
 {
     dSP;
@@ -1892,7 +1946,7 @@ DIE("Can't call method \"%s\" without a package or object reference", name);
            SETs(gv);
            RETURN;
        }
-       *(stack_base + TOPMARK + 1) = iogv;
+       *(stack_base + TOPMARK + 1) = sv_2mortal(newRV(iogv));
     }
 
     if (!ob || !SvOBJECT(ob)) {