[win32] merge change#985 from maintbranch
[p5sagit/p5-mst-13.2.git] / toke.c
diff --git a/toke.c b/toke.c
index ef2ace0..10b2a6a 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -318,16 +318,14 @@ restore_rsfp(void *f)
 }
 
 static void
-restore_expect(e)
-void *e;
+restore_expect(void *e)
 {
     /* a safe way to store a small integer in a pointer */
     expect = (expectation)((char *)e - tokenbuf);
 }
 
 static void
-restore_lex_expect(e)
-void *e;
+restore_lex_expect(void *e)
 {
     /* a safe way to store a small integer in a pointer */
     lex_expect = (expectation)((char *)e - tokenbuf);
@@ -555,7 +553,7 @@ force_ident(register char *s, int kind)
            /* XXX see note in pp_entereval() for why we forgo typo
               warnings if the symbol must be introduced in an eval.
               GSAR 96-10-12 */
-           gv_fetchpv(s, in_eval ? GV_ADDMULTI : TRUE,
+           gv_fetchpv(s, in_eval ? (GV_ADDMULTI | 8) : TRUE,
                kind == '$' ? SVt_PV :
                kind == '@' ? SVt_PVAV :
                kind == '%' ? SVt_PVHV :
@@ -768,6 +766,12 @@ sublex_done(void)
   processing a pattern (lex_inpat is true), a transliteration
   (lex_inwhat & OP_TRANS is true), or a double-quoted string.
 
+  Returns a pointer to the character scanned up to. Iff this is
+  advanced from the start pointer supplied (ie if anything was
+  successfully parsed), will leave an OP for the substring scanned
+  in yylval. Caller must intuit reason for not parsing further
+  by looking at the next characters herself.
+
   In patterns:
     backslashes:
       double-quoted style: \r and \n
@@ -835,17 +839,11 @@ scan_const(char *start)
     bool dorange = FALSE;                      /* are we in a translit range? */
     I32 len;                                   /* ? */
 
-    /*
-      leave is the set of acceptably-backslashed characters.
-
-      I do *not* understand why there's the double hook here.
-    */
+    /* leaveit is the set of acceptably-backslashed characters */
     char *leaveit =
        lex_inpat
            ? "\\.^$@AGZdDwWsSbB+*?|()-nrtfeaxc0123456789[{]} \t\n\r\f\v#"
-           : (lex_inwhat & OP_TRANS)
-               ? ""
-               : "";
+           : "";
 
     while (s < send || dorange) {
         /* get transliterations out of the way (they're most literal) */
@@ -1032,7 +1030,7 @@ scan_const(char *start)
        Renew(SvPVX(sv), SvLEN(sv), char);
     }
 
-    /* ??? */
+    /* return the substring (via yylval) only if we parsed anything */
     if (s > bufptr)
        yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
     else
@@ -1202,7 +1200,12 @@ intuit_method(char *start, GV *gv)
        return *s == '(' ? FUNCMETH : METHOD;
     }
     if (!keyword(tmpbuf, len)) {
-       indirgv = gv_fetchpv(tmpbuf,FALSE, SVt_PVCV);
+       if (len > 2 && tmpbuf[len - 2] == ':' && tmpbuf[len - 1] == ':') {
+           len -= 2;
+           tmpbuf[len] = '\0';
+           goto bare_package;
+       }
+       indirgv = gv_fetchpv(tmpbuf, FALSE, SVt_PVCV);
        if (indirgv && GvCVu(indirgv))
            return 0;
        /* filehandle or package name makes it a method */
@@ -1210,11 +1213,10 @@ intuit_method(char *start, GV *gv)
            s = skipspace(s);
            if ((bufend - s) >= 2 && *s == '=' && *(s+1) == '>')
                return 0;       /* no assumptions -- "=>" quotes bearword */
-           nextval[nexttoke].opval =
-               (OP*)newSVOP(OP_CONST, 0,
-                           newSVpv(tmpbuf,0));
-           nextval[nexttoke].opval->op_private =
-               OPpCONST_BARE;
+      bare_package:
+           nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0,
+                                                  newSVpv(tmpbuf,0));
+           nextval[nexttoke].opval->op_private = OPpCONST_BARE;
            expect = XTERM;
            force_next(WORD);
            bufptr = s;
@@ -1505,7 +1507,7 @@ yylex(void)
        /* build ops for a bareword */
        yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf+1, 0));
        yylval.opval->op_private = OPpCONST_ENTERED;
