Update INSTALL regarding binary compatibility

[perl5.git] / toke.c

diff --git a/toke.c b/toke.c
index daa60a1..544cd1a 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -714,8 +714,9 @@ Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, bool new_filter)
 
     if (!len) {
        parser->linestr = newSVpvs("\n;");
-    } else if (SvREADONLY(line) || s[len-1] != ';') {
-       parser->linestr = newSVsv(line);
+    } else if (SvREADONLY(line) || s[len-1] != ';' || !SvPOK(line)) {
+       /* avoid tie/overload weirdness */
+       parser->linestr = newSVpvn_flags(s, len, SvUTF8(line));
        if (s[len-1] != ';')
            sv_catpvs(parser->linestr, "\n;");
     } else {
@@ -2811,7 +2812,8 @@ S_scan_const(pTHX_ char *start)
 
            s++;
 
-           /* deprecate \1 in strings and substitution replacements */
+           /* warn on \1 - \9 in substitution replacements, but note that \11
+            * is an octal; and \19 is \1 followed by '9' */
            if (PL_lex_inwhat == OP_SUBST && !PL_lex_inpat &&
                isDIGIT(*s) && *s != '0' && !isDIGIT(s[1]))
            {
@@ -2866,7 +2868,7 @@ S_scan_const(pTHX_ char *start)
                    goto default_action;
                }
 
-           /* eg. \132 indicates the octal constant 0x132 */
+           /* eg. \132 indicates the octal constant 0132 */
            case '0': case '1': case '2': case '3':
            case '4': case '5': case '6': case '7':
                {
@@ -2877,6 +2879,21 @@ S_scan_const(pTHX_ char *start)
                }
                goto NUM_ESCAPE_INSERT;
 
+           /* eg. \o{24} indicates the octal constant \024 */
+           case 'o':
+               {
+                   STRLEN len;
+                   const char* error;
+
+                   bool valid = grok_bslash_o(s, &uv, &len, &error, 1);
+                   s += len;
+                   if (! valid) {
+                       yyerror(error);
+                       continue;
+                   }
+                   goto NUM_ESCAPE_INSERT;
+               }
+
            /* eg. \x24 indicates the hex constant 0x24 */
            case 'x':
                ++s;
@@ -3756,8 +3773,6 @@ Perl_filter_del(pTHX_ filter_t funcp)
     /* if filter is on top of stack (usual case) just pop it off */
     datasv = FILTER_DATA(AvFILLp(PL_rsfp_filters));
     if (IoANY(datasv) == FPTR2DPTR(void *, funcp)) {
-       IoFLAGS(datasv) &= ~IOf_FAKE_DIRP;
-       IoANY(datasv) = (void *)NULL;
        sv_free(av_pop(PL_rsfp_filters));
 
         return;
@@ -6190,8 +6205,9 @@ Perl_yylex(pTHX)
                gvp = 0;
                if (hgv && tmp != KEY_x && tmp != KEY_CORE)     /* never ambiguous */
                    Perl_ck_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
-                                  "Ambiguous call resolved as CORE::%s(), %s",
-                                  GvENAME(hgv), "qualify as such or use &");
+                                  "Ambiguous call resolved as CORE::%s(), "
+                                  "qualify as such or use &",
+                                  GvENAME(hgv));
            }
        }
 
@@ -6479,10 +6495,27 @@ Perl_yylex(pTHX)
                        const char *proto = SvPV_const(MUTABLE_SV(cv), protolen);
                        if (!protolen)
                            TERM(FUNC0SUB);
-                       if ((*proto == '$' || *proto == '_') && proto[1] == '\0')
-                           OPERATOR(UNIOPSUB);
                        while (*proto == ';')
                            proto++;
+                       if (
+                           (
+                               (
+                                   *proto == '$' || *proto == '_'
+                                || *proto == '*'
+                               )
+                            && proto[1] == '\0'
+                           )
+                        || (
+                            *proto == '\\' && proto[1] && proto[2] == '\0'
+                           )
+                       )
+                           OPERATOR(UNIOPSUB);
+                       if (*proto == '\\' && proto[1] == '[') {
+                           const char *p = proto + 2;
+                           while(*p && *p != ']')
+                               ++p;
+                           if(*p == ']' && !p[1]) OPERATOR(UNIOPSUB);
+                       }
                        if (*proto == '&' && *s == '{') {
                            if (PL_curstash)
                                sv_setpvs(PL_subname, "__ANON__");
@@ -8501,7 +8534,7 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
           if (name[1] == 'i' &&
               name[2] == 'e')
           {                                       /* tie        */
-            return KEY_tie;
+            return -KEY_tie;
           }
 
           goto unknown;
@@ -8945,7 +8978,7 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
                 case 'e':
                   if (name[3] == 'd')
                   {                               /* tied       */
-                    return KEY_tied;
+                    return -KEY_tied;
                   }
 
                   goto unknown;
@@ -9440,7 +9473,7 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
                     {
                       case 'e':
                         {                         /* untie      */
-                          return KEY_untie;
+                          return -KEY_untie;
                         }
 
                       case 'l':
@@ -11887,6 +11920,12 @@ S_scan_pat(pTHX_ char *start, I32 type)
 #endif
     while (*s && strchr(valid_flags, *s))
        pm->op_pmflags = S_pmflag(pm->op_pmflags, *s++);
+
+    if (isALNUM(*s)) {
+       Perl_ck_warner_d(aTHX_ packWARN(WARN_SYNTAX),
+           "Having no space between pattern and following word is deprecated");
+
+    }
 #ifdef PERL_MAD
     if (PL_madskills && modstart != s) {
        SV* tmptoken = newSVpvn(modstart, s - modstart);
@@ -11967,8 +12006,14 @@ S_scan_subst(pTHX_ char *start)
        }
        else if (strchr(S_PAT_MODS, *s))
            pm->op_pmflags = S_pmflag(pm->op_pmflags, *s++);
-       else
+       else {
+           if (isALNUM(*s)) {
+               Perl_ck_warner_d(aTHX_ packWARN(WARN_SYNTAX),
+                   "Having no space between pattern and following word is deprecated");
+
+           }
            break;
+       }
     }
 
 #ifdef PERL_MAD
@@ -12966,11 +13011,11 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
            const char *base, *Base, *max;
 
            /* check for hex */
-           if (s[1] == 'x') {
+           if (s[1] == 'x' || s[1] == 'X') {
                shift = 4;
                s += 2;
                just_zero = FALSE;
-           } else if (s[1] == 'b') {
+           } else if (s[1] == 'b' || s[1] == 'B') {
                shift = 1;
                s += 2;
                just_zero = FALSE;