X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/f12c70209e012fbc59a7f4c437dc47d352265aed..2626e112ed2a75058c6a5e98cce21f1af08a8ace:/pp.c diff --git a/pp.c b/pp.c index 03685cb..863478d 100644 --- a/pp.c +++ b/pp.c @@ -1,6 +1,6 @@ /* pp.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. @@ -15,7 +15,25 @@ #include "EXTERN.h" #include "perl.h" -static void doencodes _((SV *sv, char *s, I32 len)); +/* + * Types used in bitwise operations. + * + * Normally we'd just use IV and UV. However, some hardware and + * software combinations (e.g. Alpha and current OSF/1) don't have a + * floating-point type to use for NV that has adequate bits to fully + * hold an IV/UV. (In other words, sizeof(long) == sizeof(double).) + * + * It just so happens that "int" is the right size everywhere, at + * least today. + */ +typedef int IBW; +typedef unsigned UBW; + +static void doencodes _((SV* sv, char* s, I32 len)); +static SV* refto _((SV* sv)); +static U32 seed _((void)); + +static bool srand_called = FALSE; /* variations on pp_null */ @@ -74,7 +92,8 @@ PP(pp_padhv) else { SV* sv = sv_newmortal(); if (HvFILL((HV*)TARG)) { - sprintf(buf, "%d/%d", HvFILL((HV*)TARG), HvMAX((HV*)TARG)+1); + sprintf(buf, "%ld/%ld", + (long)HvFILL((HV*)TARG), (long)HvMAX((HV*)TARG)+1); sv_setpv(sv, buf); } else @@ -98,7 +117,13 @@ PP(pp_rv2gv) if (SvROK(sv)) { wasref: sv = SvRV(sv); - if (SvTYPE(sv) != SVt_PVGV) + if (SvTYPE(sv) == SVt_PVIO) { + GV *gv = (GV*) sv_newmortal(); + gv_init(gv, 0, "", 0, 0); + GvIOp(gv) = (IO *)sv; + SvREFCNT_inc(sv); + sv = (SV*) gv; + } else if (SvTYPE(sv) != SVt_PVGV) DIE("Not a GLOB reference"); } else { @@ -114,6 +139,8 @@ PP(pp_rv2gv) if (op->op_flags & OPf_REF || op->op_private & HINT_STRICT_REFS) DIE(no_usym, "a symbol"); + if (dowarn) + warn(warn_uninit); RETSETUNDEF; } sym = SvPV(sv, na); @@ -122,28 +149,8 @@ PP(pp_rv2gv) sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV); } } - if (op->op_private & OPpLVAL_INTRO) { - GP *ogp = GvGP(sv); - - SSCHECK(3); - SSPUSHPTR(SvREFCNT_inc(sv)); - SSPUSHPTR(ogp); - SSPUSHINT(SAVEt_GP); - - if (op->op_flags & OPf_SPECIAL) { - GvGP(sv)->gp_refcnt++; /* will soon be assigned */ - GvINTRO_on(sv); - } - else { - GP *gp; - Newz(602,gp, 1, GP); - GvGP(sv) = gp; - GvREFCNT(sv) = 1; - GvSV(sv) = NEWSV(72,0); - GvLINE(sv) = curcop->cop_line; - GvEGV(sv) = (GV*)sv; - } - } + if (op->op_private & OPpLVAL_INTRO) + save_gp((GV*)sv, !(op->op_flags & OPf_SPECIAL)); SETs(sv); RETURN; } @@ -176,6 +183,8 @@ PP(pp_rv2sv) if (op->op_flags & OPf_REF || op->op_private & HINT_STRICT_REFS) DIE(no_usym, "a SCALAR"); + if (dowarn) + warn(warn_uninit); RETSETUNDEF; } sym = SvPV(sv, na); @@ -188,7 +197,7 @@ PP(pp_rv2sv) if (op->op_flags & OPf_MOD) { if (op->op_private & OPpLVAL_INTRO) sv = save_scalar((GV*)TOPs); - else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV)) + else if (op->op_private & OPpDEREF) provide_ref(op, sv); } SETs(sv); @@ -214,7 +223,12 @@ PP(pp_pos) dSP; dTARGET; dPOPss; if (op->op_flags & OPf_MOD) { - LvTYPE(TARG) = '<'; + if (SvTYPE(TARG) < SVt_PVLV) { + sv_upgrade(TARG, SVt_PVLV); + sv_magic(TARG, Nullsv, '.', Nullch, 0); + } + + LvTYPE(TARG) = '.'; LvTARG(TARG) = sv; PUSHs(TARG); /* no SvSETMAGIC */ RETURN; @@ -242,8 +256,11 @@ PP(pp_rv2cv) /* We usually try to add a non-existent subroutine in case of AUTOLOAD. */ /* (But not in defined().) */ CV *cv = sv_2cv(TOPs, &stash, &gv, !(op->op_flags & OPf_SPECIAL)); - - if (!cv) + if (cv) { + if (CvCLONE(cv)) + cv = (CV*)sv_2mortal((SV*)cv_clone(cv)); + } + else cv = (CV*)&sv_undef; SETs((SV*)cv); RETURN; @@ -259,10 +276,8 @@ PP(pp_prototype) ret = &sv_undef; cv = sv_2cv(TOPs, &stash, &gv, FALSE); - if (cv && SvPOK(cv)) { - char *p = SvPVX(cv); - ret = sv_2mortal(newSVpv(p ? p : "", SvLEN(cv))); - } + if (cv && SvPOK(cv)) + ret = sv_2mortal(newSVpv(SvPVX(cv), SvCUR(cv))); SETs(ret); RETURN; } @@ -270,60 +285,59 @@ PP(pp_prototype) PP(pp_anoncode) { dSP; - CV* cv = (CV*)cSVOP->op_sv; - EXTEND(SP,1); - + CV* cv = (CV*)curpad[op->op_targ]; if (CvCLONE(cv)) cv = (CV*)sv_2mortal((SV*)cv_clone(cv)); - + EXTEND(SP,1); PUSHs((SV*)cv); RETURN; } PP(pp_srefgen) { - dSP; dTOPss; - SV* rv; - rv = sv_newmortal(); - sv_upgrade(rv, SVt_RV); - if (SvPADTMP(sv)) - sv = newSVsv(sv); - else { - SvTEMP_off(sv); - (void)SvREFCNT_inc(sv); - } - SvRV(rv) = sv; - SvROK_on(rv); - SETs(rv); + dSP; + *SP = refto(*SP); RETURN; } PP(pp_refgen) { dSP; dMARK; - SV* sv; - SV* rv; if (GIMME != G_ARRAY) { MARK[1] = *SP; SP = MARK + 1; } - while (MARK < SP) { - sv = *++MARK; - rv = sv_newmortal(); - sv_upgrade(rv, SVt_RV); - if (SvPADTMP(sv)) - sv = newSVsv(sv); - else { - SvTEMP_off(sv); - (void)SvREFCNT_inc(sv); - } - SvRV(rv) = sv; - SvROK_on(rv); - *MARK = rv; - } + EXTEND_MORTAL(SP - MARK); + while (++MARK <= SP) + *MARK = refto(*MARK); RETURN; } +static SV* +refto(sv) +SV* sv; +{ + SV* rv; + + if (SvTYPE(sv) == SVt_PVLV && LvTYPE(sv) == 'y') { + if (LvTARGLEN(sv)) + vivify_itervar(sv); + if (LvTARG(sv)) + sv = LvTARG(sv); + } + else if (SvPADTMP(sv)) + sv = newSVsv(sv); + else { + SvTEMP_off(sv); + (void)SvREFCNT_inc(sv); + } + rv = sv_newmortal(); + sv_upgrade(rv, SVt_RV); + SvRV(rv) = sv; + SvROK_on(rv); + return rv; +} + PP(pp_ref) { dSP; dTARGET; @@ -368,13 +382,12 @@ PP(pp_study) register I32 ch; register I32 *sfirst; register I32 *snext; - I32 retval; STRLEN len; - s = (unsigned char*)(SvPV(sv, len)); - pos = len; - if (sv == lastscream) - SvSCREAM_off(sv); + if (sv == lastscream) { + if (SvSCREAM(sv)) + RETPUSHYES; + } else { if (lastscream) { SvSCREAM_off(lastscream); @@ -382,10 +395,11 @@ PP(pp_study) } lastscream = SvREFCNT_inc(sv); } - if (pos <= 0) { - retval = 0; - goto ret; - } + + s = (unsigned char*)(SvPV(sv, len)); + pos = len; + if (pos <= 0) + RETPUSHNO; if (pos > maxscream) { if (maxscream < 0) { maxscream = pos + 80; @@ -415,21 +429,11 @@ PP(pp_study) else snext[pos] = -pos; sfirst[ch] = pos; - - /* If there were any case insensitive searches, we must assume they - * all are. This speeds up insensitive searches much more than - * it slows down sensitive ones. - */ - if (sawi) - sfirst[fold[ch]] = pos; } SvSCREAM_on(sv); sv_magic(sv, Nullsv, 'g', Nullch, 0); /* piggyback on m//g magic */ - retval = 1; - ret: - XPUSHs(sv_2mortal(newSViv((I32)retval))); - RETURN; + RETPUSHYES; } PP(pp_trans) @@ -520,8 +524,10 @@ PP(pp_undef) dSP; SV *sv; - if (!op->op_private) + if (!op->op_private) { + EXTEND(SP, 1); RETPUSHUNDEF; + } sv = POPs; if (!sv) @@ -544,16 +550,19 @@ PP(pp_undef) hv_undef((HV*)sv); break; case SVt_PVCV: + if (!CvANON((CV*)sv) && cv_const_sv((CV*)sv)) + warn("Constant subroutine %s undefined", + GvENAME(CvGV((CV*)sv))); + /* FALL THROUGH */ + case SVt_PVFM: cv_undef((CV*)sv); - sub_generation++; break; case SVt_PVGV: - if (SvFAKE(sv)) { - sv_setsv(sv, &sv_undef); - break; - } + if (SvFAKE(sv)) + sv_setsv(sv, &sv_undef); + break; default: - if (SvPOK(sv) && SvLEN(sv)) { + if (SvTYPE(sv) >= SVt_PV && SvPVX(sv) && SvLEN(sv)) { (void)SvOOK_off(sv); Safefree(SvPVX(sv)); SvPV_set(sv, Nullch); @@ -569,9 +578,13 @@ PP(pp_undef) PP(pp_predec) { dSP; - if (SvIOK(TOPs)) { + if (SvREADONLY(TOPs)) + croak(no_modify); + if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) && + SvIVX(TOPs) != IV_MIN) + { --SvIVX(TOPs); - SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK); + SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK); } else sv_dec(TOPs); @@ -582,10 +595,14 @@ PP(pp_predec) PP(pp_postinc) { dSP; dTARGET; + if (SvREADONLY(TOPs)) + croak(no_modify); sv_setsv(TARG, TOPs); - if (SvIOK(TOPs)) { + if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) && + SvIVX(TOPs) != IV_MAX) + { ++SvIVX(TOPs); - SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK); + SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK); } else sv_inc(TOPs); @@ -599,10 +616,14 @@ PP(pp_postinc) PP(pp_postdec) { dSP; dTARGET; + if(SvREADONLY(TOPs)) + croak(no_modify); sv_setsv(TARG, TOPs); - if (SvIOK(TOPs)) { + if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) && + SvIVX(TOPs) != IV_MIN) + { --SvIVX(TOPs); - SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK); + SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK); } else sv_dec(TOPs); @@ -637,25 +658,24 @@ PP(pp_divide) { dSP; dATARGET; tryAMAGICbin(div,opASSIGN); { - dPOPnv; - if (value == 0.0) + dPOPPOPnnrl; + double value; + if (right == 0.0) DIE("Illegal division by zero"); #ifdef SLOPPYDIVIDE /* insure that 20./5. == 4. */ { - double x; - I32 k; - x = POPn; - if ((double)I_32(x) == x && - (double)I_32(value) == value && - (k = I_32(x)/I_32(value))*I_32(value) == I_32(x)) { + IV k; + if ((double)I_V(left) == left && + (double)I_V(right) == right && + (k = I_V(left)/I_V(right))*I_V(right) == I_V(left)) { value = k; } else { - value = x/value; + value = left / right; } } #else - value = POPn / value; + value = left / right; #endif PUSHn( value ); RETURN; @@ -666,21 +686,26 @@ PP(pp_modulo) { dSP; dATARGET; tryAMAGICbin(mod,opASSIGN); { - register unsigned long tmpulong; - register long tmplong; - I32 value; + register UV right; - tmpulong = (unsigned long) POPn; - if (tmpulong == 0L) + right = POPu; + if (!right) DIE("Illegal modulus zero"); - value = TOPn; - if (value >= 0.0) - value = (I32)(((unsigned long)value) % tmpulong); + + if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) { + register IV left = SvIVX(TOPs); + if (left < 0) + SETu( (right - ((UV)(-left) - 1) % right) - 1 ); + else + SETi( left % right ); + } else { - tmplong = (long)value; - value = (I32)(tmpulong - ((-tmplong - 1) % tmpulong)) - 1; + register double left = TOPn; + if (left < 0.0) + SETu( (right - (U_V(-left) - 1) % right) - 1 ); + else + SETu( U_V(left) % right ); } - SETi(value); RETURN; } } @@ -724,16 +749,17 @@ PP(pp_repeat) } SvSetSV(TARG, tmpstr); SvPV_force(TARG, len); - if (count >= 1) { - SvGROW(TARG, (count * len) + 1); - if (count > 1) + if (count != 1) { + if (count < 1) + SvCUR_set(TARG, 0); + else { + SvGROW(TARG, (count * len) + 1); repeatcpy(SvPVX(TARG) + len, SvPVX(TARG), len, count - 1); - SvCUR(TARG) *= count; + SvCUR(TARG) *= count; + } *SvEND(TARG) = '\0'; - (void)SvPOK_only(TARG); } - else - sv_setsv(TARG, &sv_no); + (void)SvPOK_only(TARG); PUSHTARG; } RETURN; @@ -744,7 +770,7 @@ PP(pp_subtract) { dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN); { - dPOPTOPnnrl; + dPOPTOPnnrl_ul; SETn( left - right ); RETURN; } @@ -754,9 +780,16 @@ PP(pp_left_shift) { dSP; dATARGET; tryAMAGICbin(lshift,opASSIGN); { - dPOPTOPiirl; - SETi( left << right ); - RETURN; + IBW shift = POPi; + if (op->op_private & HINT_INTEGER) { + IBW i = TOPi; + SETi( i << shift ); + } + else { + UBW u = TOPu; + SETu( u << shift ); + } + RETURN; } } @@ -764,8 +797,15 @@ PP(pp_right_shift) { dSP; dATARGET; tryAMAGICbin(rshift,opASSIGN); { - dPOPTOPiirl; - SETi( left >> right ); + IBW shift = POPi; + if (op->op_private & HINT_INTEGER) { + IBW i = TOPi; + SETi( i >> shift ); + } + else { + UBW u = TOPu; + SETu( u >> shift ); + } RETURN; } } @@ -827,12 +867,16 @@ PP(pp_ncmp) dPOPTOPnnrl; I32 value; - if (left > right) - value = 1; + if (left == right) + value = 0; else if (left < right) value = -1; - else - value = 0; + else if (left > right) + value = 1; + else { + SETs(&sv_undef); + RETURN; + } SETi(value); RETURN; } @@ -843,7 +887,10 @@ PP(pp_slt) dSP; tryAMAGICbinSET(slt,0); { dPOPTOPssrl; - SETs( sv_cmp(left, right) < 0 ? &sv_yes : &sv_no ); + int cmp = ((op->op_private & OPpLOCALE) + ? sv_cmp_locale(left, right) + : sv_cmp(left, right)); + SETs( cmp < 0 ? &sv_yes : &sv_no ); RETURN; } } @@ -853,7 +900,10 @@ PP(pp_sgt) dSP; tryAMAGICbinSET(sgt,0); { dPOPTOPssrl; - SETs( sv_cmp(left, right) > 0 ? &sv_yes : &sv_no ); + int cmp = ((op->op_private & OPpLOCALE) + ? sv_cmp_locale(left, right) + : sv_cmp(left, right)); + SETs( cmp > 0 ? &sv_yes : &sv_no ); RETURN; } } @@ -863,7 +913,10 @@ PP(pp_sle) dSP; tryAMAGICbinSET(sle,0); { dPOPTOPssrl; - SETs( sv_cmp(left, right) <= 0 ? &sv_yes : &sv_no ); + int cmp = ((op->op_private & OPpLOCALE) + ? sv_cmp_locale(left, right) + : sv_cmp(left, right)); + SETs( cmp <= 0 ? &sv_yes : &sv_no ); RETURN; } } @@ -873,7 +926,20 @@ PP(pp_sge) dSP; tryAMAGICbinSET(sge,0); { dPOPTOPssrl; - SETs( sv_cmp(left, right) >= 0 ? &sv_yes : &sv_no ); + int cmp = ((op->op_private & OPpLOCALE) + ? sv_cmp_locale(left, right) + : sv_cmp(left, right)); + SETs( cmp >= 0 ? &sv_yes : &sv_no ); + RETURN; + } +} + +PP(pp_seq) +{ + dSP; tryAMAGICbinSET(seq,0); + { + dPOPTOPssrl; + SETs( sv_eq(left, right) ? &sv_yes : &sv_no ); RETURN; } } @@ -893,19 +959,28 @@ PP(pp_scmp) dSP; dTARGET; tryAMAGICbin(scmp,0); { dPOPTOPssrl; - SETi( sv_cmp(left, right) ); + int cmp = ((op->op_private & OPpLOCALE) + ? sv_cmp_locale(left, right) + : sv_cmp(left, right)); + SETi( cmp ); RETURN; } } -PP(pp_bit_and) { +PP(pp_bit_and) +{ dSP; dATARGET; tryAMAGICbin(band,opASSIGN); { dPOPTOPssrl; if (SvNIOKp(left) || SvNIOKp(right)) { - unsigned long value = U_L(SvNV(left)); - value = value & U_L(SvNV(right)); - SETn((double)value); + if (op->op_private & HINT_INTEGER) { + IBW value = SvIV(left) & SvIV(right); + SETi( value ); + } + else { + UBW value = SvUV(left) & SvUV(right); + SETu( value ); + } } else { do_vop(op->op_type, TARG, left, right); @@ -921,9 +996,14 @@ PP(pp_bit_xor) { dPOPTOPssrl; if (SvNIOKp(left) || SvNIOKp(right)) { - unsigned long value = U_L(SvNV(left)); - value = value ^ U_L(SvNV(right)); - SETn((double)value); + if (op->op_private & HINT_INTEGER) { + IBW value = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right); + SETi( value ); + } + else { + UBW value = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right); + SETu( value ); + } } else { do_vop(op->op_type, TARG, left, right); @@ -939,9 +1019,14 @@ PP(pp_bit_or) { dPOPTOPssrl; if (SvNIOKp(left) || SvNIOKp(right)) { - unsigned long value = U_L(SvNV(left)); - value = value | U_L(SvNV(right)); - SETn((double)value); + if (op->op_private & HINT_INTEGER) { + IBW value = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right); + SETi( value ); + } + else { + UBW value = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right); + SETu( value ); + } } else { do_vop(op->op_type, TARG, left, right); @@ -958,12 +1043,14 @@ PP(pp_negate) dTOPss; if (SvGMAGICAL(sv)) mg_get(sv); - if (SvNIOKp(sv)) + if (SvIOKp(sv) && !SvNOKp(sv) && !SvPOKp(sv) && SvIVX(sv) != IV_MIN) + SETi(-SvIVX(sv)); + else if (SvNIOKp(sv)) SETn(-SvNV(sv)); else if (SvPOKp(sv)) { STRLEN len; char *s = SvPV(sv, len); - if (isALPHA(*s) || *s == '_') { + if (isIDFIRST(*s)) { sv_setpvn(TARG, "-", 1); sv_catsv(TARG, sv); } @@ -995,18 +1082,20 @@ PP(pp_complement) dSP; dTARGET; tryAMAGICun(compl); { dTOPss; - register I32 anum; - if (SvNIOKp(sv)) { - IV iv = ~SvIV(sv); - if (iv < 0) - SETn( (double) ~U_L(SvNV(sv)) ); - else - SETi( iv ); + if (op->op_private & HINT_INTEGER) { + IBW value = ~SvIV(sv); + SETi( value ); + } + else { + UBW value = ~SvUV(sv); + SETu( value ); + } } else { register char *tmps; register long *tmpl; + register I32 anum; STRLEN len; SvSetSV(TARG, sv); @@ -1059,6 +1148,8 @@ PP(pp_i_modulo) dSP; dATARGET; tryAMAGICbin(mod,opASSIGN); { dPOPTOPiirl; + if (!right) + DIE("Illegal modulus zero"); SETi( left % right ); RETURN; } @@ -1215,6 +1306,10 @@ PP(pp_rand) value = POPn; if (value == 0.0) value = 1.0; + if (!srand_called) { + (void)srand((unsigned)seed()); + srand_called = TRUE; + } #if RANDBITS == 31 value = rand() * value / 2147483648.0; #else @@ -1235,38 +1330,44 @@ PP(pp_rand) PP(pp_srand) { dSP; - I32 anum; + UV anum; + if (MAXARG < 1) + anum = seed(); + else + anum = POPu; + (void)srand((unsigned)anum); + srand_called = TRUE; + EXTEND(SP, 1); + RETPUSHYES; +} - if (MAXARG < 1) { +static U32 +seed() +{ + U32 u; #ifdef VMS # include - unsigned int when[2]; - _ckvmssts(sys$gettim(when)); - anum = when[0] ^ when[1]; + unsigned int when[2]; + _ckvmssts(sys$gettim(when)); + u = when[0] ^ when[1]; #else -# if defined(I_SYS_TIME) && !defined(PLAN9) - struct timeval when; - gettimeofday(&when,(struct timezone *) 0); - anum = when.tv_sec ^ when.tv_usec; +# ifdef HAS_GETTIMEOFDAY + struct timeval when; + gettimeofday(&when,(struct timezone *) 0); + u = when.tv_sec ^ when.tv_usec; # else - Time_t when; - (void)time(&when); - anum = when; + Time_t when; + (void)time(&when); + u = when; # endif #endif -#if !defined(PLAN9) /* XXX Plan9 assembler chokes on this; fix coming soon */ - /* 17-Jul-1996 bailey@genetics.upenn.edu */ - /* What is a good hashing algorithm here? */ - anum ^= ( ( 269 * (U32)getpid()) - ^ (26107 * (U32)&when) - ^ (73819 * (U32)stack_sp)); +#ifndef PLAN9 /* XXX Plan9 assembler chokes on this; fix needed */ + /* What is a good hashing algorithm here? */ + u ^= ( ( 269 * (U32)getpid()) + ^ (26107 * (U32)&when) + ^ (73819 * (U32)stack_sp)); #endif - } - else - anum = POPi; - (void)srand(anum); - EXTEND(SP, 1); - RETPUSHYES; + return u; } PP(pp_exp) @@ -1287,8 +1388,10 @@ PP(pp_log) { double value; value = POPn; - if (value <= 0.0) + if (value <= 0.0) { + SET_NUMERIC_STANDARD(); DIE("Can't take log of %g", value); + } value = log(value); XPUSHn(value); RETURN; @@ -1301,8 +1404,10 @@ PP(pp_sqrt) { double value; value = POPn; - if (value < 0.0) + if (value < 0.0) { + SET_NUMERIC_STANDARD(); DIE("Can't take sqrt of %g", value); + } value = sqrt(value); XPUSHn(value); RETURN; @@ -1312,15 +1417,28 @@ PP(pp_sqrt) PP(pp_int) { dSP; dTARGET; - double value; - value = POPn; - if (value >= 0.0) - (void)modf(value, &value); - else { - (void)modf(-value, &value); - value = -value; + { + double value = TOPn; + IV iv; + + if (SvIOKp(TOPs) && !SvNOKp(TOPs) && !SvPOKp(TOPs)) { + iv = SvIVX(TOPs); + SETi(iv); + } + else { + if (value >= 0.0) + (void)modf(value, &value); + else { + (void)modf(-value, &value); + value = -value; + } + iv = I_V(value); + if (iv == value) + SETi(iv); + else + SETn(value); + } } - XPUSHn(value); RETURN; } @@ -1328,37 +1446,39 @@ PP(pp_abs) { dSP; dTARGET; tryAMAGICun(abs); { - double value; - value = POPn; - - if (value < 0.0) - value = -value; + double value = TOPn; + IV iv; - XPUSHn(value); - RETURN; + if (SvIOKp(TOPs) && !SvNOKp(TOPs) && !SvPOKp(TOPs) && + (iv = SvIVX(TOPs)) != IV_MIN) { + if (iv < 0) + iv = -iv; + SETi(iv); + } + else { + if (value < 0.0) + value = -value; + SETn(value); + } } + RETURN; } PP(pp_hex) { dSP; dTARGET; char *tmps; - unsigned long value; I32 argtype; tmps = POPp; - value = scan_hex(tmps, 99, &argtype); - if ((IV)value >= 0) - XPUSHi(value); - else - XPUSHn(U_V(value)); + XPUSHu(scan_hex(tmps, 99, &argtype)); RETURN; } PP(pp_oct) { dSP; dTARGET; - unsigned long value; + UV value; I32 argtype; char *tmps; @@ -1371,10 +1491,7 @@ PP(pp_oct) value = scan_hex(++tmps, 99, &argtype); else value = scan_oct(tmps, 99, &argtype); - if ((IV)value >= 0) - XPUSHi(value); - else - XPUSHn(U_V(value)); + XPUSHu(value); RETURN; } @@ -1425,14 +1542,24 @@ PP(pp_substr) rem = len; sv_setpvn(TARG, tmps, rem); if (lvalue) { /* it's an lvalue! */ - if (!SvGMAGICAL(sv)) - (void)SvPOK_only(sv); + if (!SvGMAGICAL(sv)) { + if (SvROK(sv)) { + SvPV_force(sv,na); + if (dowarn) + warn("Attempt to use reference as lvalue in substr"); + } + if (SvOK(sv)) /* is it defined ? */ + (void)SvPOK_only(sv); + else + sv_setpvn(sv,"",0); /* avoid lexical reincarnation */ + } + if (SvTYPE(TARG) < SVt_PVLV) { sv_upgrade(TARG, SVt_PVLV); sv_magic(TARG, Nullsv, 'x', Nullch, 0); } - LvTYPE(TARG) = 's'; + LvTYPE(TARG) = 'x'; LvTARG(TARG) = sv; LvTARGOFF(TARG) = pos; LvTARGLEN(TARG) = rem; @@ -1511,7 +1638,7 @@ PP(pp_vec) } } - sv_setiv(TARG, (I32)retnum); + sv_setiv(TARG, (IV)retnum); PUSHs(TARG); RETURN; } @@ -1588,7 +1715,14 @@ PP(pp_rindex) PP(pp_sprintf) { dSP; dMARK; dORIGMARK; dTARGET; +#ifdef USE_LOCALE_NUMERIC + if (op->op_private & OPpLOCALE) + SET_NUMERIC_LOCAL(); + else + SET_NUMERIC_STANDARD(); +#endif do_sprintf(TARG, SP-MARK, MARK+1); + TAINT_IF(SvTAINTED(TARG)); SP = ORIGMARK; PUSHTARG; RETURN; @@ -1660,8 +1794,15 @@ PP(pp_ucfirst) SETs(sv); } s = SvPV_force(sv, na); - if (isLOWER(*s)) - *s = toUPPER(*s); + if (*s) { + if (op->op_private & OPpLOCALE) { + TAINT; + SvTAINTED_on(sv); + *s = toUPPER_LC(*s); + } + else + *s = toUPPER(*s); + } RETURN; } @@ -1679,8 +1820,15 @@ PP(pp_lcfirst) SETs(sv); } s = SvPV_force(sv, na); - if (isUPPER(*s)) - *s = toLOWER(*s); + if (*s) { + if (op->op_private & OPpLOCALE) { + TAINT; + SvTAINTED_on(sv); + *s = toLOWER_LC(*s); + } + else + *s = toLOWER(*s); + } SETs(sv); RETURN; @@ -1691,7 +1839,6 @@ PP(pp_uc) dSP; SV *sv = TOPs; register char *s; - register char *send; STRLEN len; if (!SvPADTMP(sv)) { @@ -1700,12 +1847,21 @@ PP(pp_uc) sv = TARG; SETs(sv); } + s = SvPV_force(sv, len); - send = s + len; - while (s < send) { - if (isLOWER(*s)) - *s = toUPPER(*s); - s++; + if (len) { + register char *send = s + len; + + if (op->op_private & OPpLOCALE) { + TAINT; + SvTAINTED_on(sv); + for (; s < send; s++) + *s = toUPPER_LC(*s); + } + else { + for (; s < send; s++) + *s = toUPPER(*s); + } } RETURN; } @@ -1715,7 +1871,6 @@ PP(pp_lc) dSP; SV *sv = TOPs; register char *s; - register char *send; STRLEN len; if (!SvPADTMP(sv)) { @@ -1724,12 +1879,21 @@ PP(pp_lc) sv = TARG; SETs(sv); } + s = SvPV_force(sv, len); - send = s + len; - while (s < send) { - if (isUPPER(*s)) - *s = toLOWER(*s); - s++; + if (len) { + register char *send = s + len; + + if (op->op_private & OPpLOCALE) { + TAINT; + SvTAINTED_on(sv); + for (; s < send; s++) + *s = toLOWER_LC(*s); + } + else { + for (; s < send; s++) + *s = toLOWER(*s); + } } RETURN; } @@ -1848,17 +2012,35 @@ PP(pp_delete) { dSP; SV *sv; - SV *tmpsv = POPs; - HV *hv = (HV*)POPs; - STRLEN len; - if (SvTYPE(hv) != SVt_PVHV) { - DIE("Not a HASH reference"); + HV *hv; + + if (op->op_private & OPpSLICE) { + dMARK; dORIGMARK; + hv = (HV*)POPs; + if (SvTYPE(hv) != SVt_PVHV) + DIE("Not a HASH reference"); + while (++MARK <= SP) { + sv = hv_delete_ent(hv, *MARK, + (op->op_private & OPpLEAVE_VOID ? G_DISCARD : 0), 0); + *MARK = sv ? sv : &sv_undef; + } + if (GIMME != G_ARRAY) { + MARK = ORIGMARK; + *++MARK = *SP; + SP = MARK; + } + } + else { + SV *keysv = POPs; + hv = (HV*)POPs; + if (SvTYPE(hv) != SVt_PVHV) + DIE("Not a HASH reference"); + sv = hv_delete_ent(hv, keysv, + (op->op_private & OPpLEAVE_VOID ? G_DISCARD : 0), 0); + if (!sv) + sv = &sv_undef; + PUSHs(sv); } - sv = hv_delete_ent(hv, tmpsv, - (op->op_private & OPpLEAVE_VOID ? G_DISCARD : 0), 0); - if (!sv) - RETPUSHUNDEF; - PUSHs(sv); RETURN; } @@ -1968,7 +2150,7 @@ PP(pp_lslice) if (ix >= max || !(*lelem = firstrelem[ix])) *lelem = &sv_undef; } - if (!is_something_there && (SvOKp(*lelem) || SvGMAGICAL(*lelem))) + if (!is_something_there && (SvOK(*lelem) || SvGMAGICAL(*lelem))) is_something_there = TRUE; } if (is_something_there) @@ -1980,17 +2162,17 @@ PP(pp_lslice) PP(pp_anonlist) { - dSP; dMARK; + dSP; dMARK; dORIGMARK; I32 items = SP - MARK; - SP = MARK; - XPUSHs((SV*)sv_2mortal((SV*)av_make(items, MARK+1))); + SV *av = sv_2mortal((SV*)av_make(items, MARK+1)); + SP = ORIGMARK; /* av_make() might realloc stack_sp */ + XPUSHs(av); RETURN; } PP(pp_anonhash) { dSP; dMARK; dORIGMARK; - STRLEN len; HV* hv = (HV*)sv_2mortal((SV*)newHV()); while (MARK < SP) { @@ -2073,15 +2255,20 @@ PP(pp_splice) MEXTEND(MARK, length); Copy(AvARRAY(ary)+offset, MARK, length, SV*); if (AvREAL(ary)) { - for (i = length, dst = MARK; i; i--) - sv_2mortal(*dst++); /* free them eventualy */ + EXTEND_MORTAL(length); + for (i = length, dst = MARK; i; i--) { + if (!SvIMMORTAL(*dst)) + sv_2mortal(*dst); /* free them eventualy */ + dst++; + } } MARK += length - 1; } else { *MARK = AvARRAY(ary)[offset+length-1]; if (AvREAL(ary)) { - sv_2mortal(*MARK); + if (!SvIMMORTAL(*MARK)) + sv_2mortal(*MARK); for (i = length - 1, dst = &AvARRAY(ary)[offset]; i > 0; i--) SvREFCNT_dec(*dst++); /* free them now */ } @@ -2167,8 +2354,12 @@ PP(pp_splice) if (length) { Copy(tmparyval, MARK, length, SV*); if (AvREAL(ary)) { - for (i = length, dst = MARK; i; i--) - sv_2mortal(*dst++); /* free them eventualy */ + EXTEND_MORTAL(length); + for (i = length, dst = MARK; i; i--) { + if (!SvIMMORTAL(*dst)) + sv_2mortal(*dst); /* free them eventualy */ + dst++; + } } Safefree(tmparyval); } @@ -2177,7 +2368,8 @@ PP(pp_splice) else if (length--) { *MARK = tmparyval[length]; if (AvREAL(ary)) { - sv_2mortal(*MARK); + if (!SvIMMORTAL(*MARK)) + sv_2mortal(*MARK); while (length-- > 0) SvREFCNT_dec(tmparyval[length]); } @@ -2212,7 +2404,7 @@ PP(pp_pop) dSP; AV *av = (AV*)POPs; SV *sv = av_pop(av); - if (sv != &sv_undef && AvREAL(av)) + if (!SvIMMORTAL(sv) && AvREAL(av)) (void)sv_2mortal(sv); PUSHs(sv); RETURN; @@ -2226,7 +2418,7 @@ PP(pp_shift) EXTEND(SP, 1); if (!sv) RETPUSHUNDEF; - if (sv != &sv_undef && AvREAL(av)) + if (!SvIMMORTAL(sv) && AvREAL(av)) (void)sv_2mortal(sv); PUSHs(sv); RETURN; @@ -2293,12 +2485,42 @@ PP(pp_reverse) RETURN; } +static SV * +mul128(sv, m) + SV *sv; + U8 m; +{ + STRLEN len; + char *s = SvPV(sv, len); + char *t; + U32 i = 0; + + if (!strnEQ(s, "0000", 4)) { /* need to grow sv */ + SV *new = newSVpv("0000000000", 10); + + sv_catsv(new, sv); + SvREFCNT_dec(sv); /* free old sv */ + sv = new; + s = SvPV(sv, len); + } + t = s + len - 1; + while (!*t) /* trailing '\0'? */ + t--; + while (t > s) { + i = ((*t - '0') << 7) + m; + *(t--) = '0' + (i % 10); + m = i / 10; + } + return (sv); +} + /* Explosives and implosives. */ PP(pp_unpack) { dSP; dPOPPOPssrl; + SV **oldsp = sp; SV *sv; STRLEN llen; STRLEN rlen; @@ -2520,12 +2742,13 @@ PP(pp_unpack) } else { EXTEND(SP, len); + EXTEND_MORTAL(len); while (len-- > 0) { aint = *s++; if (aint >= 128) /* fake up signed chars */ aint -= 256; sv = NEWSV(36, 0); - sv_setiv(sv, (I32)aint); + sv_setiv(sv, (IV)aint); PUSHs(sv_2mortal(sv)); } } @@ -2542,10 +2765,11 @@ PP(pp_unpack) } else { EXTEND(SP, len); + EXTEND_MORTAL(len); while (len-- > 0) { auint = *s++ & 255; sv = NEWSV(37, 0); - sv_setiv(sv, (I32)auint); + sv_setiv(sv, (IV)auint); PUSHs(sv_2mortal(sv)); } } @@ -2563,11 +2787,12 @@ PP(pp_unpack) } else { EXTEND(SP, len); + EXTEND_MORTAL(len); while (len-- > 0) { Copy(s, &ashort, 1, I16); s += sizeof(I16); sv = NEWSV(38, 0); - sv_setiv(sv, (I32)ashort); + sv_setiv(sv, (IV)ashort); PUSHs(sv_2mortal(sv)); } } @@ -2595,6 +2820,7 @@ PP(pp_unpack) } else { EXTEND(SP, len); + EXTEND_MORTAL(len); while (len-- > 0) { Copy(s, &aushort, 1, U16); s += sizeof(U16); @@ -2607,7 +2833,7 @@ PP(pp_unpack) if (datumtype == 'v') aushort = vtohs(aushort); #endif - sv_setiv(sv, (I32)aushort); + sv_setiv(sv, (IV)aushort); PUSHs(sv_2mortal(sv)); } } @@ -2628,11 +2854,12 @@ PP(pp_unpack) } else { EXTEND(SP, len); + EXTEND_MORTAL(len); while (len-- > 0) { Copy(s, &aint, 1, int); s += sizeof(int); sv = NEWSV(40, 0); - sv_setiv(sv, (I32)aint); + sv_setiv(sv, (IV)aint); PUSHs(sv_2mortal(sv)); } } @@ -2653,11 +2880,12 @@ PP(pp_unpack) } else { EXTEND(SP, len); + EXTEND_MORTAL(len); while (len-- > 0) { Copy(s, &auint, 1, unsigned int); s += sizeof(unsigned int); sv = NEWSV(41, 0); - sv_setiv(sv, (I32)auint); + sv_setuv(sv, (UV)auint); PUSHs(sv_2mortal(sv)); } } @@ -2678,11 +2906,12 @@ PP(pp_unpack) } else { EXTEND(SP, len); + EXTEND_MORTAL(len); while (len-- > 0) { Copy(s, &along, 1, I32); s += sizeof(I32); sv = NEWSV(42, 0); - sv_setiv(sv, (I32)along); + sv_setiv(sv, (IV)along); PUSHs(sv_2mortal(sv)); } } @@ -2713,10 +2942,10 @@ PP(pp_unpack) } else { EXTEND(SP, len); + EXTEND_MORTAL(len); while (len-- > 0) { Copy(s, &aulong, 1, U32); s += sizeof(U32); - sv = NEWSV(43, 0); #ifdef HAS_NTOHL if (datumtype == 'N') aulong = ntohl(aulong); @@ -2725,7 +2954,8 @@ PP(pp_unpack) if (datumtype == 'V') aulong = vtohl(aulong); #endif - sv_setnv(sv, (double)aulong); + sv = NEWSV(43, 0); + sv_setuv(sv, (UV)aulong); PUSHs(sv_2mortal(sv)); } } @@ -2735,6 +2965,7 @@ PP(pp_unpack) if (len > along) len = along; EXTEND(SP, len); + EXTEND_MORTAL(len); while (len-- > 0) { if (sizeof(char*) > strend - s) break; @@ -2748,6 +2979,50 @@ PP(pp_unpack) PUSHs(sv_2mortal(sv)); } break; + case 'w': + EXTEND(SP, len); + EXTEND_MORTAL(len); + { + UV auv = 0; + U32 bytes = 0; + + while ((len > 0) && (s < strend)) { + auv = (auv << 7) | (*s & 0x7f); + if (!(*s++ & 0x80)) { + bytes = 0; + sv = NEWSV(40, 0); + sv_setuv(sv, auv); + PUSHs(sv_2mortal(sv)); + len--; + auv = 0; + } + else if (++bytes >= sizeof(UV)) { /* promote to string */ + char decn[sizeof(UV) * 3 + 1]; + char *t; + + (void) sprintf(decn, "%0*ld", + (int)sizeof(decn) - 1, auv); + sv = newSVpv(decn, 0); + while (s < strend) { + sv = mul128(sv, *s & 0x7f); + if (!(*s++ & 0x80)) { + bytes = 0; + break; + } + } + t = SvPV(sv, na); + while (*t == '0') + t++; + sv_chop(sv, t); + PUSHs(sv_2mortal(sv)); + len--; + auv = 0; + } + } + if ((s >= strend) && bytes) + croak("Unterminated compressed integer"); + } + break; case 'P': EXTEND(SP, 1); if (sizeof(char*) > strend - s) @@ -2764,6 +3039,7 @@ PP(pp_unpack) #ifdef HAS_QUAD case 'q': EXTEND(SP, len); + EXTEND_MORTAL(len); while (len-- > 0) { if (s + sizeof(Quad_t) > strend) aquad = 0; @@ -2778,6 +3054,7 @@ PP(pp_unpack) break; case 'Q': EXTEND(SP, len); + EXTEND_MORTAL(len); while (len-- > 0) { if (s + sizeof(unsigned Quad_t) > strend) auquad = 0; @@ -2786,7 +3063,7 @@ PP(pp_unpack) s += sizeof(unsigned Quad_t); } sv = NEWSV(43, 0); - sv_setiv(sv, (IV)auquad); + sv_setuv(sv, (UV)auquad); PUSHs(sv_2mortal(sv)); } break; @@ -2806,6 +3083,7 @@ PP(pp_unpack) } else { EXTEND(SP, len); + EXTEND_MORTAL(len); while (len-- > 0) { Copy(s, &afloat, 1, float); s += sizeof(float); @@ -2829,6 +3107,7 @@ PP(pp_unpack) } else { EXTEND(SP, len); + EXTEND_MORTAL(len); while (len-- > 0) { Copy(s, &adouble, 1, double); s += sizeof(double); @@ -2914,6 +3193,8 @@ PP(pp_unpack) checksum = 0; } } + if (sp == oldsp && GIMME != G_ARRAY) + PUSHs(&sv_undef); RETURN; } @@ -2944,6 +3225,85 @@ register I32 len; sv_catpvn(sv, "\n", 1); } +static SV * +is_an_int(s, l) + char *s; + STRLEN l; +{ + SV *result = newSVpv("", l); + char *result_c = SvPV(result, na); /* convenience */ + char *out = result_c; + bool skip = 1; + bool ignore = 0; + + while (*s) { + switch (*s) { + case ' ': + break; + case '+': + if (!skip) { + SvREFCNT_dec(result); + return (NULL); + } + break; + case '0': + case '1': + case '2': + case '3': + case '4': + case '5': + case '6': + case '7': + case '8': + case '9': + skip = 0; + if (!ignore) { + *(out++) = *s; + } + break; + case '.': + ignore = 1; + break; + default: + SvREFCNT_dec(result); + return (NULL); + } + s++; + } + *(out++) = '\0'; + SvCUR_set(result, out - result_c); + return (result); +} + +static int +div128(pnum, done) + SV *pnum; /* must be '\0' terminated */ + bool *done; +{ + STRLEN len; + char *s = SvPV(pnum, len); + int m = 0; + int r = 0; + char *t = s; + + *done = 1; + while (*t) { + int i; + + i = m * 10 + (*t - '0'); + m = i & 0x7F; + r = (i >> 7); /* r < 10 */ + if (r) { + *done = 0; + } + *(t++) = '0' + r; + } + *(t++) = '\0'; + SvCUR_set(pnum, (STRLEN) (t - s)); + return (m); +} + + PP(pp_pack) { dSP; dMARK; dORIGMARK; dTARGET; @@ -3223,6 +3583,65 @@ PP(pp_pack) sv_catpvn(cat, (char*)&auint, sizeof(unsigned int)); } break; + case 'w': + while (len-- > 0) { + fromstr = NEXTFROM; + adouble = floor(SvNV(fromstr)); + + if (adouble < 0) + croak("Cannot compress negative numbers"); + + if (adouble <= UV_MAX) { + char buf[1 + sizeof(UV)]; + char *in = buf + sizeof(buf); + UV auv = U_V(adouble);; + + do { + *--in = (auv & 0x7f) | 0x80; + auv >>= 7; + } while (auv); + buf[sizeof(buf) - 1] &= 0x7f; /* clear continue bit */ + sv_catpvn(cat, in, (buf + sizeof(buf)) - in); + } + else if (SvPOKp(fromstr)) { /* decimal string arithmetics */ + char *from, *result, *in; + SV *norm; + STRLEN len; + bool done; + + /* Copy string and check for compliance */ + from = SvPV(fromstr, len); + if ((norm = is_an_int(from, len)) == NULL) + croak("can compress only unsigned integer"); + + New('w', result, len, char); + in = result + len; + done = FALSE; + while (!done) + *--in = div128(norm, &done) | 0x80; + result[len - 1] &= 0x7F; /* clear continue bit */ + sv_catpvn(cat, in, (result + len) - in); + Safefree(result); + SvREFCNT_dec(norm); /* free norm */ + } + else if (SvNOKp(fromstr)) { + char buf[sizeof(double) * 2]; /* 8/7 <= 2 */ + char *in = buf + sizeof(buf); + + do { + double next = floor(adouble / 128); + *--in = (unsigned char)(adouble - (next * 128)) | 0x80; + if (--in < buf) /* this cannot happen ;-) */ + croak ("Cannot compress integer"); + adouble = next; + } while (adouble > 0); + buf[sizeof(buf) - 1] &= 0x7f; /* clear continue bit */ + sv_catpvn(cat, in, (buf + sizeof(buf)) - in); + } + else + croak("Cannot compress non integer"); + } + break; case 'i': while (len-- > 0) { fromstr = NEXTFROM; @@ -3328,7 +3747,8 @@ PP(pp_split) STRLEN len; register char *s = SvPV(sv, len); char *strend = s + len; - register PMOP *pm = (PMOP*)POPs; + register PMOP *pm; + register REGEXP *rx; register SV *dstr; register char *m; I32 iters = 0; @@ -3339,12 +3759,21 @@ PP(pp_split) I32 realarray = 0; I32 base; AV *oldstack = curstack; - register REGEXP *rx = pm->op_pmregexp; I32 gimme = GIMME; I32 oldsave = savestack_ix; +#ifdef DEBUGGING + Copy(&LvTARGOFF(POPs), &pm, 1, PMOP*); +#else + pm = (PMOP*)POPs; +#endif if (!pm || !s) DIE("panic: do_split"); + rx = pm->op_pmregexp; + + TAINT_IF((pm->op_pmflags & PMf_LOCALE) && + (pm->op_pmflags & (PMf_WHITE | PMf_SKIPWHITE))); + if (pm->op_pmreplroot) ary = GvAVn((GV*)pm->op_pmreplroot); else if (gimme != G_ARRAY) @@ -3366,8 +3795,14 @@ PP(pp_split) base = SP - stack_base; orig = s; if (pm->op_pmflags & PMf_SKIPWHITE) { - while (isSPACE(*s)) - s++; + if (pm->op_pmflags & PMf_LOCALE) { + while (isSPACE_LC(*s)) + s++; + } + else { + while (isSPACE(*s)) + s++; + } } if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) { SAVEINT(multiline); @@ -3378,17 +3813,25 @@ PP(pp_split) limit = maxiters + 2; if (pm->op_pmflags & PMf_WHITE) { while (--limit) { - /*SUPPRESS 530*/ - for (m = s; m < strend && !isSPACE(*m); m++) ; + m = s; + while (m < strend && + !((pm->op_pmflags & PMf_LOCALE) + ? isSPACE_LC(*m) : isSPACE(*m))) + ++m; if (m >= strend) break; + dstr = NEWSV(30, m-s); sv_setpvn(dstr, s, m-s); if (!realarray) sv_2mortal(dstr); XPUSHs(dstr); - /*SUPPRESS 530*/ - for (s = m + 1; s < strend && isSPACE(*s); s++) ; + + s = m + 1; + while (s < strend && + ((pm->op_pmflags & PMf_LOCALE) + ? isSPACE_LC(*s) : isSPACE(*s))) + ++s; } } else if (strEQ("^", rx->precomp)) { @@ -3406,23 +3849,13 @@ PP(pp_split) s = m; } } - else if (pm->op_pmshort) { + else if (pm->op_pmshort && !rx->nparens) { i = SvCUR(pm->op_pmshort); if (i == 1) { - I32 fold = (pm->op_pmflags & PMf_FOLD); i = *SvPVX(pm->op_pmshort); - if (fold && isUPPER(i)) - i = toLOWER(i); while (--limit) { - if (fold) { - for ( m = s; - m < strend && *m != i && - (!isUPPER(*m) || toLOWER(*m) != i); - m++) /*SUPPRESS 530*/ - ; - } - else /*SUPPRESS 530*/ - for (m = s; m < strend && *m != i; m++) ; + /*SUPPRESS 530*/ + for (m = s; m < strend && *m != i; m++) ; if (m >= strend) break; dstr = NEWSV(30, m-s); @@ -3452,7 +3885,9 @@ PP(pp_split) else { maxiters += (strend - s) * rx->nparens; while (s < strend && --limit && - pregexec(rx, s, strend, orig, 1, Nullsv, TRUE) ) { + pregexec(rx, s, strend, orig, 1, Nullsv, TRUE)) + { + TAINT_IF(rx->exec_tainted); if (rx->subbase && rx->subbase != orig) { m = s; @@ -3500,7 +3935,7 @@ PP(pp_split) iters++; } else if (!origlimit) { - while (iters > 0 && SvCUR(TOPs) == 0) + while (iters > 0 && (!TOPs || !SvANY(TOPs) || SvCUR(TOPs) == 0)) iters--, SP--; } if (realarray) {