Re: [perl #33892] Add Interix support

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

diff --git a/toke.c b/toke.c
index bdf8ed4..5d5abf4 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -275,9 +275,7 @@ S_tokereport(pTHX_ char* s, I32 rv)
        char *name = Nullch;
        enum token_type type = TOKENTYPE_NONE;
        struct debug_tokens *p;
-        SV* report = NEWSV(0, 60);
-
-        Perl_sv_catpvf(aTHX_ report, "<== ");
+        SV* report = newSVpvn("<== ", 4);
 
        for (p = debug_tokens; p->token; p++) {
            if (p->token == (int)rv) {
@@ -287,11 +285,11 @@ S_tokereport(pTHX_ char* s, I32 rv)
            }
        }
        if (name)
-           Perl_sv_catpvf(aTHX_ report, "%s", name);
+           Perl_sv_catpv(aTHX_ report, name);
        else if ((char)rv > ' ' && (char)rv < '~')
            Perl_sv_catpvf(aTHX_ report, "'%c'", (char)rv);
        else if (!rv)
-           Perl_sv_catpvf(aTHX_ report, "EOF");
+           Perl_sv_catpv(aTHX_ report, "EOF");
        else
            Perl_sv_catpvf(aTHX_ report, "?? %"IVdf, (IV)rv);
        switch (type) {
@@ -872,6 +870,15 @@ S_force_next(pTHX_ I32 type)
     }
 }
 
+STATIC SV *
+S_newSV_maybe_utf8(pTHX_ const char *start, STRLEN len)
+{
+    SV *sv = newSVpvn(start,len);
+    if (UTF && !IN_BYTES && is_utf8_string((U8*)start, len))
+       SvUTF8_on(sv);
+    return sv;
+}
+
 /*
  * S_force_word
  * When the lexer knows the next thing is a word (for instance, it has
@@ -911,10 +918,10 @@ S_force_word(pTHX_ register char *start, int token, int check_keyword, int allow
                PL_expect = XOPERATOR;
            }
        }
-       PL_nextval[PL_nexttoke].opval = (OP*)newSVOP(OP_CONST,0, newSVpv(PL_tokenbuf,0));
+       PL_nextval[PL_nexttoke].opval
+           = (OP*)newSVOP(OP_CONST,0,
+                          S_newSV_maybe_utf8(aTHX_ PL_tokenbuf, len));
        PL_nextval[PL_nexttoke].opval->op_private |= OPpCONST_BARE;
-       if (UTF && !IN_BYTES && is_utf8_string((U8*)PL_tokenbuf, len))
-           SvUTF8_on(((SVOP*)PL_nextval[PL_nexttoke].opval)->op_sv);
        force_next(token);
     }
     return s;
@@ -1697,7 +1704,7 @@ S_scan_const(pTHX_ char *start)
                         UV uv = utf8_to_uvchr((U8*)str, 0);
 
                         if (uv < 0x100) {
-                             U8 tmpbuf[UTF8_MAXLEN+1], *d;
+                             U8 tmpbuf[UTF8_MAXBYTES+1], *d;
 
                              d = uvchr_to_utf8(tmpbuf, UNI_TO_NATIVE(uv));
                              sv_setpvn(res, (char *)tmpbuf, d - tmpbuf);
@@ -2597,7 +2604,7 @@ Perl_yylex(pTHX)
                            /* The count here deliberately includes the NUL
                               that terminates the C string constant.  This
                               embeds the opening NUL into the string.  */
-                           sv_catpvn(aTHX_ PL_linestr, "our @F=split(q", 15);
+                           sv_catpvn(PL_linestr, "our @F=split(q", 15);
                            s = PL_splitstr;
                            do {
                                /* Need to \ \s  */
@@ -4010,10 +4017,10 @@ Perl_yylex(pTHX)
        /* Is this a word before a => operator? */
        if (*d == '=' && d[1] == '>') {
            CLINE;
-           yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(PL_tokenbuf,0));
+           yylval.opval
+               = (OP*)newSVOP(OP_CONST, 0,
+                              S_newSV_maybe_utf8(aTHX_ PL_tokenbuf, len));
            yylval.opval->op_private = OPpCONST_BARE;
-           if (UTF && !IN_BYTES && is_utf8_string((U8*)PL_tokenbuf, len))
-             SvUTF8_on(((SVOP*)yylval.opval)->op_sv);
            TERM(WORD);
        }
 
@@ -4135,8 +4142,12 @@ Perl_yylex(pTHX)
                    sv = newSVpvn("CORE::GLOBAL::",14);
                    sv_catpv(sv,PL_tokenbuf);
                }
-               else
-                   sv = newSVpv(PL_tokenbuf,0);
+               else {
+                   /* If len is 0, newSVpv does strlen(), which is correct.
+                      If len is non-zero, then it will be the true length,
+                      and so the scalar will be created correctly.  */
+                   sv = newSVpv(PL_tokenbuf,len);
+               }
 
                /* Presume this is going to be a bareword of some sort. */
 
@@ -5513,7 +5524,7 @@ S_pending_ident(pTHX)
                 sv_catpv(sym, PL_tokenbuf+1);
                 yylval.opval = (OP*)newSVOP(OP_CONST, 0, sym);
                 yylval.opval->op_private = OPpCONST_ENTERED;
-                gv_fetchpv(SvPVX(sym),
+                gv_fetchsv(sym,
                     (PL_in_eval
                         ? (GV_ADDMULTI | GV_ADDINEVAL)
                         : GV_ADDMULTI
@@ -6330,6 +6341,9 @@ S_new_constant(pTHX_ char *s, STRLEN len, const char *key, SV *sv, SV *pv,
     return res;
 }
 
+/* Returns a NUL terminated string, with the length of the string written to
+   *slp
+   */
 STATIC char *
 S_scan_word(pTHX_ register char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp)
 {
@@ -7123,7 +7137,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
     I32 brackets = 1;                  /* bracket nesting level */
     bool has_utf8 = FALSE;             /* is there any utf8 content? */
     I32 termcode;                      /* terminating char. code */
-    U8 termstr[UTF8_MAXLEN];           /* terminating string */
+    U8 termstr[UTF8_MAXBYTES];         /* terminating string */
     STRLEN termlen;                    /* length of terminating string */
     char *last = NULL;                 /* last position for nesting bracket */
 
@@ -8216,7 +8230,7 @@ Perl_scan_vstring(pTHX_ char *s, SV *sv)
 
     if (!isALPHA(*pos)) {
        UV rev;
-       U8 tmpbuf[UTF8_MAXLEN+1];
+       U8 tmpbuf[UTF8_MAXBYTES+1];
        U8 *tmpend;
 
        if (*s == 'v') s++;  /* get past 'v' */