makedepend VOS fix from Paul Green.

[perl5.git] / toke.c

diff --git a/toke.c b/toke.c
index 46f87dd..faa1eac 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -634,6 +634,8 @@ S_skipspace(pTHX_ register char *s)
 
            sv_upgrade(sv, SVt_PVMG);
            sv_setpvn(sv,PL_bufptr,PL_bufend-PL_bufptr);
+            (void)SvIOK_on(sv);
+            SvIVX(sv) = 0;
            av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv);
        }
     }
@@ -1978,7 +1980,7 @@ Perl_filter_add(pTHX_ filter_t funcp, SV *datasv)
     IoANY(datasv) = (void *)funcp; /* stash funcp into spare field */
     IoFLAGS(datasv) |= IOf_FAKE_DIRP;
     DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_add func %p (%s)\n",
-                         funcp, SvPV_nolen(datasv)));
+                         (void*)funcp, SvPV_nolen(datasv)));
     av_unshift(PL_rsfp_filters, 1);
     av_store(PL_rsfp_filters, 0, datasv) ;
     return(datasv);
@@ -1990,7 +1992,7 @@ void
 Perl_filter_del(pTHX_ filter_t funcp)
 {
     SV *datasv;
-    DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_del func %p", funcp));
+    DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_del func %p", (void*)funcp));
     if (!PL_rsfp_filters || AvFILLp(PL_rsfp_filters)<0)
        return;
     /* if filter is on top of stack (usual case) just pop it off */
@@ -2060,7 +2062,7 @@ Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen)
     funcp = (filter_t)IoANY(datasv);
     DEBUG_P(PerlIO_printf(Perl_debug_log,
                          "filter_read %d: via function %p (%s)\n",
-                         idx, funcp, SvPV_nolen(datasv)));
+                         idx, (void*)funcp, SvPV_nolen(datasv)));
     /* Call function. The function is expected to      */
     /* call "FILTER_READ(idx+1, buf_sv)" first.                */
     /* Return: <0:error, =0:eof, >0:not eof            */
@@ -2440,7 +2442,7 @@ Perl_yylex(pTHX)
                    if (PL_minus_F) {
                        if (strchr("/'\"", *PL_splitstr)
                              && strchr(PL_splitstr + 1, *PL_splitstr))
-                           Perl_sv_catpvf(aTHX_ PL_linestr, "@F=split(%s);", PL_splitstr);
+                           Perl_sv_catpvf(aTHX_ PL_linestr, "our @F=split(%s);", PL_splitstr);
                        else {
                            char delim;
                            s = "'~#\200\1'"; /* surely one char is unused...*/
@@ -2469,6 +2471,8 @@ Perl_yylex(pTHX)
 
                sv_upgrade(sv, SVt_PVMG);
                sv_setsv(sv,PL_linestr);
+                (void)SvIOK_on(sv);
+                SvIVX(sv) = 0;
                av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv);
            }
            goto retry;
@@ -2552,6 +2556,8 @@ Perl_yylex(pTHX)
 
            sv_upgrade(sv, SVt_PVMG);
            sv_setsv(sv,PL_linestr);
+            (void)SvIOK_on(sv);
+            SvIVX(sv) = 0;
            av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv);
        }
        PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
@@ -2592,7 +2598,7 @@ Perl_yylex(pTHX)
                     * at least, set argv[0] to the basename of the Perl
                     * interpreter. So, having found "#!", we'll set it right.
                     */
-                   SV *x = GvSV(gv_fetchpv("\030", TRUE, SVt_PV));
+                   SV *x = GvSV(gv_fetchpv("\030", TRUE, SVt_PV)); /* $^X */
                    assert(SvPOK(x) || SvGMAGICAL(x));
                    if (sv_eq(x, CopFILESV(PL_curcop))) {
                        sv_setpvn(x, ipath, ipathend - ipath);
@@ -2682,6 +2688,7 @@ Perl_yylex(pTHX)
                    while (SPACE_OR_TAB(*d)) d++;
 
                    if (*d++ == '-') {
+                       bool switches_done = PL_doswitches;
                        do {
                            if (*d == 'M' || *d == 'm') {
                                char *m = d;
@@ -2705,6 +2712,14 @@ Perl_yylex(pTHX)
                                (void)gv_fetchfile(PL_origfilename);
                            goto retry;
                        }
+                       if (PL_doswitches && !switches_done) {
+                           int argc = PL_origargc;
+                           char **argv = PL_origargv;
+                           do {
+                               argc--,argv++;
+                           } while (argc && argv[0][0] == '-' && argv[0][1]);
+                           init_argv_symbols(argc,argv);
+                       }
                    }
                }
            }
