implement C<goto &func> and other fixes (via private mail)

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

diff --git a/op.c b/op.c
index 98ceb4f..4af15e7 100644 (file)
--- a/op.c
+++ b/op.c
@@ -120,7 +120,11 @@ pad_allocmy(char *name)
     PADOFFSET off;
     SV *sv;
 
-    if (!(isALPHA(name[1]) || name[1] == '_' && (int)strlen(name) > 2)) {
+    if (!(
+       isALPHA(name[1]) ||
+       (PL_hints & HINT_UTF8 && (name[1] & 0xc0) == 0xc0) ||
+       name[1] == '_' && (int)strlen(name) > 2))
+    {
        if (!isPRINT(name[1])) {
            name[3] = '\0';
            name[2] = toCTRL(name[1]);
@@ -219,10 +223,10 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix, I32 s
                    SvNVX(namesv) = (double)PL_curcop->cop_seq;
                    SvIVX(namesv) = PAD_MAX;    /* A ref, intro immediately */
                    SvFAKE_on(namesv);          /* A ref, not a real var */
-                   if (SvOBJECT(svp[off])) {   /* A typed var */
+                   if (SvOBJECT(sv)) {         /* A typed var */
                        SvOBJECT_on(namesv);
                        (void)SvUPGRADE(namesv, SVt_PVMG);
-                       SvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*)SvSTASH(svp[off]));
+                       SvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*)SvSTASH(sv));
                        PL_sv_objcount++;
                    }
                    if (CvANON(PL_compcv) || SvTYPE(PL_compcv) == SVt_PVFM) {
@@ -1687,7 +1691,7 @@ localize(OP *o, I32 lex)
        dTHR;
        if (ckWARN(WARN_PARENTHESIS) && PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ',') {
            char *s;
-           for (s = PL_bufptr; *s && (isALNUM(*s) || strchr("@$%, ",*s)); s++) ;
+           for (s = PL_bufptr; *s && (isALNUM(*s) || (*s & 0x80) || strchr("@$%, ",*s)); s++) ;
            if (*s == ';' || *s == '=')
                warner(WARN_PARENTHESIS, "Parens missing around \"%s\" list",
                                lex ? "my" : "local");
@@ -2077,7 +2081,7 @@ newBINOP(I32 type, I32 flags, OP *first, OP *last)
     if (binop->op_next)
        return (OP*)binop;
 
-    binop->op_last = last = binop->op_first->op_sibling;
+    binop->op_last = binop->op_first->op_sibling;
 
     return fold_constants((OP *)binop);
 }
@@ -3838,9 +3842,10 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
     CvSTASH(cv) = PL_curstash;
 #ifdef USE_THREADS
     CvOWNER(cv) = 0;
-    if (!CvMUTEXP(cv))
+    if (!CvMUTEXP(cv)) {
        New(666, CvMUTEXP(cv), 1, perl_mutex);
-    MUTEX_INIT(CvMUTEXP(cv));
+       MUTEX_INIT(CvMUTEXP(cv));
+    }
 #endif /* USE_THREADS */
 
     if (ps)
@@ -4032,7 +4037,8 @@ newXS(char *name, void (*subaddr) (CV * _CPERLproto), char *filename)
                            && HvNAME(GvSTASH(CvGV(cv)))
                            && strEQ(HvNAME(GvSTASH(CvGV(cv))), "autouse"))) {
                line_t oldline = PL_curcop->cop_line;
-               PL_curcop->cop_line = PL_copline;
+               if (PL_copline != NOLINE)
+                   PL_curcop->cop_line = PL_copline;
                warner(WARN_REDEFINE, "Subroutine %s redefined",name);
                PL_curcop->cop_line = oldline;
            }
@@ -4449,8 +4455,46 @@ ck_rvconst(register OP *o)
        char *name;
        int iscv;
        GV *gv;
+       SV *kidsv = kid->op_sv;
+
+       /* Is it a constant from cv_const_sv()? */
+       if (SvROK(kidsv) && SvREADONLY(kidsv)) {
+           SV *rsv = SvRV(kidsv);
+           int svtype = SvTYPE(rsv);
+           char *badtype = Nullch;
 
-       name = SvPV(kid->op_sv, PL_na);
+           switch (o->op_type) {
+           case OP_RV2SV:
+               if (svtype > SVt_PVMG)
+                   badtype = "a SCALAR";
+               break;
+           case OP_RV2AV:
+               if (svtype != SVt_PVAV)
+                   badtype = "an ARRAY";
+               break;
+           case OP_RV2HV:
+               if (svtype != SVt_PVHV) {
+                   if (svtype == SVt_PVAV) {   /* pseudohash? */
+                       SV **ksv = av_fetch((AV*)rsv, 0, FALSE);
+                       if (ksv && SvROK(*ksv)
+                           && SvTYPE(SvRV(*ksv)) == SVt_PVHV)
+                       {
+                               break;
+                       }
+                   }
+                   badtype = "a HASH";
+               }
+               break;
+           case OP_RV2CV:
+               if (svtype != SVt_PVCV)
+                   badtype = "a CODE";
+               break;
+           }
+           if (badtype)
+               croak("Constant is not %s reference", badtype);
+           return o;
+       }
+       name = SvPV(kidsv, PL_na);
        if ((PL_hints & HINT_STRICT_REFS) && (kid->op_private & OPpCONST_BARE)) {
            char *badthing = Nullch;
            switch (o->op_type) {