FindBin.pm on Win32 systems

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

diff --git a/op.c b/op.c
index 75c7d9f..58f26e1 100644 (file)
--- a/op.c
+++ b/op.c
@@ -56,9 +56,10 @@ static OP *new_logop _((I32 type, I32 flags, OP **firstp, OP **otherp));
 STATIC char*
 gv_ename(GV *gv)
 {
+    STRLEN n_a;
     SV* tmpsv = sv_newmortal();
     gv_efullname3(tmpsv, gv, Nullch);
-    return SvPV(tmpsv,PL_na);
+    return SvPV(tmpsv,n_a);
 }
 
 STATIC OP *
@@ -549,11 +550,15 @@ find_threadsv(char *name)
     if (!p)
        return NOT_IN_PAD;
     key = p - PL_threadsv_names;
+    MUTEX_LOCK(&thr->mutex);
     svp = av_fetch(thr->threadsv, key, FALSE);
-    if (!svp) {
+    if (svp)
+       MUTEX_UNLOCK(&thr->mutex);
+    else {
        SV *sv = NEWSV(0, 0);
        av_store(thr->threadsv, key, sv);
        thr->threadsvp = AvARRAY(thr->threadsv);
+       MUTEX_UNLOCK(&thr->mutex);
        /*
         * Some magic variables used to be automagically initialised
         * in gv_fetchpv. Those which are now per-thread magicals get
@@ -570,6 +575,16 @@ find_threadsv(char *name)
        case '`':
        case '\'':
            PL_sawampersand = TRUE;
+           /* FALL THROUGH */
+       case '1':
+       case '2':
+       case '3':
+       case '4':
+       case '5':
+       case '6':
+       case '7':
+       case '8':
+       case '9':
            SvREADONLY_on(sv);
            /* FALL THROUGH */
 
@@ -812,7 +827,8 @@ scalarvoid(OP *o)
     SV* sv;
 
     /* assumes no premature commitment */
-    if (!o || (o->op_flags & OPf_WANT) == OPf_WANT_LIST || PL_error_count
+    U8 want = o->op_flags & OPf_WANT;
+    if (!o || (want && want != OPf_WANT_SCALAR) || PL_error_count
         || o->op_type == OP_RETURN)
        return o;
 
@@ -1120,6 +1136,7 @@ mod(OP *o, I32 type)
     dTHR;
     OP *kid;
     SV *sv;
+    STRLEN n_a;
 
     if (!o || PL_error_count)
        return o;
@@ -1247,7 +1264,7 @@ mod(OP *o, I32 type)
        PL_modcount++;
        if (!type)
            croak("Can't localize lexical variable %s",
-               SvPV(*av_fetch(PL_comppad_name, o->op_targ, 4), PL_na));
+               SvPV(*av_fetch(PL_comppad_name, o->op_targ, 4), n_a));
        break;
 
 #ifdef USE_THREADS
@@ -1693,7 +1710,7 @@ localize(OP *o, I32 lex)
            char *s;
            for (s = PL_bufptr; *s && (isALNUM(*s) || (*s & 0x80) || strchr("@$%, ",*s)); s++) ;
            if (*s == ';' || *s == '=')
-               warner(WARN_PARENTHESIS, "Parens missing around \"%s\" list",
+               warner(WARN_PARENTHESIS, "Parentheses missing around \"%s\" list",
                                lex ? "my" : "local");
        }
     }
@@ -2597,6 +2614,7 @@ package(OP *o)
        sv_setpv(PL_curstname,"<none>");
        PL_curstash = Nullhv;
     }
+    PL_hints |= HINT_BLOCK_SCOPE;
     PL_copline = NOLINE;
     PL_expect = XSTATE;
 }