@@ -4889,7 +4904,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);
@@ -4937,14 +4952,20 @@ 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 (!strchr("$@%*;[]&\\ ", *p))
+                           bad_proto = TRUE;
                        if (!isSPACE(*p))
                            d[tmp++] = *p;
                    }
                    d[tmp] = '\0';
+                   if (bad_proto)
+                       Perl_croak(aTHX_ "Malformed prototype for %s : %s",
+                                  SvPVX(PL_subname), d);
                    SvCUR(PL_lex_stuff) = tmp;
                    have_proto = TRUE;
 
@@ -6533,6 +6554,8 @@ S_scan_heredoc(pTHX_ register char *s)
 
            sv_upgrade(sv, SVt_PVMG);
            sv_setsv(sv,PL_linestr);
+            (void)SvIOK_on(sv);
+            SvIVX(sv) = 0;
            av_store(CopFILEAV(PL_curcop), (I32)CopLINE(PL_curcop),sv);
        }
        if (*s == term && memEQ(s,PL_tokenbuf,len)) {
@@ -6883,6 +6906,8 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
 
            sv_upgrade(sv, SVt_PVMG);
            sv_setsv(sv,PL_linestr);
+            (void)SvIOK_on(sv);
+            SvIVX(sv) = 0;
            av_store(CopFILEAV(PL_curcop), (I32)CopLINE(PL_curcop), sv);
        }
 
@@ -7203,7 +7228,7 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp)
            }
            if (*s == '.' && isDIGIT(s[1])) {
                /* oops, it's really a v-string, but without the "v" */
-               s = start - 1;
+               s = start;
                goto vstring;
            }
        }
@@ -7297,58 +7322,8 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp)
     /* if it starts with a v, it could be a v-string */
     case 'v':
 vstring:
-       {
-           char *pos = s;
-           pos++;
-           while (isDIGIT(*pos) || *pos == '_')
-               pos++;
-           if (!isALPHA(*pos)) {
-               UV rev;
-               U8 tmpbuf[UTF8_MAXLEN+1];
-               U8 *tmpend;
-               s++;                            /* get past 'v' */
-
-               sv = NEWSV(92,5);
-               sv_setpvn(sv, "", 0);
-
-               for (;;) {
-                   if (*s == '0' && isDIGIT(s[1]))
-                       yyerror("Octal number in vector unsupported");
-                   rev = 0;
-                   {
-                       /* this is atoi() that tolerates underscores */
-                       char *end = pos;
-                       UV mult = 1;
-                       while (--end >= s) {
-                           UV orev;
-                           if (*end == '_')
-                               continue;
-                           orev = rev;
-                           rev += (*end - '0') * mult;
-                           mult *= 10;
-                           if (orev > rev && ckWARN_d(WARN_OVERFLOW))
-                               Perl_warner(aTHX_ WARN_OVERFLOW,
-                                           "Integer overflow in decimal number");
-                       }
-                   }
-                   /* Append native character for the rev point */
-                   tmpend = uvchr_to_utf8(tmpbuf, rev);
-                   sv_catpvn(sv, (const char*)tmpbuf, tmpend - tmpbuf);
-                   if (!UNI_IS_INVARIANT(NATIVE_TO_UNI(rev)))
-                       SvUTF8_on(sv);
-                   if (*pos == '.' && isDIGIT(pos[1]))
-                       s = ++pos;
-                   else {
-                       s = pos;
-                       break;
-                   }
-                   while (isDIGIT(*pos) || *pos == '_')
-                       pos++;
-               }
-               SvPOK_on(sv);
-               SvREADONLY_on(sv);
-           }
-       }
+               sv = NEWSV(92,5); /* preallocate storage space */
+               s = new_vstring(s,sv);
        break;
     }