[inseparable changes from match from perl-5.003_97h to perl-5.003_97i]

 CORE PORTABILITY

Subject: Provide memset() if it's missing
From: Chip Salzenberg <chip@perl.com>
Files: global.sym perl.h proto.h util.c

Subject: Don't tell GCC that warn(), croak(), and die() are printf-lik
From: Chip Salzenberg <chip@perl.com>
Files: proto.h

 DOCUMENTATION

Subject: FAQ udpate (24-apr-97)
Date: Thu, 24 Apr 1997 16:47:23 -0600 (MDT)
From: Nathan Torkington <gnat@prometheus.frii.com>
Files: pod/perlfaq*.pod

    private-msgid: 199704242247.QAA07010@prometheus.frii.com

 OTHER CORE CHANGES

Subject: Misc. sv_vcatpvfn() fixes
From: Hugo van der Sanden <hv@crypt.compulink.co.uk>
Files: gv.c mg.c op.c perl.c pp.c pp_ctl.c sv.c toke.c util.c

Subject: Enforce order of sprintf() elements
From: Chip Salzenberg <chip@perl.com>
Files: sv.c

Subject: Guard against long numbers, <<LONG_DELIM, and <long glob>
From: Chip Salzenberg <chip@perl.com>
Files: global.sym mg.c perl.c pod/perldiag.pod proto.h toke.c util.c

Subject: Guard against C<goto> to deeply nested label
From: Chip Salzenberg <chip@perl.com>
Files: pod/perldiag.pod pp_ctl.c

Subject: Guard against overflow in dup2() emulation
From: Chip Salzenberg <chip@perl.com>
Files: util.c

Subject: Win32: Guard against long function names
From: Chip Salzenberg <chip@perl.com>
Files: win32/win32sck.c

Subject: Make mess() always work, by using a non-arena SV
From: Chip Salzenberg <chip@perl.com>
Files: perl.c util.c

Subject: When copying a format line, take only its string value
From: Chip Salzenberg <chip@perl.com>
Files: sv.c

Subject: Fix LEAKTEST numbers
From: Chip Salzenberg <chip@perl.com>
Files: ext/DynaLoader/dl_vms.xs handy.h os2/os2.c util.c vms/vms.c win32/win32.c win32/win32sck.c

1 files changed, 41 insertions, 24 deletions

diff --git a/toke.c b/toke.c
index 56e2fac1f1..9c4f487e1d 100644
--- a/toke.c
+++ b/toke.c
@@ -50,7 +50,7 @@ static int uni _((I32 f, char *s));
 static char * filter_gets _((SV *sv, PerlIO *fp, STRLEN append));
 static void restore_rsfp _((void *f));
 
-static char too_long[] = "Identifier too long";
+static char ident_too_long[] = "Identifier too long";
 
 static char *linestart;		/* beg. of most recently read line */
 
