X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doop.c;h=400934dd3cbf96fce951095a4178cb47c70eda66;hb=acce7d4e04d89207299003c3e80c69d50bc82069;hp=d8615995c4c5306e760d86b4b6cc79828e90a046;hpb=4633a7c4bad06b471d9310620b7fe8ddd158cccd;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/doop.c b/doop.c
index d861599..400934d 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.
@@ -18,36 +18,28 @@
 #include <signal.h>
 #endif
 
-#ifdef BUGGY_MSC
- #pragma function(memcmp)
-#endif /* BUGGY_MSC */
-
-#ifdef BUGGY_MSC
- #pragma intrinsic(memcmp)
-#endif /* BUGGY_MSC */
-
 I32
 do_trans(sv,arg)
 SV *sv;
 OP *arg;
 {
     register short *tbl;
-    register char *s;
-    register I32 matches = 0;
+    register U8 *s;
+    register U8 *send;
+    register U8 *d;
     register I32 ch;
-    register char *send;
-    register char *d;
+    register I32 matches = 0;
     register I32 squash = op->op_private & OPpTRANS_SQUASH;
     STRLEN len;
 
     if (SvREADONLY(sv))
 	croak(no_modify);
-    tbl = (short*) cPVOP->op_pv;
-    s = SvPV(sv, len);
+    tbl = (short*)cPVOP->op_pv;
+    s = (U8*)SvPV(sv, len);
     if (!len)
 	return 0;
     if (!SvPOKp(sv))
-	s = SvPV_force(sv, len);
+	s = (U8*)SvPV_force(sv, len);
     (void)SvPOK_only(sv);
     send = s + len;
     if (!tbl || !s)
@@ -55,7 +47,7 @@ OP *arg;
     DEBUG_t( deb("2.TBL\n"));
     if (!op->op_private) {
 	while (s < send) {
-	    if ((ch = tbl[*s & 0377]) >= 0) {
+	    if ((ch = tbl[*s]) >= 0) {
 		matches++;
 		*s = ch;
 	    }
@@ -65,7 +57,7 @@ OP *arg;
     else {
 	d = s;
 	while (s < send) {
-	    if ((ch = tbl[*s & 0377]) >= 0) {
+	    if ((ch = tbl[*s]) >= 0) {
 		*d = ch;
 		if (matches++ && squash) {
 		    if (d[-1] == *d)
@@ -82,7 +74,7 @@ OP *arg;
 	}
 	matches += send - d;	/* account for disappeared chars */
 	*d = '\0';
-	SvCUR_set(sv, d - SvPVX(sv));
+	SvCUR_set(sv, d - (U8*)SvPVX(sv));
     }
     SvSETMAGIC(sv);
     return matches;
@@ -157,10 +149,7 @@ register SV **sarg;
     register char *s;
     register char *t;
     register char *f;
-    bool dolong;
-#ifdef HAS_QUAD
-    bool doquad;
-#endif /* HAS_QUAD */
+    char dotype;
     char ch;
     register char *send;
     register SV *arg;
@@ -189,10 +178,7 @@ register SV **sarg;
 	f = t;
 	*buf = '\0';
 	xs = buf;
-#ifdef HAS_QUAD
-	doquad =
-#endif /* HAS_QUAD */
-	dolong = FALSE;
+	dotype = '\0';
 	pre = post = 0;
 	for (t++; t < send; t++) {
 	    switch (*t) {
@@ -212,12 +198,14 @@ register SV **sarg;
 		continue;
 	    case 'l':
 #ifdef HAS_QUAD
-		if (dolong) {
-		    dolong = FALSE;
-		    doquad = TRUE;
-		} else
+		if (dotype == 'l')
+		    dotype = 'q';
+		else
 #endif
-		dolong = TRUE;
+		    dotype = 'l';
+		continue;
+	    case 'h':
+		dotype = 's';
 		continue;
 	    case 'c':
 		ch = *(++t);
@@ -234,38 +222,54 @@ register SV **sarg;
 		}
 		break;
 	    case 'D':
-		dolong = TRUE;
+		dotype = 'l';
 		/* FALL THROUGH */
 	    case 'd':
+	    case 'i':
 		ch = *(++t);
 		*t = '\0';
+		switch (dotype) {
 #ifdef HAS_QUAD
-		if (doquad)
-		    (void)sprintf(buf,s,(Quad_t)SvNV(arg));
-		else
+		case 'q':
+		    /* perl.h says that if quad is available, IV is quad */
+		    (void)sprintf(xs,f,(Quad_t)SvIV(arg));
+		    break;
 #endif
-		if (dolong)
-		    (void)sprintf(xs,f,(long)SvNV(arg));
-		else
-		    (void)sprintf(xs,f,SvIV(arg));
+		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':
-		dolong = TRUE;
+		dotype = 'l';
 		/* FALL THROUGH */
 	    case 'x': case 'o': case 'u':
 		ch = *(++t);
 		*t = '\0';
-		value = SvNV(arg);
+		switch (dotype) {
 #ifdef HAS_QUAD
-		if (doquad)
-		    (void)sprintf(buf,s,(unsigned Quad_t)value);
-		else
+		case 'q':
+		    /* perl.h says that if quad is available, UV is quad */
+		    (void)sprintf(xs,f,(unsigned Quad_t)SvUV(arg));
+		    break;
 #endif
-		if (dolong)
-		    (void)sprintf(xs,f,U_L(value));
-		else
-		    (void)sprintf(xs,f,U_I(value));
+		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':
@@ -273,6 +277,15 @@ register SV **sarg;
 		*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);
@@ -320,7 +333,7 @@ register SV **sarg;
 	    /* end of switch, copy results */
 	    *t = ch;
 	    if (xs == buf && xlen >= sizeof(buf)) {	/* Ooops! */
-		fputs("panic: sprintf overflow - memory corrupted!\n",stderr);
+		PerlIO_puts(PerlIO_stderr(),"panic: sprintf overflow - memory corrupted!\n");
 		my_exit(1);
 	    }
 	    SvGROW(sv, SvCUR(sv) + (f - s) + xlen + 1 + pre + post);
@@ -442,10 +455,13 @@ I32
 do_chomp(sv)
 register SV *sv;
 {
-    register I32 count = 0;
+    register I32 count;
     STRLEN len;
     char *s;
-    
+
+    if (RsSNARF(rs))
+	return 0;
+    count = 0;
     if (SvTYPE(sv) == SVt_PVAV) {
 	register I32 i;
         I32 max;
@@ -472,7 +488,7 @@ register SV *sv;
 	s = SvPV_force(sv, len);
     if (s && len) {
 	s += --len;
-	if (rspara) {
+	if (RsPARA(rs)) {
 	    if (*s != '\n')
 		goto nope;
 	    ++count;
@@ -482,21 +498,24 @@ register SV *sv;
 		++count;
 	    }
 	}
-	else if (rslen == 1) {
-	    if (*s != rschar)
-		goto nope;
-	    ++count;
-	} 
 	else {
-	    if (len < rslen - 1)
-		goto nope;
-	    len -= rslen - 1;
-	    s -= rslen - 1;
-	    if (bcmp(s, rs, rslen))
-		goto nope;
-	    count += rslen;
+	    STRLEN rslen;
+	    char *rsptr = SvPV(rs, rslen);
+	    if (rslen == 1) {
+		if (*s != *rsptr)
+		    goto nope;
+		++count;
+	    }
+	    else {
+		if (len < rslen - 1)
+		    goto nope;
+		len -= rslen - 1;
+		s -= rslen - 1;
+		if (memNE(s, rsptr, rslen))
+		    goto nope;
+		count += rslen;
+	    }
 	}
-
 	*s = '\0';
 	SvCUR_set(sv, len);
 	SvNIOK_off(sv);
@@ -521,17 +540,32 @@ SV *right;
     register char *dc;
     STRLEN leftlen;
     STRLEN rightlen;
-    register char *lc = SvPV(left, leftlen);
-    register char *rc = SvPV(right, rightlen);
+    register char *lc;
+    register char *rc;
     register I32 len;
     I32 lensave;
+    char *lsave;
+    char *rsave;
 
-    dc = SvPV_force(sv,na);
+    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;
     lensave = len;
-    if (SvCUR(sv) < len) {
-	dc = SvGROW(sv,len + 1);
-	(void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
+    if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) {
+	dc = SvPV_force(sv, na);
+	if (SvCUR(sv) < len) {
+	    dc = SvGROW(sv, len + 1);
+	    (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
+	}
+    }
+    else {
+	I32 needlen = ((optype == OP_BIT_AND)
+			? len : (leftlen > rightlen ? leftlen : rightlen));
+	Newz(801, dc, needlen + 1, char);
+	(void)sv_usepvn(sv, dc, needlen);
+	dc = SvPVX(sv);		/* sv_usepvn() calls Renew() */
     }
     SvCUR_set(sv, len);
     (void)SvPOK_only(sv);
@@ -582,9 +616,6 @@ SV *right;
     }
 #endif
     {
-	char *lsave = lc;
-	char *rsave = rc;
-	
 	switch (optype) {
 	case OP_BIT_AND:
 	    while (len--)
@@ -616,24 +647,45 @@ dARGS
 {
     dSP;
     HV *hv = (HV*)POPs;
-    I32 i;
     register HE *entry;
-    char *tmps;
     SV *tmpstr;
+    I32 gimme = GIMME_V;
     I32 dokeys =   (op->op_type == OP_KEYS);
     I32 dovalues = (op->op_type == OP_VALUES);
 
     if (op->op_type == OP_RV2HV || op->op_type == OP_PADHV) 
 	dokeys = dovalues = TRUE;
 
-    if (!hv)
+    if (!hv) {
+	if (op->op_flags & OPf_MOD) {	/* lvalue */
+	    dTARGET;		/* make sure to clear its target here */
+	    if (SvTYPE(TARG) == SVt_PVLV)
+		LvTARG(TARG) = Nullsv;
+	    PUSHs(TARG);
+	}
 	RETURN;
+    }
 
     (void)hv_iterinit(hv);	/* always reset iterator regardless */
 
-    if (GIMME != G_ARRAY) {
+    if (gimme == G_VOID)
+	RETURN;
+
+    if (gimme == G_SCALAR) {
+	I32 i;
 	dTARGET;
 
+	if (op->op_flags & OPf_MOD) {	/* lvalue */
+	    if (SvTYPE(TARG) < SVt_PVLV) {
+		sv_upgrade(TARG, SVt_PVLV);
+		sv_magic(TARG, Nullsv, 'k', Nullch, 0);
+	    }
+	    LvTYPE(TARG) = 'k';
+	    LvTARG(TARG) = (SV*)hv;
+	    PUSHs(TARG);
+	    RETURN;
+	}
+
 	if (!SvRMAGICAL(hv) || !mg_find((SV*)hv,'P'))
 	    i = HvKEYS(hv);
 	else {
@@ -653,21 +705,19 @@ dARGS
     PUTBACK;	/* hv_iternext and hv_iterval might clobber stack_sp */
     while (entry = hv_iternext(hv)) {
 	SPAGAIN;
-	if (dokeys) {
-	    tmps = hv_iterkey(entry,&i);	/* won't clobber stack_sp */
-	    if (!i)
-		tmps = "";
-	    XPUSHs(sv_2mortal(newSVpv(tmps,i)));
-	}
+	if (dokeys)
+	    XPUSHs(hv_iterkeysv(entry));	/* won't clobber stack_sp */
 	if (dovalues) {
 	    tmpstr = NEWSV(45,0);
 	    PUTBACK;
 	    sv_setsv(tmpstr,hv_iterval(hv,entry));
 	    SPAGAIN;
 	    DEBUG_H( {
-		sprintf(buf,"%d%%%d=%d\n",entry->hent_hash,
-		    HvMAX(hv)+1,entry->hent_hash & HvMAX(hv));
-		sv_setpv(tmpstr,buf);
+			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));
 	}