X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/8ebc5c0145d2e3559bce3073437e6d027dcdffcc..8ed4b6723befcaa6a7915091a3de5084c49b6b16:/doop.c

diff --git a/doop.c b/doop.c
index 2dccbb9..702aaf8 100644
--- a/doop.c
+++ b/doop.c
@@ -1,6 +1,6 @@
 /*    doop.c
  *
- *    Copyright (c) 1991-1994, Larry Wall
+ *    Copyright (c) 1991-1997, 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.
@@ -19,10 +19,9 @@
 #endif
 
 I32
-do_trans(sv,arg)
-SV *sv;
-OP *arg;
+do_trans(SV *sv, OP *arg)
 {
+    dTHR;
     register short *tbl;
     register U8 *s;
     register U8 *send;
@@ -30,9 +29,10 @@ OP *arg;
     register I32 ch;
     register I32 matches = 0;
     register I32 squash = op->op_private & OPpTRANS_SQUASH;
+    register U8 *p;
     STRLEN len;
 
-    if (SvREADONLY(sv))
+    if (SvREADONLY(sv) && !(op->op_private & OPpTRANS_COUNTONLY))
 	croak(no_modify);
     tbl = (short*)cPVOP->op_pv;
     s = (U8*)SvPV(sv, len);
@@ -53,17 +53,27 @@ OP *arg;
 	    }
 	    s++;
 	}
+	SvSETMAGIC(sv);
+    }
+    else if (op->op_private & OPpTRANS_COUNTONLY) {
+	while (s < send) {
+	    if (tbl[*s] >= 0)
+		matches++;
+	    s++;
+	}
     }
     else {
 	d = s;
+	p = send;
 	while (s < send) {
 	    if ((ch = tbl[*s]) >= 0) {
 		*d = ch;
-		if (matches++ && squash) {
-		    if (d[-1] == *d)
+		matches++;
+		if (squash) {
+		    if (p == d - 1 && *p == *d)
 			matches--;
 		    else
-			d++;
+		        p = d++;
 		}
 		else
 		    d++;
@@ -75,17 +85,13 @@ OP *arg;
 	matches += send - d;	/* account for disappeared chars */
 	*d = '\0';
 	SvCUR_set(sv, d - (U8*)SvPVX(sv));
+	SvSETMAGIC(sv);
     }
-    SvSETMAGIC(sv);
     return matches;
 }
 
 void
-do_join(sv,del,mark,sp)
-register SV *sv;
-SV *del;
-register SV **mark;
-register SV **sp;
+do_join(register SV *sv, SV *del, register SV **mark, register SV **sp)
 {
     SV **oldmark = mark;
     register I32 items = sp - mark;
@@ -100,7 +106,7 @@ register SV **sp;
 	sv_upgrade(sv, SVt_PV);
     if (SvLEN(sv) < len + items) {	/* current length is way too short */
 	while (items-- > 0) {
-	    if (*mark) {
+	    if (*mark && !SvGMAGICAL(*mark) && SvOK(*mark)) {
 		SvPV(*mark, tmplen);
 		len += tmplen;
 	    }
@@ -141,211 +147,20 @@ register SV **sp;
 }
 
 void
-do_sprintf(sv,len,sarg)
-register SV *sv;
-register I32 len;
-register SV **sarg;
+do_sprintf(SV *sv, I32 len, SV **sarg)
 {
-    register char *s;
-    register char *t;
-    register char *f;
-    bool dolong;
-#ifdef HAS_QUAD
-    bool doquad;
-#endif /* HAS_QUAD */
-    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;
-#ifdef HAS_QUAD
-	doquad =
-#endif /* HAS_QUAD */
-	dolong = FALSE;
-	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 (dolong) {
-		    dolong = FALSE;
-		    doquad = TRUE;
-		} else
-#endif
-		dolong = TRUE;
-		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':
-		dolong = TRUE;
-		/* FALL THROUGH */
-	    case 'd':
-		ch = *(++t);
-		*t = '\0';
-#ifdef HAS_QUAD
-		if (doquad)
-		    (void)sprintf(buf,s,(Quad_t)SvNV(arg));
-		else
-#endif
-		if (dolong)
-		    (void)sprintf(xs,f,(long)SvNV(arg));
-		else
-		    (void)sprintf(xs,f,SvIV(arg));
-		xlen = strlen(xs);
-		break;
-	    case 'X': case 'O':
-		dolong = TRUE;
-		/* FALL THROUGH */
-	    case 'x': case 'o': case 'u':
-		ch = *(++t);
-		*t = '\0';
-		value = SvNV(arg);
-#ifdef HAS_QUAD
-		if (doquad)
-		    (void)sprintf(buf,s,(unsigned Quad_t)value);
-		else
-#endif
-		if (dolong)
-		    (void)sprintf(xs,f,U_L(value));
-		else
-		    (void)sprintf(xs,f,U_I(value));
-		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
-do_vecset(sv)
-SV *sv;
+do_vecset(SV *sv)
 {
     SV *targ = LvTARG(sv);
     register I32 offset;
@@ -396,9 +211,7 @@ SV *sv;
 }
 
 void
-do_chop(astr,sv)
-register SV *astr;
-register SV *sv;
+do_chop(register SV *astr, register SV *sv)
 {
     STRLEN len;
     char *s;
@@ -440,9 +253,9 @@ register SV *sv;
 } 
 
 I32
-do_chomp(sv)
-register SV *sv;
+do_chomp(register SV *sv)
 {
+    dTHR;
     register I32 count;
     STRLEN len;
     char *s;
@@ -514,12 +327,9 @@ register SV *sv;
 } 
 
 void
-do_vop(optype,sv,left,right)
-I32 optype;
-SV *sv;
-SV *left;
-SV *right;
+do_vop(I32 optype, SV *sv, SV *left, SV *right)
 {
+    dTHR;	/* just for taint */
 #ifdef LIBERAL
     register long *dl;
     register long *ll;
@@ -535,8 +345,8 @@ SV *right;
     char *lsave;
     char *rsave;
 
-    if (optype == OP_BIT_OR && sv == left && !SvOK(sv) && !SvGMAGICAL(sv))
-	sv_setpvn(sv, "", 0);	/* avoid undef warning on |= */
+    if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv)))
+	sv_setpvn(sv, "", 0);	/* avoid undef warning on |= and ^= */
     lsave = lc = SvPV(left, leftlen);
     rsave = rc = SvPV(right, rightlen);
     len = leftlen < rightlen ? leftlen : rightlen;
@@ -627,19 +437,22 @@ SV *right;
 	    break;
 	}
     }
