projects / p5sagit/p5-mst-13.2.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw
Few more IDE/editor nits from p5p.
[p5sagit/p5-mst-13.2.git] / op.c
diff --git a/op.c b/op.c
index e40d334..5e2439c 100644 (file)
--- a/op.c
+++ b/op.c
@@ -1,6 +1,6 @@
 /*    op.c
  *
- *    Copyright (c) 1991-2000, Larry Wall
+ *    Copyright (c) 1991-2001, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -102,6 +102,30 @@ S_no_bareword_allowed(pTHX_ OP *o)
                     SvPV_nolen(cSVOPo_sv)));
 }
 
+STATIC U8*
+S_trlist_upgrade(pTHX_ U8** sp, U8** ep)
+{
+    U8 *s = *sp;
+    U8 *e = *ep;
+    U8 *d;
+
+    Newz(801, d, (e - s) * 2, U8);
+    *sp = d;
+
+    while (s < e) {
+        if (*s < 0x80 || *s == 0xff)
+            *d++ = *s++;
+       else {
+            U8 c = *s++;
+            *d++ = ((c >> 6)         | 0xc0);
+            *d++ = ((c       & 0x3f) | 0x80);
+        }
+    }
+    *ep = d;
+    return *sp;
+}
+  
+
 /* "register" allocation */
 
 PADOFFSET
@@ -112,7 +136,7 @@ Perl_pad_allocmy(pTHX_ char *name)
 
     if (!(PL_in_my == KEY_our ||
          isALPHA(name[1]) ||
-         (PL_hints & HINT_UTF8 && (name[1] & 0xc0) == 0xc0) ||
+         (PL_hints & HINT_UTF8 && UTF8_IS_START(name[1])) ||
          (name[1] == '_' && (int)strlen(name) > 2)))
     {
        if (!isPRINT(name[1]) || strchr("\t\n\r\f", name[1])) {
@@ -1336,6 +1360,31 @@ Perl_mod(pTHX_ OP *o, I32 type)
        PL_modcount++;
        return o;
     case OP_CONST:
+        if (o->op_private & (OPpCONST_BARE) && 
+                !(type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN)) {
+            SV *sv = ((SVOP*)o)->op_sv;
+            GV *gv;
+
+            /* Could be a filehandle */
+            if (gv = gv_fetchpv(SvPV_nolen(sv), FALSE, SVt_PVIO)) {
+                OP* gvio = newUNOP(OP_RV2GV, 0, newGVOP(OP_GV, 0, gv));
+                op_free(o);
+                o = gvio;
+            } else {
+                /* OK, it's a sub */
+                OP* enter;
+                gv = gv_fetchpv(SvPV_nolen(sv), TRUE, SVt_PVCV);
+
+                enter = newUNOP(OP_ENTERSUB,0, 
+                        newUNOP(OP_RV2CV, 0, 
+                            newGVOP(OP_GV, 0, gv)
+                        ));
+                enter->op_private |= OPpLVAL_INTRO;
+                op_free(o);
+                o = enter;
+            }
+            break;
+        }
        if (!(o->op_private & (OPpCONST_ARYBASE)))
            goto nomod;
        if (PL_eval_start && PL_eval_start->op_type == OP_CONST) {
@@ -2145,7 +2194,7 @@ Perl_localize(pTHX_ OP *o, I32 lex)
     else {
        if (ckWARN(WARN_PARENTHESIS) && PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ',') {
            char *s;
-           for (s = PL_bufptr; *s && (isALNUM(*s) || (*s & 0x80) || strchr("@$%, ",*s)); s++) ;
+           for (s = PL_bufptr; *s && (isALNUM(*s) || UTF8_IS_CONTINUED(*s) || strchr("@$%, ",*s)); s++) ;
            if (*s == ';' || *s == '=')
                Perl_warner(aTHX_ WARN_PARENTHESIS,
                            "Parentheses missing around \"%s\" list",
@@ -2421,6 +2470,8 @@ Perl_prepend_elem(pTHX_ I32 type, OP *first, OP *last)
        if (type == OP_LIST) {  /* already a PUSHMARK there */
            first->op_sibling = ((LISTOP*)last)->op_first->op_sibling;
            ((LISTOP*)last)->op_first->op_sibling = first;
+            if (!(first->op_flags & OPf_PARENS))
+                last->op_flags &= ~OPf_PARENS;
        }
        else {
            if (!(last->op_flags & OPf_KIDS)) {
@@ -2581,13 +2632,14 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
     SV *rstr = ((SVOP*)repl)->op_sv;
     STRLEN tlen;
     STRLEN rlen;
-    register U8 *t = (U8*)SvPV(tstr, tlen);
-    register U8 *r = (U8*)SvPV(rstr, rlen);
+    U8 *t = (U8*)SvPV(tstr, tlen);
+    U8 *r = (U8*)SvPV(rstr, rlen);
     register I32 i;
     register I32 j;
     I32 del;
     I32 complement;
     I32 squash;
+    I32 grows = 0;
     register short *tbl;
 
     complement = o->op_private & OPpTRANS_COMPLEMENT;
@@ -2616,11 +2668,12 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
        I32 none = 0;
        U32 max = 0;
        I32 bits;
-       I32 grows = 0;
        I32 havefinal = 0;
        U32 final;
        I32 from_utf    = o->op_private & OPpTRANS_FROM_UTF;
        I32 to_utf      = o->op_private & OPpTRANS_TO_UTF;
+       U8* tsave = from_utf ? NULL : trlist_upgrade(&t, &tend);
+       U8* rsave = to_utf   ? NULL : trlist_upgrade(&r, &rend);
 
        if (complement) {
            U8 tmpbuf[UTF8_MAXLEN+1];
@@ -2742,20 +2795,8 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
                if (rfirst + diff > max)
                    max = rfirst + diff;
                rfirst += diff + 1;
-               if (!grows) {
-                   if (rfirst <= 0x80)
-                       ;
-                   else if (rfirst <= 0x800)
-                       grows |= (tfirst < 0x80);
-                   else if (rfirst <= 0x10000)
-                       grows |= (tfirst < 0x800);
-                   else if (rfirst <= 0x200000)
-                       grows |= (tfirst < 0x10000);
-                   else if (rfirst <= 0x4000000)
-                       grows |= (tfirst < 0x200000);
-                   else if (rfirst <= 0x80000000)
-                       grows |= (tfirst < 0x4000000);
-               }
+               if (!grows)
+                   grows = (UNISKIP(tfirst) < UNISKIP(rfirst));
            }
            tfirst += diff + 1;
        }
@@ -2780,9 +2821,14 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
            (void)hv_store((HV*)SvRV((cSVOPo->op_sv)), "FINAL", 5,
                           newSVuv((UV)final), 0);
 
-       if (grows && to_utf)
+       if (grows)
            o->op_private |= OPpTRANS_GROWS;
 
+       if (tsave)
+           Safefree(tsave);
+       if (rsave)
+           Safefree(rsave);
+
        op_free(expr);
        op_free(repl);
        return o;
@@ -2803,8 +2849,11 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
                    else
                        tbl[i] = i;
                }
-               else
+               else {
+                   if (i < 128 && r[j] >= 128)
+                       grows = 1;
                    tbl[i] = r[j++];
+               }
            }
        }
     }
@@ -2825,10 +2874,15 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
                }
                --j;
            }
-           if (tbl[t[i]] == -1)
+           if (tbl[t[i]] == -1) {
+               if (t[i] < 128 && r[j] >= 128)
+                   grows = 1;
                tbl[t[i]] = r[j];
+           }
        }
     }
