Integrate mainperl.

[perl5.git] / toke.c

diff --git a/toke.c b/toke.c
index 719867b..8664b8f 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -14,6 +14,9 @@
 #include "EXTERN.h"
 #include "perl.h"
 
+#define yychar PL_yychar
+#define yylval PL_yylval
+
 #ifndef PERL_OBJECT
 static void check_uni _((void));
 static void  force_next _((I32 type));
@@ -952,14 +955,16 @@ scan_const(char *start)
 
        /* if we get here, we're not doing a transliteration */
 
-       /* skip for regexp comments /(?#comment)/ */
+       /* skip for regexp comments /(?#comment)/ and code /(?{code})/,
+          except for the last char, which will be done separately. */
        else if (*s == '(' && PL_lex_inpat && s[1] == '?') {
            if (s[2] == '#') {
                while (s < send && *s != ')')
                    *d++ = *s++;
-           } else if (s[2] == '{') {   /* This should march regcomp.c */
+           } else if (s[2] == '{'
+                      || s[2] == 'p' && s[3] == '{') { /* This should march regcomp.c */
                I32 count = 1;
-               char *regparse = s + 3;
+               char *regparse = s + (s[2] == '{' ? 3 : 4);
                char c;
 
                while (count && (c = *regparse)) {
@@ -971,11 +976,11 @@ scan_const(char *start)
                        count--;
                    regparse++;
                }
-               if (*regparse == ')')
-                   regparse++;
-               else
+               if (*regparse != ')') {
+                   regparse--;         /* Leave one char for continuation. */
                    yyerror("Sequence (?{...}) not terminated or not {}-balanced");
-               while (s < regparse && *s != ')')
+               }
+               while (s < regparse)
                    *d++ = *s++;
            }
        }
@@ -1071,8 +1076,10 @@ scan_const(char *start)
                if (*s == '{') {
                    char* e = strchr(s, '}');
 
-                   if (!e)
+                   if (!e) {
                        yyerror("Missing right brace on \\x{}");
+                       e = s;
+                   }
                    if (!utf) {
                        dTHR;
                        if (ckWARN(WARN_UTF8))
@@ -1431,7 +1438,7 @@ filter_del(filter_t funcp)
     if (!PL_rsfp_filters || AvFILLp(PL_rsfp_filters)<0)
        return;
     /* if filter is on top of stack (usual case) just pop it off */
-    if (IoDIRP(FILTER_DATA(AvFILLp(PL_rsfp_filters))) == (void*)funcp){
+    if (IoDIRP(FILTER_DATA(AvFILLp(PL_rsfp_filters))) == (DIR*)funcp){
        sv_free(av_pop(PL_rsfp_filters));
 
         return;
@@ -1527,8 +1534,6 @@ filter_gets(register SV *sv, register PerlIO *fp, STRLEN append)
        { "OPERATOR", "TERM", "REF", "STATE", "BLOCK", "TERMBLOCK" };
 #endif
 
-EXT int yychar;                /* last token */
-
 /*
   yylex
 
@@ -5072,12 +5077,9 @@ scan_ident(register char *s, register char *send, char *dest, STRLEN destlen, I3
        return s;
     }
     if (*s == '$' && s[1] &&
-      (isALNUM(s[1]) || strchr("${", s[1]) || strnEQ(s+1,"::",2)) )
+       (isALNUM(s[1]) || strchr("${", s[1]) || strnEQ(s+1,"::",2)) )
     {
-       if (isDIGIT(s[1]) && PL_lex_state == LEX_INTERPNORMAL)
-           deprecate("\"$$<digit>\" to mean \"${$}<digit>\"");
-       else
-           return s;
+       return s;
     }
     if (*s == '{') {
        bracket = s;