+    SvTAINT(sv);
 }
 
 OP *
-do_kv(ARGS)
-dARGS
+do_kv(ARGSproto)
 {
-    dSP;
+    djSP;
     HV *hv = (HV*)POPs;
+    HV *keys;
     register HE *entry;
     SV *tmpstr;
+    I32 gimme = GIMME_V;
     I32 dokeys =   (op->op_type == OP_KEYS);
     I32 dovalues = (op->op_type == OP_VALUES);
-
+    I32 realhv = (SvTYPE(hv) == SVt_PVHV);
+    
     if (op->op_type == OP_RV2HV || op->op_type == OP_PADHV) 
 	dokeys = dovalues = TRUE;
 
@@ -653,10 +466,14 @@ dARGS
 	RETURN;
     }
 
-    (void)hv_iterinit(hv);	/* always reset iterator regardless */
+    keys = realhv ? hv : avhv_keys((AV*)hv);
+    (void)hv_iterinit(keys);	/* always reset iterator regardless */
 
-    if (GIMME != G_ARRAY) {
-	I32 i;
+    if (gimme == G_VOID)
+	RETURN;
+
+    if (gimme == G_SCALAR) {
+	IV i;
 	dTARGET;
 
 	if (op->op_flags & OPf_MOD) {	/* lvalue */
@@ -665,43 +482,44 @@ dARGS
 		sv_magic(TARG, Nullsv, 'k', Nullch, 0);
 	    }
 	    LvTYPE(TARG) = 'k';
-	    LvTARG(TARG) = (SV*)hv;
+	    if (LvTARG(TARG) != (SV*)keys) {
+		if (LvTARG(TARG))
+		    SvREFCNT_dec(LvTARG(TARG));
+		LvTARG(TARG) = SvREFCNT_inc(keys);
+	    }
 	    PUSHs(TARG);
 	    RETURN;
 	}
 
-	if (!SvRMAGICAL(hv) || !mg_find((SV*)hv,'P'))
-	    i = HvKEYS(hv);
+	if (!SvRMAGICAL(keys) || !mg_find((SV*)keys,'P'))
+	    i = HvKEYS(keys);
 	else {
 	    i = 0;
 	    /*SUPPRESS 560*/
-	    while (entry = hv_iternext(hv)) {
-		i++;
-	    }
+	    while (hv_iternext(keys)) i++;
 	}
 	PUSHi( i );
 	RETURN;
     }
 
-    /* Guess how much room we need.  hv_max may be a few too many.  Oh well. */
-    EXTEND(sp, HvMAX(hv) * (dokeys + dovalues));
+    EXTEND(SP, HvKEYS(keys) * (dokeys + dovalues));
 
     PUTBACK;	/* hv_iternext and hv_iterval might clobber stack_sp */
-    while (entry = hv_iternext(hv)) {
+    while (entry = hv_iternext(keys)) {
 	SPAGAIN;
 	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));
+	    sv_setsv(tmpstr,realhv ?
+		     hv_iterval(hv,entry) : avhv_iterval((AV*)hv,entry));
+	    DEBUG_H(sv_setpvf(tmpstr, "%lu%%%d=%lu",
+			    (unsigned long)HeHASH(entry),
+			    HvMAX(keys)+1,
+			    (unsigned long)(HeHASH(entry) & HvMAX(keys))));
 	    SPAGAIN;
-	    DEBUG_H( {
-			sprintf(buf,"%d%%%d=%d\n", HeHASH(entry),
-				HvMAX(hv)+1, HeHASH(entry) & HvMAX(hv));
-			sv_setpv(tmpstr,buf);
-	    } )
-	    XPUSHs(sv_2mortal(tmpstr));
+	    XPUSHs(tmpstr);
 	}
 	PUTBACK;
     }