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 3e21271..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,6 +223,12 @@ 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(sv)) {         /* A typed var */
+                       SvOBJECT_on(namesv);
+                       (void)SvUPGRADE(namesv, SVt_PVMG);
+                       SvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*)SvSTASH(sv));
+                       PL_sv_objcount++;
+                   }
                    if (CvANON(PL_compcv) || SvTYPE(PL_compcv) == SVt_PVFM) {
                        /* "It's closures all the way down." */
                        CvCLONE_on(PL_compcv);
@@ -1681,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");
@@ -1917,7 +1927,7 @@ append_list(I32 type, LISTOP *first, LISTOP *last)
     first->op_last = last->op_last;
     first->op_children += last->op_children;
     if (first->op_children)
-       last->op_flags |= OPf_KIDS;
+       first->op_flags |= OPf_KIDS;
 
     Safefree(last);
     return (OP*)first;
@@ -2071,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);
 }
@@ -4027,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;
            }
@@ -4444,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) {