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

 BUILD PROCESS

Subject: Fix up Linux hints for tcsh, and Configure patch
Date: Tue, 22 Apr 1997 11:02:27 -0400 (EDT)
From: Andy Dougherty <doughera@lafcol.lafayette.edu>
Files: Configure hints/linux.sh
Msg-ID: Pine.SOL.3.95q.970422101051.2506C-100000@fractal.lafayette.e

    (applied based on p5p patch as commit 1eb1b1cb9647b817d039bb17afa3e74940b5ef92)

Subject: There is no standard answer to 'Use suidperl?'
From: Chip Salzenberg <chip@perl.com>
Files: hints/bsdos.sh hints/freebsd.sh hints/linux.sh hints/machten_2.sh

 CORE LANGUAGE CHANGES

Subject: Support PRINTF for tied handles
Date: Sun, 20 Apr 1997 18:26:13 -0400
From: Doug MacEachern <dougm@opengroup.org>
Files: pod/perldelta.pod pod/perltie.pod pp_sys.c t/op/misc.t
Msg-ID: 199704202226.SAA08032@postman.osf.org

    (applied based on p5p patch as commit e7c5525577c16ee25e3521e86aca2b5105dba394)

 CORE PORTABILITY

Subject: Fix bitwise shifts and pack('w') on Crays
From: Chip Salzenberg <chip@perl.com>
Files: pp.c

 DOCUMENTATION

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

    private-msgid: 199704231822.MAA05074@prometheus.frii.com

 OTHER CORE CHANGES

Subject: Mondo Cool patch for buffer safety and convenience
From: Chip Salzenberg <chip@perl.com>
Files: XSUB.h doop.c dump.c ext/DynaLoader/dl_dlopen.xs ext/DynaLoader/dl_hpux.xs ext/DynaLoader/dl_next.xs ext/DynaLoader/dlutils.c ext/ODBM_File/ODBM_File.xs global.sym gv.c interp.sym mg.c op.c perl.c perl.h pod/perlguts.pod pp.c pp_ctl.c pp_hot.c pp_sys.c proto.h regcomp.c regexec.c sv.c toke.c util.c

Subject: Problems with glob
Date: Sun, 20 Apr 1997 02:44:32 -0400 (EDT)
From: Ilya Zakharevich <ilya@math.ohio-state.edu>
Files: op.c
Msg-ID: 1997Apr20.024432.1941365@hmivax.humgen.upenn.edu

    (applied based on p5p patch as commit a1230b335277820e65b8a9454ab751341204cf4f)

Subject: Fix scalar leak in closures
From: Chip Salzenberg <chip@perl.com>
Files: op.c scope.c

Subject: Refine error messages re: anon subs' prototypes
From: Chip Salzenberg <chip@perl.com>
Files: op.c

Subject: Outermost scope is void, not scalar
From: Chip Salzenberg <chip@perl.com>
Files: pp_ctl.c

1 files changed, 16 insertions, 218 deletions

diff --git a/doop.c b/doop.c
index 400934dd3c..763b1a9f80 100644
--- a/doop.c
+++ b/doop.c
@@ -142,217 +142,18 @@ register SV **sp;
 
 void
 do_sprintf(sv,len,sarg)