@@ -3419,13 +3437,15 @@ newLOOPEX(I32 type, OP *label)
 {
     dTHR;
     OP *o;
+    STRLEN n_a;
+
     if (type != OP_GOTO || label->op_type == OP_CONST) {
        /* "last()" means "last" */
        if (label->op_type == OP_STUB && (label->op_flags & OPf_PARENS))
            o = newOP(type, OPf_SPECIAL);
        else {
            o = newPVOP(type, 0, savepv(label->op_type == OP_CONST
-                                       ? SvPVx(((SVOP*)label)->op_sv, PL_na)
+                                       ? SvPVx(((SVOP*)label)->op_sv, n_a)
                                        : ""));
        }
        op_free(label);
@@ -3679,7 +3699,11 @@ cv_clone2(CV *proto, CV *outside)
 CV *
 cv_clone(CV *proto)
 {
-    return cv_clone2(proto, CvOUTSIDE(proto));
+    CV *cv;
+    MUTEX_LOCK(&PL_cred_mutex);                /* XXX create separate mutex */
+    cv = cv_clone2(proto, CvOUTSIDE(proto));
+    MUTEX_UNLOCK(&PL_cred_mutex);      /* XXX create separate mutex */
+    return cv;
 }
 
 void
@@ -3755,10 +3779,11 @@ CV *
 newSUB(I32 floor, OP *o, OP *proto, OP *block)
 {
     dTHR;
-    char *name = o ? SvPVx(cSVOPo->op_sv, PL_na) : Nullch;
+    STRLEN n_a;
+    char *name = o ? SvPVx(cSVOPo->op_sv, n_a) : Nullch;
     GV *gv = gv_fetchpv(name ? name : "__ANON__",
                        GV_ADDMULTI | (block ? 0 : GV_NOINIT), SVt_PVCV);
-    char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, PL_na) : Nullch;
+    char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, n_a) : Nullch;
     register CV *cv=0;
     I32 ix;
 
@@ -3865,7 +3890,7 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
                else {
                    /* force display of errors found but not reported */
                    sv_catpv(ERRSV, not_safe);
-                   croak("%s", SvPVx(ERRSV, PL_na));
+                   croak("%s", SvPVx(ERRSV, n_a));
                }
            }
        }
@@ -3991,6 +4016,7 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
     return cv;
 }
 
