This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
makedepend VOS fix from Paul Green.
[perl5.git] / toke.c
diff --git a/toke.c b/toke.c
index d9e7248..faa1eac 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1980,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);
@@ -1992,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 */
@@ -2062,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            */
@@ -2442,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...*/
@@ -4904,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);
@@ -4952,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;
 
@@ -5330,12 +5336,12 @@ Perl_keyword(pTHX_ register char *d, I32 len)
            if (strEQ(d,"cos"))                 return -KEY_cos;
            break;
        case 4:
-           if (strEQ(d,"chop"))                return KEY_chop;
+           if (strEQ(d,"chop"))                return -KEY_chop;
            break;
        case 5:
            if (strEQ(d,"close"))               return -KEY_close;
            if (strEQ(d,"chdir"))               return -KEY_chdir;
-           if (strEQ(d,"chomp"))               return KEY_chomp;
+           if (strEQ(d,"chomp"))               return -KEY_chomp;
            if (strEQ(d,"chmod"))               return -KEY_chmod;
            if (strEQ(d,"chown"))               return -KEY_chown;
            if (strEQ(d,"crypt"))               return -KEY_crypt;