"All tests successful" VC6.0 Win32

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

diff --git a/toke.c b/toke.c
index 1527daa..9d3acd2 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1,6 +1,6 @@
 /*    toke.c
  *
- *    Copyright (c) 1991-2001, Larry Wall
+ *    Copyright (c) 1991-2002, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -514,11 +514,7 @@ S_incline(pTHX_ char *s)
     ch = *t;
     *t = '\0';
     if (t - s > 0) {
-#ifdef USE_ITHREADS
-       Safefree(CopFILE(PL_curcop));
-#else
-       SvREFCNT_dec(CopFILEGV(PL_curcop));
-#endif
+       CopFILE_free(PL_curcop);
        CopFILE_set(PL_curcop, s);
     }
     *t = ch;
@@ -1428,7 +1424,9 @@ S_scan_const(pTHX_ char *start)
                /* FALL THROUGH */
            default:
                {
-                   if (ckWARN(WARN_MISC) && isALNUM(*s))
+                   if (ckWARN(WARN_MISC) &&
+                       isALNUM(*s) && 
+                       *s != '_')
                        Perl_warner(aTHX_ WARN_MISC,
                               "Unrecognized escape \\%c passed through",
                               *s);
@@ -2184,7 +2182,7 @@ Perl_yylex(pTHX)
     bool bof = FALSE;
 
     /* check if there's an identifier for us to look at */
-    if (PL_pending_ident) 
+    if (PL_pending_ident)
         return S_pending_ident(aTHX);
 
     /* no identifier pending identification */
@@ -3813,6 +3811,10 @@ Perl_yylex(pTHX)
            }
            else {                      /* no override */
                tmp = -tmp;
+               if (tmp == KEY_dump && ckWARN(WARN_MISC)) {
+                   Perl_warner(aTHX_ WARN_MISC,
+                           "dump() better written as CORE::dump()");
+               }
                gv = Nullgv;
                gvp = 0;
                if (ckWARN(WARN_AMBIGUOUS) && hgv
@@ -4904,7 +4906,7 @@ Perl_yylex(pTHX)
                char tmpbuf[sizeof PL_tokenbuf];
                SSize_t tboffset = 0;
                expectation attrful;
-               bool have_name, have_proto;
+               bool have_name, have_proto, bad_proto;
                int key = tmp;
 
                s = skipspace(s);
@@ -4952,14 +4954,22 @@ Perl_yylex(pTHX)
                    s = scan_str(s,FALSE,FALSE);
                    if (!s)
                        Perl_croak(aTHX_ "Prototype not terminated");
-                   /* strip spaces */
+                   /* strip spaces and check for bad characters */
                    d = SvPVX(PL_lex_stuff);
                    tmp = 0;
+                   bad_proto = FALSE;
                    for (p = d; *p; ++p) {
-                       if (!isSPACE(*p))
+                       if (!isSPACE(*p)) {
                            d[tmp++] = *p;
+                           if (!strchr("$@%*;[]&\\", *p))
+                               bad_proto = TRUE;
+                       }
                    }
                    d[tmp] = '\0';
+                   if (bad_proto && ckWARN(WARN_SYNTAX))
+                       Perl_warner(aTHX_ WARN_SYNTAX,
+                                   "Illegal character in prototype for %s : %s",
+                                   SvPVX(PL_subname), d);
                    SvCUR(PL_lex_stuff) = tmp;
                    have_proto = TRUE;
 
@@ -5221,7 +5231,7 @@ S_pending_ident(pTHX)
                 gv_fetchpv(SvPVX(sym),
                     (PL_in_eval
                         ? (GV_ADDMULTI | GV_ADDINEVAL)
-                        : TRUE
+                        : GV_ADDMULTI
                     ),
                     ((PL_tokenbuf[0] == '$') ? SVt_PV
                      : (PL_tokenbuf[0] == '@') ? SVt_PVAV
@@ -6649,6 +6659,9 @@ S_scan_inputsymbol(pTHX_ char *start)
        return s;
     }
     else {
+       bool readline_overriden = FALSE;
+       GV *gv_readline = Nullgv;
+       GV **gvp;
        /* we're in a filehandle read situation */
        d = PL_tokenbuf;
 
@@ -6656,6 +6669,15 @@ S_scan_inputsymbol(pTHX_ char *start)
        if (!len)
            (void)strcpy(d,"ARGV");
 
+       /* Check whether readline() is overriden */
+       if (((gv_readline = gv_fetchpv("readline", FALSE, SVt_PVCV))
+               && GvCVu(gv_readline) && GvIMPORTED_CV(gv_readline))
+               ||
+               ((gvp = (GV**)hv_fetch(PL_globalstash, "readline", 8, FALSE))
+               && (gv_readline = *gvp) != (GV*)&PL_sv_undef
+               && GvCVu(gv_readline) && GvIMPORTED_CV(gv_readline)))
+           readline_overriden = TRUE;
+
        /* if <$fh>, create the ops to turn the variable into a
           filehandle
        */
@@ -6677,7 +6699,11 @@ S_scan_inputsymbol(pTHX_ char *start)
                else {
                    OP *o = newOP(OP_PADSV, 0);
                    o->op_targ = tmp;
-                   PL_lex_op = (OP*)newUNOP(OP_READLINE, 0, o);
+                   PL_lex_op = readline_overriden
+                       ? (OP*)newUNOP(OP_ENTERSUB, OPf_STACKED,
+                               append_elem(OP_LIST, o,
+                                   newCVREF(0, newGVOP(OP_GV,0,gv_readline))))
+                       : (OP*)newUNOP(OP_READLINE, 0, o);
                }
            }
            else {
@@ -6687,11 +6713,16 @@ intro_sym:
                gv = gv_fetchpv(d,
                                (PL_in_eval
                                 ? (GV_ADDMULTI | GV_ADDINEVAL)
-                                : TRUE),
+                                : GV_ADDMULTI),
                                SVt_PV);
-               PL_lex_op = (OP*)newUNOP(OP_READLINE, 0,
-                                           newUNOP(OP_RV2SV, 0,
-                                               newGVOP(OP_GV, 0, gv)));
+               PL_lex_op = readline_overriden
+                   ? (OP*)newUNOP(OP_ENTERSUB, OPf_STACKED,
+                           append_elem(OP_LIST,
+                               newUNOP(OP_RV2SV, 0, newGVOP(OP_GV, 0, gv)),
+                               newCVREF(0, newGVOP(OP_GV, 0, gv_readline))))
+                   : (OP*)newUNOP(OP_READLINE, 0,
+                           newUNOP(OP_RV2SV, 0,
+                               newGVOP(OP_GV, 0, gv)));
            }
            PL_lex_op->op_flags |= OPf_SPECIAL;
            /* we created the ops in PL_lex_op, so make yylval.ival a null op */
@@ -6702,7 +6733,12 @@ intro_sym:
           (<Foo::BAR> or <FOO>) so build a simple readline OP */
        else {
            GV *gv = gv_fetchpv(d,TRUE, SVt_PVIO);
-           PL_lex_op = (OP*)newUNOP(OP_READLINE, 0, newGVOP(OP_GV, 0, gv));
+           PL_lex_op = readline_overriden
+               ? (OP*)newUNOP(OP_ENTERSUB, OPf_STACKED,
+                       append_elem(OP_LIST,
+                           newGVOP(OP_GV, 0, gv),
+                           newCVREF(0, newGVOP(OP_GV, 0, gv_readline))))
+               : (OP*)newUNOP(OP_READLINE, 0, newGVOP(OP_GV, 0, gv));
            yylval.ival = OP_NULL;
        }
     }