+/* XXX unsafe for threads if eval_owner isn't held */
 void
 newCONSTSUB(HV *stash, char *name, SV *sv)
 {
@@ -4107,9 +4133,10 @@ newFORM(I32 floor, OP *o, OP *block)
     char *name;
     GV *gv;
     I32 ix;
+    STRLEN n_a;
 
     if (o)
-       name = SvPVx(cSVOPo->op_sv, PL_na);
+       name = SvPVx(cSVOPo->op_sv, n_a);
     else
        name = "STDOUT";
     gv = gv_fetchpv(name,TRUE, SVt_PVFM);
@@ -4458,6 +4485,7 @@ ck_rvconst(register OP *o)
        int iscv;
        GV *gv;
        SV *kidsv = kid->op_sv;
+       STRLEN n_a;
 
        /* Is it a constant from cv_const_sv()? */
        if (SvROK(kidsv) && SvREADONLY(kidsv)) {
@@ -4496,7 +4524,7 @@ ck_rvconst(register OP *o)
                croak("Constant is not %s reference", badtype);
            return o;
        }
-       name = SvPV(kidsv, PL_na);
+       name = SvPV(kidsv, n_a);
        if ((PL_hints & HINT_STRICT_REFS) && (kid->op_private & OPpCONST_BARE)) {
            char *badthing = Nullch;
            switch (o->op_type) {
@@ -4559,8 +4587,9 @@ ck_ftst(OP *o)
        SVOP *kid = (SVOP*)cUNOPo->op_first;
 
        if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
+           STRLEN n_a;
            OP *newop = newGVOP(type, OPf_REF,
-               gv_fetchpv(SvPVx(kid->op_sv, PL_na), TRUE, SVt_PVIO));
+               gv_fetchpv(SvPVx(kid->op_sv, n_a), TRUE, SVt_PVIO));
            op_free(o);
            return newop;
        }
@@ -4595,6 +4624,7 @@ ck_fun(OP *o)
     }
 
     if (o->op_flags & OPf_KIDS) {
+       STRLEN n_a;
        tokid = &cLISTOPo->op_first;
        kid = cLISTOPo->op_first;
        if (kid->op_type == OP_PUSHMARK ||
@@ -4624,7 +4654,7 @@ ck_fun(OP *o)
            case OA_AVREF:
                if (kid->op_type == OP_CONST &&
                  (kid->op_private & OPpCONST_BARE)) {
-                   char *name = SvPVx(((SVOP*)kid)->op_sv, PL_na);
+                   char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
                    OP *newop = newAVREF(newGVOP(OP_GV, 0,
                        gv_fetchpv(name, TRUE, SVt_PVAV) ));
                    if (ckWARN(WARN_SYNTAX))
@@ -4643,7 +4673,7 @@ ck_fun(OP *o)
            case OA_HVREF:
                if (kid->op_type == OP_CONST &&
                  (kid->op_private & OPpCONST_BARE)) {
-                   char *name = SvPVx(((SVOP*)kid)->op_sv, PL_na);
+                   char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
                    OP *newop = newHVREF(newGVOP(OP_GV, 0,
                        gv_fetchpv(name, TRUE, SVt_PVHV) ));
                    if (ckWARN(WARN_SYNTAX))
@@ -4675,11 +4705,15 @@ ck_fun(OP *o)
                    if (kid->op_type == OP_CONST &&
                      (kid->op_private & OPpCONST_BARE)) {
                        OP *newop = newGVOP(OP_GV, 0,
-                           gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, PL_na), TRUE,
+                           gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, n_a), TRUE,
                                        SVt_PVIO) );
                        op_free(kid);
                        kid = newop;
                    }
+                   else if (kid->op_type == OP_READLINE) {
+                       /* neophyte patrol: open(<FH>), close(<FH>) etc. */
+                       bad_type(numargs, "HANDLE", PL_op_desc[o->op_type], kid);
+                   }
                    else {
                        kid->op_sibling = 0;
                        kid = newUNOP(OP_RV2GV, 0, scalar(kid));
@@ -5049,6 +5083,8 @@ ck_sort(OP *o)
                kid->op_next = k;
            o->op_flags |= OPf_SPECIAL;
        }
+       else if (kid->op_type == OP_RV2SV || kid->op_type == OP_PADSV)
+           null(cLISTOPo->op_first->op_sibling);
     }
 
     return o;
@@ -5118,6 +5154,7 @@ ck_subr(OP *o)
     GV *namegv = 0;
     int optional = 0;
     I32 arg = 0;
+    STRLEN n_a;
 
     for (cvop = o2; cvop->op_sibling; cvop = cvop->op_sibling) ;
     if (cvop->op_type == OP_RV2CV) {
@@ -5129,7 +5166,7 @@ ck_subr(OP *o)
            cv = GvCVu(tmpop->op_sv);
            if (cv && SvPOK(cv) && !(o->op_private & OPpENTERSUB_AMPER)) {
                namegv = CvANON(cv) ? (GV*)tmpop->op_sv : CvGV(cv);
-               proto = SvPV((SV*)cv, PL_na);
+               proto = SvPV((SV*)cv, n_a);
            }
        }
     }
@@ -5221,7 +5258,7 @@ ck_subr(OP *o)
            default:
              oops:
                croak("Malformed prototype for %s: %s",
-                       gv_ename(namegv), SvPV((SV*)cv, PL_na));
+                       gv_ename(namegv), SvPV((SV*)cv, n_a));
            }
        }
        else
@@ -5265,6 +5302,8 @@ peep(register OP *o)
 {
     dTHR;
     register OP* oldop = 0;
+    STRLEN n_a;
+
     if (!o || o->op_seq)
        return;
     ENTER;
@@ -5427,7 +5466,7 @@ peep(register OP *o)
            indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE);
            if (!indsvp) {
                croak("No such field \"%s\" in variable %s of type %s",
-                     key, SvPV(lexname, PL_na), HvNAME(SvSTASH(lexname)));
+                     key, SvPV(lexname, n_a), HvNAME(SvSTASH(lexname)));
            }
            ind = SvIV(*indsvp);
            if (ind < 1)