New shiny models

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

diff --git a/toke.c b/toke.c
index 03bc682..5c24cca 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1275,7 +1275,7 @@ S_force_word(pTHX_ register char *start, int token, int check_keyword, int allow
        (allow_initial_tick && *s == '\'') )
     {
        s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, allow_pack, &len);
-       if (check_keyword && keyword(PL_tokenbuf, len))
+       if (check_keyword && keyword(PL_tokenbuf, len, 0))
            return start;
        start_force(PL_curforce);
        if (PL_madskills)
@@ -1793,7 +1793,7 @@ S_scan_const(pTHX_ char *start)
     const char * const leaveit = /* set of acceptably-backslashed characters */
        (const char *)
        (PL_lex_inpat
-        ? "\\.^$@AGZdDwWsSbBpPXC+*?|()-nrtfeaxcz0123456789[{]} \t\n\r\f\v#"
+        ? "\\.^$@AGZdDwWsSbBpPXC+*?|()-Nnrktfeaxcz0123456789[{]} \t\n\r\f\v#"
         : "");
 
     if (PL_lex_inwhat == OP_TRANS && PL_sublex_info.sub_op) {
@@ -2179,6 +2179,7 @@ S_scan_const(pTHX_ char *start)
                    SV *res;
                    STRLEN len;
                    const char *str;
+                   SV *type;
 
                    if (!e) {
                        yyerror("Missing right brace on \\N{}");
@@ -2192,12 +2193,17 @@ S_scan_const(pTHX_ char *start)
                        s += 3;
                        len = e - s;
                        uv = grok_hex(s, &len, &flags, NULL);
+                       if ( e > s && len != (STRLEN)(e - s) ) {
+                           uv = 0xFFFD;
+                       }
                        s = e + 1;
                        goto NUM_ESCAPE_INSERT;
                    }
                    res = newSVpvn(s + 1, e - s - 1);
+                   type = newSVpvn(s - 2,e - s + 3);
                    res = new_constant( NULL, 0, "charnames",
-                                       res, NULL, "\\N{...}" );
+                                       res, NULL, SvPVX(type) );
+                   SvREFCNT_dec(type);         
                    if (has_utf8)
                        sv_utf8_upgrade(res);
                    str = SvPV_const(res,len);
@@ -2508,7 +2514,7 @@ S_intuit_more(pTHX_ register char *s)
                    while (isALPHA(*s))
                        *d++ = *s++;
                    *d = '\0';
-                   if (keyword(tmpbuf, d - tmpbuf))
+                   if (keyword(tmpbuf, d - tmpbuf, 0))
                        weight -= 150;
                }
                if (un_char == last_un_char + 1)
@@ -2587,14 +2593,14 @@ S_intuit_method(pTHX_ char *start, GV *gv, CV *cv)
        len = start - SvPVX(PL_linestr);
 #endif
        s = PEEKSPACE(s);
-#ifdef PERLMAD
+#ifdef PERL_MAD
        start = SvPVX(PL_linestr) + len;
 #endif
        PL_bufptr = start;
        PL_expect = XREF;
        return *s == '(' ? FUNCMETH : METHOD;
     }
