/* 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.
#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;
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);
}
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++;
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;
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;
}
}
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;
}
void
-do_chop(astr,sv)
-register SV *astr;
-register SV *sv;
+do_chop(register SV *astr, register SV *sv)
{
STRLEN len;
char *s;
}
I32
-do_chomp(sv)
-register SV *sv;
+do_chomp(register SV *sv)
{
+ dTHR;
register I32 count;
STRLEN len;
char *s;
}
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;
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;
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;
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 */
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;
}
https://perl5.git.perl.org / perl5.git / blobdiff