Use dev version for JSON::PP

[perl5.git] / toke.c

diff --git a/toke.c b/toke.c
index 297559a..8cca3f4 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -3463,7 +3463,7 @@ S_scan_const(pTHX_ char *start)
                 * to recode the rest of the string into utf8 */
                
                /* Here uv is the ordinal of the next character being added */
-               if (!NATIVE_IS_INVARIANT(uv)) {
+               if (!UVCHR_IS_INVARIANT(uv)) {
                    if (!has_utf8 && uv > 255) {
                        /* Might need to recode whatever we have accumulated so
                         * far if it contains any chars variant in utf8 or
@@ -3797,7 +3797,7 @@ S_scan_const(pTHX_ char *start)
     default_action:
        /* If we started with encoded form, or already know we want it,
           then encode the next character */
-       if (! NATIVE_IS_INVARIANT((U8)(*s)) && (this_utf8 || has_utf8)) {
+       if (! NATIVE_BYTE_IS_INVARIANT((U8)(*s)) && (this_utf8 || has_utf8)) {
            STRLEN len  = 1;
 
 
@@ -4682,6 +4682,20 @@ S_word_takes_any_delimeter(char *p, STRLEN len)
            (p[0] == 'q' && strchr("qwxr", p[1]))));
 }
 
+static void
+S_check_scalar_slice(pTHX_ char *s)
+{
+    s++;
+    while (*s == ' ' || *s == '\t') s++;
+    if (*s == 'q' && s[1] == 'w'
+     && !isWORDCHAR_lazy_if(s+2,UTF))
+       return;
+    while (*s && (isWORDCHAR_lazy_if(s,UTF) || strchr(" \t$#+-'\"", *s)))
+       s += UTF ? UTF8SKIP(s) : 1;
+    if (*s == '}' || *s == ']')
+       pl_yylval.ival = OPpSLICEWARNING;
+}
+
 /*
   yylex
 
@@ -5159,22 +5173,20 @@ Perl_yylex(pTHX)
            goto keylookup;
        {
         SV *dsv = newSVpvs_flags("", SVs_TEMP);
-        const char *c = UTF ? savepv(sv_uni_display(dsv, newSVpvn_flags(s,
+        const char *c = UTF ? sv_uni_display(dsv, newSVpvn_flags(s,
                                                     UTF8SKIP(s),
                                                     SVs_TEMP | SVf_UTF8),
-                                            10, UNI_DISPLAY_ISPRINT))
+                                            10, UNI_DISPLAY_ISPRINT)
                             : Perl_form(aTHX_ "\\x%02X", (unsigned char)*s);
         len = UTF ? Perl_utf8_length(aTHX_ (U8 *) PL_linestart, (U8 *) s) : (STRLEN) (s - PL_linestart);
         if (len > UNRECOGNIZED_PRECEDE_COUNT) {
             d = UTF ? (char *) Perl_utf8_hop(aTHX_ (U8 *) s, -UNRECOGNIZED_PRECEDE_COUNT) : s - UNRECOGNIZED_PRECEDE_COUNT;
         } else {
             d = PL_linestart;
-        }      
-        *s = '\0';
-        sv_setpv(dsv, d);
-        if (UTF)
-            SvUTF8_on(dsv);
-        Perl_croak(aTHX_  "Unrecognized character %s; marked by <-- HERE after %"SVf"<-- HERE near column %d", c, SVfARG(dsv), (int) len + 1);
+        }
+        Perl_croak(aTHX_  "Unrecognized character %s; marked by <-- HERE after %"UTF8f"<-- HERE near column %d", c,
+                          UTF8fARG(UTF, (s - d), d),
+                         (int) len + 1);
     }
     case 4:
     case 26:
@@ -5802,6 +5814,7 @@ Perl_yylex(pTHX)
        Mop(OP_MULTIPLY);
 
     case '%':
+    {
        if (PL_expect == XOPERATOR) {
            if (s[1] == '=' && !PL_lex_allbrackets &&
                    PL_lex_fakeeof >= LEX_FAKEEOF_ASSIGN)
@@ -5813,13 +5826,25 @@ Perl_yylex(pTHX)
        PL_tokenbuf[0] = '%';
        s = scan_ident(s, PL_bufend, PL_tokenbuf + 1,
                sizeof PL_tokenbuf - 1, FALSE);
+       pl_yylval.ival = 0;
        if (!PL_tokenbuf[1]) {
            PREREF('%');
        }
+       if ((PL_expect != XREF || PL_oldoldbufptr == PL_last_lop) && intuit_more(s)) {
+           if (*s == '[')
+               PL_tokenbuf[0] = '@';
+
+           /* Warn about % where they meant $. */
+           if (*s == '[' || *s == '{') {
+               if (ckWARN(WARN_SYNTAX)) {
+                   S_check_scalar_slice(aTHX_ s);
+               }
+           }
+       }
        PL_expect = XOPERATOR;
        force_ident_maybe_lex('%');
        TERM('%');
-
+    }
     case '^':
        if (!PL_lex_allbrackets && PL_lex_fakeeof >=
                (s[1] == '=' ? LEX_FAKEEOF_ASSIGN : LEX_FAKEEOF_BITWISE))
@@ -6672,6 +6697,7 @@ Perl_yylex(pTHX)
            no_op("Array", s);
        PL_tokenbuf[0] = '@';
        s = scan_ident(s, PL_bufend, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, FALSE);
+       pl_yylval.ival = 0;
        if (!PL_tokenbuf[1]) {
            PREREF('@');
        }
@@ -6684,18 +6710,7 @@ Perl_yylex(pTHX)
            /* Warn about @ where they meant $. */
            if (*s == '[' || *s == '{') {
                if (ckWARN(WARN_SYNTAX)) {
-                   const char *t = s + 1;
-                   while (*t && (isWORDCHAR_lazy_if(t,UTF) || strchr(" \t$#+-'\"", *t)))
-                       t += UTF ? UTF8SKIP(t) : 1;
-                   if (*t == '}' || *t == ']') {
-                       t++;
-                       PL_bufptr = PEEKSPACE(PL_bufptr); /* XXX can realloc */
-       /* diag_listed_as: Scalar value @%s[%s] better written as $%s[%s] */
-                       Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
-                        "Scalar value %"UTF8f" better written as $%"UTF8f,
-                         UTF8fARG(UTF, t-PL_bufptr, PL_bufptr),
-                         UTF8fARG(UTF, t-PL_bufptr-1, PL_bufptr+1));
-                   }
+                   S_check_scalar_slice(aTHX_ s);
                }
            }
        }
@@ -11888,7 +11903,7 @@ Perl_scan_vstring(pTHX_ const char *s, const char *const e, SV *sv)
            /* Append native character for the rev point */
            tmpend = uvchr_to_utf8(tmpbuf, rev);
            sv_catpvn(sv, (const char*)tmpbuf, tmpend - tmpbuf);
-           if (!NATIVE_IS_INVARIANT(rev))
+           if (!UVCHR_IS_INVARIANT(rev))
                 SvUTF8_on(sv);
            if (pos + 1 < e && *pos == '.' && isDIGIT(pos[1]))
                 s = ++pos;