[asperl] fixups to make it build and pass tests under both compilers

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

diff --git a/toke.c b/toke.c
index 3e681f6..e9e3f00 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -181,7 +181,7 @@ missingterm(char *s)
     char q;
     if (s) {
        char *nl = strrchr(s,'\n');
-       if (nl) 
+       if (nl)
            *nl = '\0';
     }
     else if (multi_close < 32 || multi_close == 127) {
@@ -403,8 +403,6 @@ skipspace(register char *s)
                PerlIO_clearerr(rsfp);
            else
                (void)PerlIO_close(rsfp);
-           if (e_fp == rsfp)
-               e_fp = Nullfp;
            rsfp = Nullfp;
            return s;
        }
@@ -758,6 +756,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
@@ -825,17 +829,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) */
@@ -1022,7 +1020,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
@@ -1068,7 +1066,7 @@ intuit_more(register char *s)
     else {
        int weight = 2;         /* let's weigh the evidence */
        char seen[256];
-       unsigned char un_char = 0, last_un_char;
+       unsigned char un_char = 255, last_un_char;
        char *send = strchr(s,']');
        char tmpbuf[sizeof tokenbuf * 4];
 
@@ -1134,6 +1132,8 @@ intuit_more(register char *s)
                    weight += 30;
                if (strchr("zZ79~",s[1]))
                    weight += 30;
+               if (last_un_char == 255 && (isDIGIT(s[1]) || s[1] == '$'))
+                   weight -= 5;        /* cope with negative subscript */
                break;
            default:
                if (!isALNUM(last_un_char) && !strchr("$@&",last_un_char) &&
@@ -1347,7 +1347,7 @@ filter_read(int idx, SV *buf_sv, int maxlen)
     /* Call function. The function is expected to      */
     /* call "FILTER_READ(idx+1, buf_sv)" first.                */
     /* Return: <0:error, =0:eof, >0:not eof            */
-    return (*funcp)(idx, buf_sv, maxlen);
+    return (*funcp)(THIS_ idx, buf_sv, maxlen);
 }
 
 STATIC char *
@@ -1783,8 +1783,6 @@ yylex(void)
                        PerlIO_clearerr(rsfp);
                    else
                        (void)PerlIO_close(rsfp);
-                   if (e_fp == rsfp)
-                       e_fp = Nullfp;
                    rsfp = Nullfp;
                }
                if (!in_eval && (minus_n || minus_p)) {
@@ -2223,13 +2221,8 @@ yylex(void)
                else
                    lex_brackstack[lex_brackets++] = XOPERATOR;
                s = skipspace(s);
-               if (*s == '}') {
-                   if (expect == XSTATE) {
-                       lex_brackstack[lex_brackets-1] = XSTATE;
-                       break;
-                   }
+               if (*s == '}')
                    OPERATOR(HASHBRACK);
-               }
                /* This hack serves to disambiguate a pair of curlies
                 * as being a block or an anon hash.  Normally, expectation
                 * determines that, but in cases where we're not in a
@@ -4848,6 +4841,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;
 }
@@ -4869,7 +4864,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;
 
@@ -4914,13 +4909,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) {
@@ -5076,7 +5073,7 @@ scan_heredoc(register char *s)
        }
        sv_setpvn(tmpstr,d+1,s-d);
        s += len - 1;
-       curcop->cop_line++;     /* the preceding stmt passes a newline */
+       curcop->cop_line++;     /* the preceding stmt passes a newline */
 
        sv_catpvn(herewas,s,bufend-s);
        sv_setsv(linestr,herewas);