-    if (!keyword(tmpbuf, len)) {
+    if (!keyword(tmpbuf, len, 0)) {
        if (len > 2 && tmpbuf[len - 2] == ':' && tmpbuf[len - 1] == ':') {
            len -= 2;
            tmpbuf[len] = '\0';
@@ -4110,7 +4116,7 @@ Perl_yylex(pTHX)
                I32 tmp;
                SV *sv;
                d = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
-               if (isLOWER(*s) && (tmp = keyword(PL_tokenbuf, len))) {
+               if (isLOWER(*s) && (tmp = keyword(PL_tokenbuf, len, 0))) {
                    if (tmp < 0) tmp = -tmp;
                    switch (tmp) {
                    case KEY_or:
@@ -4756,7 +4762,7 @@ Perl_yylex(pTHX)
                    char tmpbuf[sizeof PL_tokenbuf];
                    int t2;
                    scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
-                   if ((t2 = keyword(tmpbuf, len))) {
+                   if ((t2 = keyword(tmpbuf, len, 0))) {
                        /* binary operators exclude handle interpretations */
                        switch (t2) {
                        case -KEY_x:
@@ -5061,7 +5067,7 @@ Perl_yylex(pTHX)
        }
 
        /* Check for keywords */
-       tmp = keyword(PL_tokenbuf, len);
+       tmp = keyword(PL_tokenbuf, len, 0);
 
        /* Is this a word before a => operator? */
        if (*d == '=' && d[1] == '>') {
@@ -5445,7 +5451,7 @@ Perl_yylex(pTHX)
                        STRLEN tmplen;
                        d = s;
                        d = scan_word(d, tmpbuf, sizeof tmpbuf, TRUE, &tmplen);
-                       if (!keyword(tmpbuf,tmplen))
+                       if (!keyword(tmpbuf, tmplen, 0))
                            probable_sub = 1;
                        else {
                            while (d < PL_bufend && isSPACE(*d))
@@ -5645,7 +5651,7 @@ Perl_yylex(pTHX)
                s += 2;
                d = s;
                s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
-               if (!(tmp = keyword(PL_tokenbuf, len)))
+               if (!(tmp = keyword(PL_tokenbuf, len, 0)))
                    Perl_croak(aTHX_ "CORE::%s is not a keyword", PL_tokenbuf);
                if (tmp < 0)
                    tmp = -tmp;
@@ -6947,7 +6953,7 @@ S_pending_ident(pTHX)
  */
 
 I32
-Perl_keyword (pTHX_ const char *name, I32 len)
+Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
 {
     dVAR;
   switch (len)
@@ -7219,7 +7225,7 @@ Perl_keyword (pTHX_ const char *name, I32 len)
             case 'r':
               if (name[2] == 'r')
               {                                   /* err        */
-                return (FEATURE_IS_ENABLED("err") ? -KEY_err : 0);
+                return (all_keywords || FEATURE_IS_ENABLED("err") ? -KEY_err : 0);
               }
 
               goto unknown;
@@ -7358,7 +7364,7 @@ Perl_keyword (pTHX_ const char *name, I32 len)
             case 'a':
               if (name[2] == 'y')
               {                                   /* say        */
-                return (FEATURE_IS_ENABLED("say") ? -KEY_say : 0);
+                return (all_keywords || FEATURE_IS_ENABLED("say") ? -KEY_say : 0);
               }
 
               goto unknown;
@@ -7882,7 +7888,7 @@ Perl_keyword (pTHX_ const char *name, I32 len)
               if (name[2] == 'e' &&
                   name[3] == 'n')
               {                                   /* when       */
-                return (FEATURE_IS_ENABLED("switch") ? KEY_when : 0);
+                return (all_keywords || FEATURE_IS_ENABLED("switch") ? KEY_when : 0);
               }
 
               goto unknown;
@@ -7965,7 +7971,7 @@ Perl_keyword (pTHX_ const char *name, I32 len)
                   name[3] == 'a' &&
                   name[4] == 'k')
               {                                   /* break      */
-                return (FEATURE_IS_ENABLED("switch") ? -KEY_break : 0);
+                return (all_keywords || FEATURE_IS_ENABLED("switch") ? -KEY_break : 0);
               }
 
               goto unknown;
@@ -8093,7 +8099,7 @@ Perl_keyword (pTHX_ const char *name, I32 len)
               name[3] == 'e' &&
               name[4] == 'n')
           {                                       /* given      */
-            return (FEATURE_IS_ENABLED("switch") ? KEY_given : 0);
+            return (all_keywords || FEATURE_IS_ENABLED("switch") ? KEY_given : 0);
           }
 
           goto unknown;
@@ -8261,7 +8267,7 @@ Perl_keyword (pTHX_ const char *name, I32 len)
                   if (name[3] == 't' &&
                       name[4] == 'e')
                   {                               /* state      */
-                    return (FEATURE_IS_ENABLED("state") ? KEY_state : 0);
+                    return (all_keywords || FEATURE_IS_ENABLED("state") ? KEY_state : 0);
                   }
 
                   goto unknown;
@@ -8929,7 +8935,7 @@ Perl_keyword (pTHX_ const char *name, I32 len)
                         name[5] == 'l' &&
                         name[6] == 't')
                     {                             /* default    */
-                      return (FEATURE_IS_ENABLED("switch") ? KEY_default : 0);
+                      return (all_keywords || FEATURE_IS_ENABLED("switch") ? KEY_default : 0);
                     }
 
                     goto unknown;
@@ -10362,7 +10368,7 @@ S_checkcomma(pTHX_ const char *s, const char *name, const char *what)
            s++;
        if (*s == ',') {
            GV* gv;
-           if (keyword(w, s - w))
+           if (keyword(w, s - w, 0))
                return;
 
            gv = gv_fetchpvn_flags(w, s - w, 0, SVt_PVCV);
@@ -10622,7 +10628,7 @@ S_scan_ident(pTHX_ register char *s, register const char *send, char *dest, STRL
            while (s < send && SPACE_OR_TAB(*s))
                s++;
            if ((*s == '[' || (*s == '{' && strNE(dest, "sub")))) {
-               if (ckWARN(WARN_AMBIGUOUS) && keyword(dest, d - dest)) {
+               if (ckWARN(WARN_AMBIGUOUS) && keyword(dest, d - dest, 0)) {
                    const char * const brack =
                        (const char *)
                        ((*s == '[') ? "[...]" : "{...}");
@@ -10656,7 +10662,7 @@ S_scan_ident(pTHX_ register char *s, register const char *send, char *dest, STRL
            }
            if (PL_lex_state == LEX_NORMAL) {
                if (ckWARN(WARN_AMBIGUOUS) &&
-                   (keyword(dest, d - dest) || get_cv(dest, FALSE)))
+                   (keyword(dest, d - dest, 0) || get_cv(dest, FALSE)))
                {
                    if (funny == '#')
                        funny = '@';
@@ -11414,7 +11420,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
 {
     dVAR;
     SV *sv;                            /* scalar value: string */
-    char *tmps;                                /* temp string, used for delimiter matching */
+    const char *tmps;                  /* temp string, used for delimiter matching */
     register char *s = start;          /* current position in the buffer */
     register char term;                        /* terminating character */
     register char *to;                 /* current position in the sv's data */