Not many people reuse an old config.sh nowadays, I suppose.

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

diff --git a/toke.c b/toke.c
index b1a9ff6..be7bacf 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -63,6 +63,11 @@
 #define PL_lex_state           (PL_parser->lex_state)
 #define PL_rsfp                        (PL_parser->rsfp)
 #define PL_rsfp_filters                (PL_parser->rsfp_filters)
+#define PL_in_my               (PL_parser->in_my)
+#define PL_in_my_stash         (PL_parser->in_my_stash)
+#define PL_tokenbuf            (PL_parser->tokenbuf)
+#define PL_multi_end           (PL_parser->multi_end)
+#define PL_error_count         (PL_parser->error_count)
 
 #ifdef PERL_MAD
 #  define PL_endwhite          (PL_parser->endwhite)
@@ -671,21 +676,20 @@ Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, bool new_filter)
 
     /* on scope exit, free this parser and restore any outer one */
     SAVEPARSER(parser);
+    parser->saved_curcop = PL_curcop;
 
     /* initialise lexer state */
 
-    SAVECOPLINE(PL_curcop);
-
 #ifdef PERL_MAD
     parser->curforce = -1;
 #else
     parser->nexttoke = 0;
 #endif
     parser->copline = NOLINE;
-    PL_lex_state = LEX_NORMAL;
+    parser->lex_state = LEX_NORMAL;
     parser->expect = XSTATE;
     parser->rsfp = rsfp;
-    parser->rsfp_filters = (new_filter || !oparser) ? NULL
+    parser->rsfp_filters = (new_filter || !oparser) ? newAV()
                : (AV*)SvREFCNT_inc(oparser->rsfp_filters);
 
     Newx(parser->lex_brackstack, 120, char);
@@ -723,6 +727,7 @@ Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, bool new_filter)
 void
 Perl_parser_free(pTHX_  const yy_parser *parser)
 {
+    PL_curcop = parser->saved_curcop;
     SvREFCNT_dec(parser->linestr);
 
     if (parser->rsfp == PerlIO_stdin())
@@ -1277,7 +1282,7 @@ S_curmad(pTHX_ char slot, SV *sv)
     /* keep a slot open for the head of the list? */
     if (slot != '_' && *where && (*where)->mad_key == '^') {
        (*where)->mad_key = slot;
-       sv_free((*where)->mad_val);
+       sv_free((SV*)((*where)->mad_val));
        (*where)->mad_val = (void*)sv;
     }
     else
@@ -3556,7 +3561,8 @@ Perl_yylex(pTHX)
     default:
        if (isIDFIRST_lazy_if(s,UTF))
            goto keylookup;
-       Perl_croak(aTHX_ "Unrecognized character \\x%02X", *s & 255);
+       len = UTF ? Perl_utf8_length(aTHX_ (U8 *) PL_linestart, (U8 *) s) : (STRLEN) (s - PL_linestart);
+       Perl_croak(aTHX_ "Unrecognized character \\x%02X in column %d", *s & 255, (int) len + 1);
     case 4:
     case 26:
        goto fake_eof;                  /* emulate EOF on ^D or ^Z */
@@ -4229,7 +4235,6 @@ Perl_yylex(pTHX)
                    switch (tmp) {
                    case KEY_or:
                    case KEY_and:
-                   case KEY_err:
                    case KEY_for:
                    case KEY_unless:
                    case KEY_if:
@@ -4291,10 +4296,6 @@ Perl_yylex(pTHX)
                        sv_free(sv);
                        CvMETHOD_on(PL_compcv);
                    }
-                   else if (!PL_in_my && len == 9 && strnEQ(SvPVX(sv), "assertion", len)) {
-                       sv_free(sv);
-                       CvASSERTION_on(PL_compcv);
-                   }
                    /* After we've set the flags, it could be argued that
                       we don't need to do the attributes.pm-based setting
                       process, and shouldn't bother appending recognized
@@ -4389,7 +4390,9 @@ Perl_yylex(pTHX)
            --PL_lex_brackets;
        if (PL_lex_state == LEX_INTERPNORMAL) {
            if (PL_lex_brackets == 0) {
-               if (*s != '[' && *s != '{' && (*s != '-' || s[1] != '>'))
+               if (*s == '-' && s[1] == '>')
+                   PL_lex_state = LEX_INTERPENDMAYBE;
+               else if (*s != '[' && *s != '{')
                    PL_lex_state = LEX_INTERPEND;
            }
        }
@@ -5427,18 +5430,7 @@ Perl_yylex(pTHX)
                            d++;
                        if (*d == ')' && (sv = gv_const_sv(gv))) {
                            s = d + 1;
-#ifdef PERL_MAD
-                           if (PL_madskills) {
-                               char *par = SvPVX(PL_linestr) + PL_realtokenstart; 
-                               sv_catpvn(PL_thistoken, par, s - par);
-                               if (PL_nextwhite) {
-                                   sv_free(PL_nextwhite);
-                                   PL_nextwhite = 0;
-                               }
-                           }
-                           else
-#endif
-                               goto its_constant;
+                           goto its_constant;
                        }
                    }
 #ifdef PERL_MAD
@@ -5485,7 +5477,7 @@ Perl_yylex(pTHX)
                                "Ambiguous use of -%s resolved as -&%s()",
                                PL_tokenbuf, PL_tokenbuf);
                    /* Check for a constant sub */
-                   if ((sv = gv_const_sv(gv)) && !PL_madskills) {
+                   if ((sv = gv_const_sv(gv))) {
                  its_constant:
                        SvREFCNT_dec(((SVOP*)yylval.opval)->op_sv);
                        ((SVOP*)yylval.opval)->op_sv = SvREFCNT_inc_simple(sv);
@@ -5929,9 +5921,6 @@ Perl_yylex(pTHX)
        case KEY_eof:
            UNI(OP_EOF);
 
-       case KEY_err:
-           OPERATOR(DOROP);
-
        case KEY_exp:
            UNI(OP_EXP);
 
@@ -7335,14 +7324,6 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
 
               goto unknown;
 
-            case 'r':
-              if (name[2] == 'r')
-              {                                   /* err        */
-                return (all_keywords || FEATURE_IS_ENABLED("err") ? -KEY_err : 0);
-              }
-
-              goto unknown;
-
             case 'x':
               if (name[2] == 'p')
               {                                   /* exp        */
@@ -12548,8 +12529,10 @@ Perl_yyerror(pTHX_ const char *s)
                 (int)PL_multi_open,(int)PL_multi_close,(IV)PL_multi_start);
         PL_multi_end = 0;
     }
-    if (PL_in_eval & EVAL_WARNONLY && ckWARN_d(WARN_SYNTAX))
-       Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "%"SVf, SVfARG(msg));
+    if (PL_in_eval & EVAL_WARNONLY) {
+       if (ckWARN_d(WARN_SYNTAX))
+           Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "%"SVf, SVfARG(msg));
+    }
     else
        qerror(msg);
     if (PL_error_count >= 10) {