-       gv_fetchpv(tokenbuf+1, in_eval ? GV_ADDMULTI : TRUE,
+       gv_fetchpv(tokenbuf+1, in_eval ? (GV_ADDMULTI | 8) : TRUE,
                   ((tokenbuf[0] == '$') ? SVt_PV
                    : (tokenbuf[0] == '@') ? SVt_PVAV
                    : SVt_PVHV));
@@ -2840,10 +2842,13 @@ yylex(void)
                /* Get the rest if it looks like a package qualifier */
 
                if (*s == '\'' || *s == ':' && s[1] == ':') {
+                   STRLEN morelen;
                    s = scan_word(s, tokenbuf + len, sizeof tokenbuf - len,
-                                 TRUE, &len);
-                   if (!len)
-                       croak("Bad name after %s::", tokenbuf);
+                                 TRUE, &morelen);
+                   if (!morelen)
+                       croak("Bad name after %s%s", tokenbuf,
+                               *s == '\'' ? "'" : "::");
+                   len += morelen;
                }
 
                if (expect == XOPERATOR) {
@@ -2856,7 +2861,28 @@ yylex(void)
                        no_op("Bareword",s);
                }
 
-               /* Look for a subroutine with this name in current package. */
+               /* Look for a subroutine with this name in current package,
+                  unless name is "Foo::", in which case Foo is a bearword
+                  (and a package name). */
+
+               if (len > 2 &&
+                   tokenbuf[len - 2] == ':' && tokenbuf[len - 1] == ':')
+               {
+                   if (dowarn && ! gv_fetchpv(tokenbuf, FALSE, SVt_PVHV))
+                       warn("Bareword \"%s\" refers to nonexistent package",
+                            tokenbuf);
+                   len -= 2;
+                   tokenbuf[len] = '\0';
+                   gv = Nullgv;
+                   gvp = 0;
+               }
+               else {
+                   len = 0;
+                   if (!gv)
+                       gv = gv_fetchpv(tokenbuf, FALSE, SVt_PVCV);
+               }
+
+               /* if we saw a global override before, get the right name */
 
                if (gvp) {
                    sv = newSVpv("CORE::GLOBAL::",14);
@@ -2864,8 +2890,6 @@ yylex(void)
                }
                else
                    sv = newSVpv(tokenbuf,0);
-               if (!gv)
-                   gv = gv_fetchpv(tokenbuf,FALSE, SVt_PVCV);
 
                /* Presume this is going to be a bareword of some sort. */
 
@@ -2873,6 +2897,11 @@ yylex(void)
                yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
                yylval.opval->op_private = OPpCONST_BARE;
 
+               /* And if "Foo::", then that's what it certainly is. */
+
+               if (len)
+                   goto safe_bareword;
+
                /* See if it's the indirect object for a list operator. */
 
                if (oldoldbufptr &&
@@ -3001,6 +3030,8 @@ yylex(void)
                            warn(warn_reserved, tokenbuf);
                    }
                }
+
+           safe_bareword:
                if (lastchar && strchr("*%&", lastchar)) {
                    warn("Operator or semicolon missing before %c%s",
                        lastchar, tokenbuf);
@@ -4682,7 +4713,7 @@ scan_word(register char *s, char *dest, STRLEN destlen, int allow_package, STRLE
            *d++ = ':';
            s++;
        }
-       else if (*s == ':' && s[1] == ':' && allow_package && isIDFIRST(s[2])) {
+       else if (*s == ':' && s[1] == ':' && allow_package && s[2] != '$') {
            *d++ = *s++;
            *d++ = *s++;
        }
@@ -4825,6 +4856,8 @@ void pmflag(U16 *pmfl, int ch)
        *pmfl |= PMf_MULTILINE;
     else if (ch == 's')
        *pmfl |= PMf_SINGLELINE;
+    else if (ch == 't')
+       *pmfl |= PMf_TAINTMEM;
     else if (ch == 'x')
        *pmfl |= PMf_EXTENDED;
 }
@@ -4846,7 +4879,7 @@ scan_pat(char *start)
     pm = (PMOP*)newPMOP(OP_MATCH, 0);
     if (multi_open == '?')
        pm->op_pmflags |= PMf_ONCE;
-    while (*s && strchr("iogcmsx", *s))
+    while (*s && strchr("iogcmstx", *s))
        pmflag(&pm->op_pmflags,*s++);
     pm->op_pmpermflags = pm->op_pmflags;
 
@@ -4891,13 +4924,15 @@ scan_subst(char *start)
     multi_start = first_start; /* so whole substitution is taken together */
 
     pm = (PMOP*)newPMOP(OP_SUBST, 0);
-    while (*s && strchr("iogcmsex", *s)) {
+    while (*s) {
        if (*s == 'e') {
            s++;
            es++;
        }
-       else
+       else if (strchr("iogcmstx", *s))
            pmflag(&pm->op_pmflags,*s++);
+       else
+           break;
     }
 
     if (es) {
@@ -4937,7 +4972,7 @@ scan_trans(char *start)
        if (lex_stuff)
            SvREFCNT_dec(lex_stuff);
        lex_stuff = Nullsv;
-       croak("Translation pattern not terminated");
+       croak("Transliteration pattern not terminated");
     }
     if (s[-1] == multi_open)
        s--;
@@ -4950,7 +4985,7 @@ scan_trans(char *start)
        if (lex_repl)
            SvREFCNT_dec(lex_repl);
        lex_repl = Nullsv;
-       croak("Translation replacement not terminated");
+       croak("Transliteration replacement not terminated");
     }
 
     New(803,tbl,256,short);