@@ -4332,7 +4332,7 @@ STRLEN *slp;
     register char *e = d + destlen - 3;  /* two-character token, ending NUL */
     for (;;) {
 	if (d >= e)
-	    croak(too_long);
+	    croak(ident_too_long);
 	if (isALNUM(*s))
 	    *d++ = *s++;
 	else if (*s == '\'' && allow_package && isIDFIRST(s[1])) {
@@ -4374,14 +4374,14 @@ I32 ck_uni;
     if (isDIGIT(*s)) {
 	while (isDIGIT(*s)) {
 	    if (d >= e)
-		croak(too_long);
+		croak(ident_too_long);
 	    *d++ = *s++;
 	}
     }
     else {
 	for (;;) {
 	    if (d >= e)
-		croak(too_long);
+		croak(ident_too_long);
 	    if (isALNUM(*s))
 		*d++ = *s++;
 	    else if (*s == '\'' && isIDFIRST(s[1])) {
@@ -4689,21 +4689,23 @@ register char *s;
     SV *tmpstr;
     char term;
     register char *d;
+    register char *e;
     char *peek;
     int outer = (rsfp && !lex_inwhat);
 
     s += 2;
     d = tokenbuf;
+    e = tokenbuf + sizeof tokenbuf - 1;
     if (!outer)
 	*d++ = '\n';
     for (peek = s; *peek == ' ' || *peek == '\t'; peek++) ;
     if (*peek && strchr("`'\"",*peek)) {
 	s = peek;
 	term = *s++;
-	s = cpytill(d,s,bufend,term,&len);
+	s = delimcpy(d, e, s, bufend, term, &len);
+	d += len;
 	if (s < bufend)
 	    s++;
-	d += len;
     }
     else {
 	if (*s == '\\')
@@ -4712,9 +4714,13 @@ register char *s;
 	    term = '"';
 	if (!isALNUM(*s))
 	    deprecate("bare << to mean <<\"\"");
-	while (isALNUM(*s))
-	    *d++ = *s++;
-    }				/* assuming tokenbuf won't clobber */
+	for (; isALNUM(*s); s++) {
+	    if (d < e)
+		*d++ = *s;
+	}
+    }
+    if (d >= tokenbuf + sizeof tokenbuf - 1)
+	croak("Delimiter for here document is too long");
     *d++ = '\n';
     *d = '\0';
     len = d - tokenbuf;
@@ -4805,15 +4811,17 @@ char *start;
 {
     register char *s = start;
     register char *d;
+    register char *e;
     I32 len;
 
     d = tokenbuf;
-    s = cpytill(d, s+1, bufend, '>', &len);
-    if (s < bufend)
-	s++;
-    else
+    e = tokenbuf + sizeof tokenbuf;
+    s = delimcpy(d, e, s + 1, bufend, '>', &len);
+    if (len >= sizeof tokenbuf)
+	croak("Excessively long <> operator");
+    if (s >= bufend)
 	croak("Unterminated <> operator");
-
+    s++;
     if (*d == '$' && d[1]) d++;
     while (*d && (isALNUM(*d) || *d == '\'' || *d == ':'))
 	d++;
@@ -4956,11 +4964,13 @@ char *start;
 {
     register char *s = start;
     register char *d;
+    register char *e;
     I32 tryiv;
     double value;
     SV *sv;
     I32 floatit;
     char *lastub = 0;
+    static char number_too_long[] = "Number too long";
 
     switch (*s) {
     default:
@@ -5022,6 +5032,7 @@ char *start;
     case '6': case '7': case '8': case '9': case '.':
       decimal:
 	d = tokenbuf;
+	e = tokenbuf + sizeof tokenbuf - 6; /* room for various punctuation */
 	floatit = FALSE;
 	while (isDIGIT(*s) || *s == '_') {
 	    if (*s == '_') {
@@ -5029,19 +5040,22 @@ char *start;
 		    warn("Misplaced _ in number");
 		lastub = ++s;
 	    }
-	    else
+	    else {
+		if (d >= e)
+		    croak(number_too_long);
 		*d++ = *s++;
+	    }
 	}
 	if (dowarn && lastub && s - lastub != 3)
 	    warn("Misplaced _ in number");
 	if (*s == '.' && s[1] != '.') {
 	    floatit = TRUE;
 	    *d++ = *s++;
-	    while (isDIGIT(*s) || *s == '_') {
-		if (*s == '_')
-		    s++;
-		else
-		    *d++ = *s++;
+	    for (; isDIGIT(*s) || *s == '_'; s++) {
+		if (d >= e)
+		    croak(number_too_long);
+		if (*s != '_')
+		    *d++ = *s;
 	    }
 	}
 	if (*s && strchr("eE",*s) && strchr("+-0123456789",s[1])) {
@@ -5050,8 +5064,11 @@ char *start;
 	    *d++ = 'e';		/* At least some Mach atof()s don't grok 'E' */
 	    if (*s == '+' || *s == '-')
 		*d++ = *s++;
-	    while (isDIGIT(*s))
+	    while (isDIGIT(*s)) {
+		if (d >= e)
+		    croak(number_too_long);
 		*d++ = *s++;
+	    }
 	}
 	*d = '\0';
 	sv = NEWSV(92,0);
@@ -5255,7 +5272,7 @@ char *s;
 	where = SvPVX(where_sv);
     }
     msg = sv_2mortal(newSVpv(s, 0));
-    sv_catpvf(msg, " at %S line %ld, ",
+    sv_catpvf(msg, " at %_ line %ld, ",
 	      GvSV(curcop->cop_filegv), (long)curcop->cop_line);
     if (context)
 	sv_catpvf(msg, "near \"%.*s\"\n", contlen, context);
@@ -5268,13 +5285,13 @@ char *s;
         multi_end = 0;
     }
     if (in_eval & 2)
-	warn("%S", msg);
+	warn("%_", msg);
     else if (in_eval)
 	sv_catsv(GvSV(errgv), msg);
     else
 	PerlIO_write(PerlIO_stderr(), SvPVX(msg), SvCUR(msg));
     if (++error_count >= 10)
-	croak("%S has too many errors.\n", GvSV(curcop->cop_filegv));
+	croak("%_ has too many errors.\n", GvSV(curcop->cop_filegv));
     in_my = 0;
     return 0;
 }