pod fixes (from Abigail and M J T Guy)

[perl5.git] / toke.c

diff --git a/toke.c b/toke.c
index cc370bc..3410ab5 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1,6 +1,6 @@
 /*    toke.c
  *
- *    Copyright (c) 1991-1999, Larry Wall
+ *    Copyright (c) 1991-2000, 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.
@@ -376,6 +376,15 @@ Perl_lex_start(pTHX_ SV *line)
     SAVEI32(PL_lex_state);
     SAVEVPTR(PL_lex_inpat);
     SAVEI32(PL_lex_inwhat);
+    if (PL_lex_state == LEX_KNOWNEXT) {
+       I32 toke = PL_nexttoke;
+       while (--toke >= 0) {
+           SAVEI32(PL_nexttype[toke]);
+           SAVEVPTR(PL_nextval[toke]);
+       }
+       SAVEI32(PL_nexttoke);
+       PL_nexttoke = 0;
+    }
     SAVECOPLINE(PL_curcop);
     SAVEPPTR(PL_bufptr);
     SAVEPPTR(PL_bufend);
@@ -1275,11 +1284,14 @@ S_scan_const(pTHX_ char *start)
            if (ckWARN(WARN_UTF8)) {
                (void)utf8_to_uv((U8*)s, &len); /* could cvt latin-1 to utf8 here... */
                if (len) {
+                   has_utf = TRUE;
                    while (len--)
                        *d++ = *s++;
                    continue;
                }
            }
+           else
+               has_utf = TRUE;         /* assume valid utf8 */
        }
 
        /* backslashes */
@@ -1349,12 +1361,6 @@ S_scan_const(pTHX_ char *start)
                        yyerror("Missing right brace on \\x{}");
                        e = s;
                    }
-                   if (!utf) {
-                       dTHR;
-                       if (ckWARN(WARN_UTF8))
-                           Perl_warner(aTHX_ WARN_UTF8,
-                                  "Use of \\x{} without utf8 declaration");
-                   }
                    /* note: utf always shorter than hex */
                    d = (char*)uv_to_utf8((U8*)d,
                                          (UV)scan_hex(s + 1, e - s - 1, &len));
@@ -1672,7 +1678,7 @@ S_intuit_more(pTHX_ register char *s)
  * Not a method if it's really "print foo $bar"
  * Method if it's really "foo package::" (interpreted as package->foo)
  * Not a method if bar is known to be a subroutne ("sub bar; foo bar")
- * Not a method if bar is a filehandle or package, but is quotd with
+ * Not a method if bar is a filehandle or package, but is quoted with
  *   =>
  */
 
@@ -6398,6 +6404,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
     register char term;                        /* terminating character */
     register char *to;                 /* current position in the sv's data */
     I32 brackets = 1;                  /* bracket nesting level */
+    bool has_utf = FALSE;              /* is there any utf8 content? */
 
     /* skip space before the delimiter */
     if (isSPACE(*s))
@@ -6408,6 +6415,9 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
 
     /* after skipping whitespace, the next character is the terminator */
     term = *s;
+    if ((term & 0x80) && UTF)
+       has_utf = TRUE;
+
     /* mark where we are */
     PL_multi_start = CopLINE(PL_curcop);
     PL_multi_open = term;
@@ -6452,6 +6462,8 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
                   have found the terminator */
                else if (*s == term)
                    break;
+               else if (!has_utf && (*s & 0x80) && UTF)
+                   has_utf = TRUE;
                *to = *s;
            }
        }
@@ -6479,6 +6491,8 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
                    break;
                else if (*s == PL_multi_open)
                    brackets++;
+               else if (!has_utf && (*s & 0x80) && UTF)
+                   has_utf = TRUE;
                *to = *s;
            }
        }
@@ -6490,7 +6504,8 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
         * this next chunk reads more into the buffer if we're not done yet
         */
 
-       if (s < PL_bufend) break;       /* handle case where we are done yet :-) */
+       if (s < PL_bufend)
+           break;              /* handle case where we are done yet :-) */
 
 #ifndef PERL_STRICT_CR
        if (to - SvPVX(sv) >= 2) {
@@ -6537,6 +6552,8 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
 
     if (keep_delims)
        sv_catpvn(sv, s, 1);
+    if (has_utf)
+       SvUTF8_on(sv);
     PL_multi_end = CopLINE(PL_curcop);
     s++;
 
@@ -6873,6 +6890,7 @@ Perl_scan_num(pTHX_ char *start)
                U8 tmpbuf[10];
                U8 *tmpend;
                NV nshift = 1.0;
+               bool utf8 = FALSE;
                s++;                            /* get past 'v' */
 
                sv = NEWSV(92,5);
@@ -6880,12 +6898,21 @@ Perl_scan_num(pTHX_ char *start)
                sv_setpvn(sv, "", 0);
 
                do {
+                   if (*s == '0' && isDIGIT(s[1]))
+                       yyerror("Octal number in vector unsupported");
                    rev = atoi(s);
                    s = ++pos;
                    while (isDIGIT(*pos))
                        pos++;
 
-                   tmpend = uv_to_utf8(tmpbuf, rev);
+                   if (rev > 127) {
+                       tmpend = uv_to_utf8(tmpbuf, rev);
+                       utf8 = TRUE;
+                   }
+                   else {
+                       tmpbuf[0] = (U8)rev;
+                       tmpend = &tmpbuf[1];
+                   }
                    *tmpend = '\0';
                    sv_catpvn(sv, (const char*)tmpbuf, tmpend - tmpbuf);
                    if (rev > 0)
@@ -6893,9 +6920,12 @@ Perl_scan_num(pTHX_ char *start)
                    nshift *= 1000;
                } while (*pos == '.' && isDIGIT(pos[1]));
 
+               if (*s == '0' && isDIGIT(s[1]))
+                   yyerror("Octal number in vector unsupported");
                rev = atoi(s);
                s = pos;
                tmpend = uv_to_utf8(tmpbuf, rev);
+               utf8 = utf8 || rev > 127;
                *tmpend = '\0';
                sv_catpvn(sv, (const char*)tmpbuf, tmpend - tmpbuf);
                if (rev > 0)
@@ -6904,7 +6934,8 @@ Perl_scan_num(pTHX_ char *start)
                SvPOK_on(sv);
                SvNOK_on(sv);
                SvREADONLY_on(sv);
-               SvUTF8_on(sv);
+               if (utf8)
+                   SvUTF8_on(sv);
            }
        }
        break;
@@ -7025,8 +7056,7 @@ Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
     SAVEI32(PL_subline);
     save_item(PL_subname);
     SAVEI32(PL_padix);
-    SAVEVPTR(PL_curpad);
-    SAVESPTR(PL_comppad);
+    SAVECOMPPAD();
     SAVESPTR(PL_comppad_name);
     SAVESPTR(PL_compcv);
     SAVEI32(PL_comppad_name_fill);