Complex tweakery.

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

diff --git a/toke.c b/toke.c
index 0ec3cf6..10273a0 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1377,7 +1377,7 @@ S_scan_const(pTHX_ char *start)
            default:
                {
                    dTHR;
-                   if (ckWARN(WARN_MISC) && isALPHA(*s))
+                   if (ckWARN(WARN_MISC) && isALNUM(*s))
                        Perl_warner(aTHX_ WARN_MISC, 
                               "Unrecognized escape \\%c passed through",
                               *s);
@@ -1389,6 +1389,7 @@ S_scan_const(pTHX_ char *start)
            /* \132 indicates an octal constant */
            case '0': case '1': case '2': case '3':
            case '4': case '5': case '6': case '7':
+               len = 0;        /* disallow underscores */
                uv = (UV)scan_oct(s, 3, &len);
                s += len;
                goto NUM_ESCAPE_INSERT;
@@ -1402,10 +1403,12 @@ S_scan_const(pTHX_ char *start)
                        yyerror("Missing right brace on \\x{}");
                        e = s;
                    }
+                   len = 1;            /* allow underscores */
                     uv = (UV)scan_hex(s + 1, e - s - 1, &len);
                     s = e + 1;
                }
                else {
+                   len = 0;            /* disallow underscores */
                    uv = (UV)scan_hex(s, 2, &len);
                    s += len;
                }
@@ -1479,8 +1482,14 @@ S_scan_const(pTHX_ char *start)
                    res = new_constant( Nullch, 0, "charnames", 
                                        res, Nullsv, "\\N{...}" );
                    str = SvPV(res,len);
-                   if (len > 1)
+                   if (!has_utf && SvUTF8(res)) {
+                       char *ostart = SvPVX(sv);
+                       SvCUR_set(sv, d - ostart);
+                       SvPOK_on(sv);
+                       sv_utf8_upgrade(sv);
+                       d = SvPVX(sv) + SvCUR(sv);
                        has_utf = TRUE;
+                   }
                    if (len > e - s + 4) {
                        char *odest = SvPVX(sv);
 
@@ -1504,7 +1513,8 @@ S_scan_const(pTHX_ char *start)
                *d = *s++;
                if (isLOWER(*d))
                   *d = toUPPER(*d);
-               *d++ = toCTRL(*d); 
+               *d = toCTRL(*d); 
+               d++;
 #else
                len = *s++;
                *d++ = toCTRL(len);
@@ -2641,7 +2651,7 @@ Perl_yylex(pTHX)
 #ifdef PERL_STRICT_CR
        Perl_warn(aTHX_ "Illegal character \\%03o (carriage return)", '\r');
        Perl_croak(aTHX_ 
-      "(Maybe you didn't strip carriage returns after a network transfer?)\n");
+      "\t(Maybe you didn't strip carriage returns after a network transfer?)\n");
 #endif
     case ' ': case '\t': case '\f': case 013:
        s++;
@@ -2649,6 +2659,11 @@ Perl_yylex(pTHX)
     case '#':
     case '\n':
        if (PL_lex_state != LEX_NORMAL || (PL_in_eval && !PL_rsfp)) {
+           if (*s == '#' && s == PL_linestart && PL_in_eval && !PL_rsfp) {
+               /* handle eval qq[#line 1 "foo"\n ...] */
+               CopLINE_dec(PL_curcop);
+               incline(s);
+           }
            d = PL_bufend;
            while (s < d && *s != '\n')
                s++;
@@ -3278,7 +3293,7 @@ Perl_yylex(pTHX)
        /* This kludge not intended to be bulletproof. */
        if (PL_tokenbuf[1] == '[' && !PL_tokenbuf[2]) {
            yylval.opval = newSVOP(OP_CONST, 0,
-                                  newSViv((IV)PL_compiling.cop_arybase));
+                                  newSViv(PL_compiling.cop_arybase));
            yylval.opval->op_private = OPpCONST_ARYBASE;
            TERM(THING);
        }
@@ -3612,7 +3627,7 @@ Perl_yylex(pTHX)
        tmp = keyword(PL_tokenbuf, len);
 
        /* Is this a word before a => operator? */
-       if (strnEQ(d,"=>",2)) {
+       if (*d == '=' && d[1] == '>') {
            CLINE;
            yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(PL_tokenbuf,0));
            yylval.opval->op_private = OPpCONST_BARE;
@@ -3767,10 +3782,18 @@ Perl_yylex(pTHX)
                    }
                }
 
-               /* If followed by a paren, it's certainly a subroutine. */
 
                PL_expect = XOPERATOR;
                s = skipspace(s);
+
+               /* Is this a word before a => operator? */
+               if (*s == '=' && s[1] == '>') {
+                   CLINE;
+                   sv_setpv(((SVOP*)yylval.opval)->op_sv, PL_tokenbuf);
+                   TERM(WORD);
+               }
+
+               /* If followed by a paren, it's certainly a subroutine. */
                if (*s == '(') {
                    CLINE;
                    if (gv && GvCVu(gv)) {
@@ -4489,7 +4512,7 @@ Perl_yylex(pTHX)
                            for (; !isSPACE(*d) && len; --len, ++d) ;
                        }
                        words = append_elem(OP_LIST, words,
-                                           newSVOP(OP_CONST, 0, newSVpvn(b, d-b)));
+                                           newSVOP(OP_CONST, 0, tokeq(newSVpvn(b, d-b))));
                    }
                }
                if (words) {