Re: [PATCH] support 'my __PACKAGE__ $obj = ...'

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

diff --git a/toke.c b/toke.c
index 99c993e..4a54f72 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -502,8 +502,14 @@ S_incline(pTHX_ char *s)
 
     ch = *t;
     *t = '\0';
-    if (t - s > 0)
+    if (t - s > 0) {
+#ifdef USE_ITHREADS
+       Safefree(CopFILE(PL_curcop));
+#else
+       SvREFCNT_dec(CopFILEGV(PL_curcop));
+#endif
        CopFILE_set(PL_curcop, s);
+    }
     *t = ch;
     CopLINE_set(PL_curcop, atoi(n)-1);
 }
@@ -981,6 +987,8 @@ S_sublex_start(pTHX)
 
            p = SvPV(sv, len);
            nsv = newSVpvn(p, len);
+            if (SvUTF8(sv))
+               SvUTF8_on(nsv);
            SvREFCNT_dec(sv);
            sv = nsv;
        } 
@@ -1384,7 +1392,7 @@ S_scan_const(pTHX_ char *start)
            default:
                {
                    dTHR;
-                   if (ckWARN(WARN_MISC) && isALNUM(*s))
+                   if (ckWARN(WARN_MISC) && isALNUM(*s) && *s != '_')
                        Perl_warner(aTHX_ WARN_MISC, 
                               "Unrecognized escape \\%c passed through",
                               *s);
@@ -1998,6 +2006,29 @@ S_filter_gets(pTHX_ register SV *sv, register PerlIO *fp, STRLEN append)
         return (sv_gets(sv, fp, append));
 }
 
+STATIC HV *S_find_in_my_stash(pTHX_ char *pkgname, I32 len)
+{
+    GV *gv;
+
+    if (*pkgname == '_' && strEQ(pkgname, "__PACKAGE__"))
+        return PL_curstash;
+
+    if (len > 2 &&
+        (pkgname[len - 2] == ':' && pkgname[len - 1] == ':') &&
+        (gv = gv_fetchpv(pkgname, FALSE, SVt_PVHV))) {
+        return GvHV(gv); /* Foo:: */
+    }
+
+    /* use constant CLASS => 'MyClass' */
+    if ((gv = gv_fetchpv(pkgname, FALSE, SVt_PVCV))) {
+        SV *sv;
+        if (GvCV(gv) && (sv = cv_const_sv(GvCV(gv)))) {
+            pkgname = SvPV_nolen(sv);
+        }
+    }
+
+    return gv_stashpv(pkgname, FALSE);
+}
 
 #ifdef DEBUGGING
     static char* exp_name[] =
@@ -2946,8 +2977,7 @@ Perl_yylex(pTHX)
            PL_expect = XTERM;
        TOKEN('(');
     case ';':
-       if (CopLINE(PL_curcop) < PL_copline)
-           PL_copline = CopLINE(PL_curcop);
+       CLINE;
        tmp = *s++;
        OPERATOR(tmp);
     case ')':
@@ -4403,7 +4433,7 @@ Perl_yylex(pTHX)
                s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, &len);
                if (len == 3 && strnEQ(PL_tokenbuf, "sub", 3))
                    goto really_sub;
-               PL_in_my_stash = gv_stashpv(PL_tokenbuf, FALSE);
+               PL_in_my_stash = find_in_my_stash(PL_tokenbuf, len);
                if (!PL_in_my_stash) {
                    char tmpbuf[1024];
                    PL_bufptr = s;
@@ -6123,45 +6153,20 @@ S_scan_trans(pTHX_ char *start)
        Perl_croak(aTHX_ "Transliteration replacement not terminated");
     }
 
-    if (UTF) {
-       o = newSVOP(OP_TRANS, 0, 0);
-       utf8 = OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF;
-    }
-    else {
        New(803,tbl,256,short);
        o = newPVOP(OP_TRANS, 0, (char*)tbl);
-       utf8 = 0;
-    }
 
     complement = del = squash = 0;
-    while (strchr("cdsCU", *s)) {
+    while (strchr("cds", *s)) {
        if (*s == 'c')
            complement = OPpTRANS_COMPLEMENT;
        else if (*s == 'd')
            del = OPpTRANS_DELETE;
        else if (*s == 's')
            squash = OPpTRANS_SQUASH;
-       else {
-           switch (count++) {
-           case 0:
-               if (*s == 'C')
-                   utf8 &= ~OPpTRANS_FROM_UTF;
-               else
-                   utf8 |= OPpTRANS_FROM_UTF;
-               break;
-           case 1:
-               if (*s == 'C')
-                   utf8 &= ~OPpTRANS_TO_UTF;
-               else
-                   utf8 |= OPpTRANS_TO_UTF;
-               break;
-           default: 
-               Perl_croak(aTHX_ "Too many /C and /U options");
-           }
-       }
        s++;
     }
-    o->op_private = del|squash|complement|utf8;
+    o->op_private = del|squash|complement;
 
     PL_lex_op = o;
     yylval.ival = OP_TRANS;