+    if (grows)
+       o->op_private |= OPpTRANS_GROWS;
     op_free(expr);
     op_free(repl);
 
@@ -3880,7 +3934,6 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *
 
     if (cont) {
        next = LINKLIST(cont);
-       loopflags |= OPpLOOP_CONTINUE;
     }
     if (expr) {
        OP *unstack = newOP(OP_UNSTACK, 0);
@@ -5425,6 +5478,7 @@ Perl_ck_rvconst(pTHX_ register OP *o)
 #else
            kid->op_sv = SvREFCNT_inc(gv);
 #endif
+           kid->op_private = 0;
            kid->op_ppaddr = PL_ppaddr[OP_GV];
        }
     }
@@ -6675,8 +6729,14 @@ Perl_peep(pTHX_ register OP *o)
 
        case OP_ENTERLOOP:
            o->op_seq = PL_op_seqmax++;
+           while (cLOOP->op_redoop->op_type == OP_NULL)
+               cLOOP->op_redoop = cLOOP->op_redoop->op_next;
            peep(cLOOP->op_redoop);
+           while (cLOOP->op_nextop->op_type == OP_NULL)
+               cLOOP->op_nextop = cLOOP->op_nextop->op_next;
            peep(cLOOP->op_nextop);
+           while (cLOOP->op_lastop->op_type == OP_NULL)
+               cLOOP->op_lastop = cLOOP->op_lastop->op_next;
            peep(cLOOP->op_lastop);
            break;
 
@@ -6684,6 +6744,9 @@ Perl_peep(pTHX_ register OP *o)
        case OP_MATCH:
        case OP_SUBST:
            o->op_seq = PL_op_seqmax++;
+           while (cPMOP->op_pmreplstart && 
+                  cPMOP->op_pmreplstart->op_type == OP_NULL)
+               cPMOP->op_pmreplstart = cPMOP->op_pmreplstart->op_next;
            peep(cPMOP->op_pmreplstart);
            break;
 
@@ -6745,6 +6808,8 @@ Perl_peep(pTHX_ register OP *o)
            if (!fields || !GvHV(*fields))
                break;
            key = SvPV(*svp, keylen);
+           if (SvUTF8(*svp))
+               keylen = -keylen;
            indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE);
            if (!indsvp) {
                Perl_croak(aTHX_ "No such pseudo-hash field \"%s\" in variable %s of type %s",
@@ -6810,6 +6875,8 @@ Perl_peep(pTHX_ register OP *o)
                 key_op = (SVOP*)key_op->op_sibling) {
                svp = cSVOPx_svp(key_op);
                key = SvPV(*svp, keylen);
+               if (SvUTF8(*svp))
+                   keylen = -keylen;
                indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE);
                if (!indsvp) {
                    Perl_croak(aTHX_ "No such pseudo-hash field \"%s\" "
Unnamed repository; edit this file to name it for gitweb.