-register SV *sv;
-register I32 len;
-register SV **sarg;
+SV *sv;
+I32 len;
+SV **sarg;
 {
-    register char *s;
-    register char *t;
-    register char *f;
-    char dotype;
-    char ch;
-    register char *send;
-    register SV *arg;
-    char *xs;
-    I32 xlen;
-    I32 pre;
-    I32 post;
-    double value;
-    STRLEN arglen;
-
-    sv_setpv(sv,"");
-    len--;			/* don't count pattern string */
-    t = s = SvPV(*sarg, arglen);	/* XXX Don't know t is writeable */
-    send = s + arglen;
-    sarg++;
-    for ( ; ; len--) {
-
-	/*SUPPRESS 560*/
-	if (len <= 0 || !(arg = *sarg++))
-	    arg = &sv_no;
-
-	/*SUPPRESS 530*/
-	for ( ; t < send && *t != '%'; t++) ;
-	if (t >= send)
-	    break;		/* end of run_format string, ignore extra args */
-	f = t;
-	*buf = '\0';
-	xs = buf;
-	dotype = '\0';
-	pre = post = 0;
-	for (t++; t < send; t++) {
-	    switch (*t) {
-	    default:
-		ch = *(++t);
-		*t = '\0';
-		(void)sprintf(xs,f);
-		len++, sarg--;
-		xlen = strlen(xs);
-		break;
-	    case 'n': case '*':
-		croak("Use of %c in printf format not supported", *t);
-
-	    case '0': case '1': case '2': case '3': case '4':
-	    case '5': case '6': case '7': case '8': case '9': 
-	    case '.': case '#': case '-': case '+': case ' ':
-		continue;
-	    case 'l':
-#ifdef HAS_QUAD
-		if (dotype == 'l')
-		    dotype = 'q';
-		else
-#endif
-		    dotype = 'l';
-		continue;
-	    case 'h':
-		dotype = 's';
-		continue;
-	    case 'c':
-		ch = *(++t);
-		*t = '\0';
-		xlen = SvIV(arg);
-		if (strEQ(f,"%c")) { /* some printfs fail on null chars */
-		    *xs = xlen;
-		    xs[1] = '\0';
-		    xlen = 1;
-		}
-		else {
-		    (void)sprintf(xs,f,xlen);
-		    xlen = strlen(xs);
-		}
-		break;
-	    case 'D':
-		dotype = 'l';
-		/* FALL THROUGH */
-	    case 'd':
-	    case 'i':
-		ch = *(++t);
-		*t = '\0';
-		switch (dotype) {
-#ifdef HAS_QUAD
-		case 'q':
-		    /* perl.h says that if quad is available, IV is quad */
-		    (void)sprintf(xs,f,(Quad_t)SvIV(arg));
-		    break;
-#endif
-		case 'l':
-		    (void)sprintf(xs,f,(long)SvIV(arg));
-		    break;
-		default:
-		    (void)sprintf(xs,f,(int)SvIV(arg));
-		    break;
-		case 's':
-		    (void)sprintf(xs,f,(short)SvIV(arg));
-		    break;
-		}
-		xlen = strlen(xs);
-		break;
-	    case 'X': case 'O':
-		dotype = 'l';
-		/* FALL THROUGH */
-	    case 'x': case 'o': case 'u':
-		ch = *(++t);
-		*t = '\0';
-		switch (dotype) {
-#ifdef HAS_QUAD
-		case 'q':
-		    /* perl.h says that if quad is available, UV is quad */
-		    (void)sprintf(xs,f,(unsigned Quad_t)SvUV(arg));
-		    break;
-#endif
-		case 'l':
-		    (void)sprintf(xs,f,(unsigned long)SvUV(arg));
-		    break;
-		default:
-		    (void)sprintf(xs,f,(unsigned int)SvUV(arg));
-		    break;
-		case 's':
-		    (void)sprintf(xs,f,(unsigned short)SvUV(arg));
-		    break;
-		}
-		xlen = strlen(xs);
-		break;
-	    case 'E': case 'e': case 'f': case 'G': case 'g':
-		ch = *(++t);
-		*t = '\0';
-		(void)sprintf(xs,f,SvNV(arg));
-		xlen = strlen(xs);
-#ifdef LC_NUMERIC
-		/*
-		 * User-defined locales may include arbitrary characters.
-		 * And, unfortunately, some system may alloc the "C" locale
-		 * to be overridden by a malicious user.
-		 */
-		if (op->op_type == OP_SPRINTF)
-		    SvTAINTED_on(sv);
-#endif /* LC_NUMERIC */
-		break;
-	    case 's':
-		ch = *(++t);
-		*t = '\0';
-		xs = SvPV(arg, arglen);
-		xlen = (I32)arglen;
-		if (strEQ(f,"%s")) {	/* some printfs fail on >128 chars */
-		    break;		/* so handle simple cases */
-		}
-		else if (f[1] == '-') {
-		    char *mp = strchr(f, '.');
-		    I32 min = atoi(f+2);
-
-		    if (mp) {
-			I32 max = atoi(mp+1);
-
-			if (xlen > max)
-			    xlen = max;
-		    }
-		    if (xlen < min)
-			post = min - xlen;
-		    break;
-		}
-		else if (isDIGIT(f[1])) {
-		    char *mp = strchr(f, '.');
-		    I32 min = atoi(f+1);
-
-		    if (mp) {
-			I32 max = atoi(mp+1);
-
-			if (xlen > max)
-			    xlen = max;
-		    }
-		    if (xlen < min)
-			pre = min - xlen;
-		    break;
-		}
-		strcpy(tokenbuf+64,f);	/* sprintf($s,...$s...) */
-		*t = ch;
-		(void)sprintf(buf,tokenbuf+64,xs);
-		xs = buf;
-		xlen = strlen(xs);
-		break;
-	    }
-	    /* end of switch, copy results */
-	    *t = ch;
-	    if (xs == buf && xlen >= sizeof(buf)) {	/* Ooops! */
-		PerlIO_puts(PerlIO_stderr(),"panic: sprintf overflow - memory corrupted!\n");
-		my_exit(1);
-	    }
-	    SvGROW(sv, SvCUR(sv) + (f - s) + xlen + 1 + pre + post);
-	    sv_catpvn(sv, s, f - s);
-	    if (pre) {
-		repeatcpy(SvPVX(sv) + SvCUR(sv), " ", 1, pre);
-		SvCUR(sv) += pre;
-	    }
-	    sv_catpvn(sv, xs, xlen);
-	    if (post) {
-		repeatcpy(SvPVX(sv) + SvCUR(sv), " ", 1, post);
-		SvCUR(sv) += post;
-	    }
-	    s = t;
-	    break;		/* break from for loop */
-	}
-    }
-    sv_catpvn(sv, s, t - s);
+    STRLEN patlen;
+    char *pat = SvPV(*sarg, patlen);
+    bool do_taint = FALSE;
+
+    sv_vsetpvfn(sv, pat, patlen, Null(va_list*), sarg + 1, len - 1, &do_taint);
     SvSETMAGIC(sv);
+    if (do_taint)
+	SvTAINTED_on(sv);
 }
 
 void
@@ -708,18 +509,15 @@ dARGS
 	if (dokeys)
 	    XPUSHs(hv_iterkeysv(entry));	/* won't clobber stack_sp */
 	if (dovalues) {
-	    tmpstr = NEWSV(45,0);
+	    tmpstr = sv_newmortal();
 	    PUTBACK;
 	    sv_setsv(tmpstr,hv_iterval(hv,entry));
+	    DEBUG_H(sv_setpvf(tmpstr, "%lu%%%d=%lu",
+			    (unsigned long)HeHASH(entry),
+			    HvMAX(hv)+1,
+			    (unsigned long)(HeHASH(entry) & HvMAX(hv))));
 	    SPAGAIN;
-	    DEBUG_H( {
-			sprintf(buf,"%lu%%%d=%lu\n",
-				(unsigned long)HeHASH(entry),
-				HvMAX(hv)+1,
-				(unsigned long)(HeHASH(entry) & HvMAX(hv)));
-			sv_setpv(tmpstr,buf);
-	    } )
-	    XPUSHs(sv_2mortal(tmpstr));
+	    XPUSHs(tmpstr);
 	}
 	PUTBACK;
     }