/* pp.c
*
- * Copyright (c) 1991-2000, Larry Wall
+ * Copyright (c) 1991-2001, 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.
if (PL_op->op_flags & OPf_REF) {
PUSHs(TARG);
RETURN;
+ } else if (LVRET) {
+ if (GIMME == G_SCALAR)
+ Perl_croak(aTHX_ "Can't return array to lvalue scalar context");
+ PUSHs(TARG);
+ RETURN;
}
if (GIMME == G_ARRAY) {
I32 maxarg = AvFILL((AV*)TARG) + 1;
SAVECLEARSV(PL_curpad[PL_op->op_targ]);
if (PL_op->op_flags & OPf_REF)
RETURN;
+ else if (LVRET) {
+ if (GIMME == G_SCALAR)
+ Perl_croak(aTHX_ "Can't return hash to lvalue scalar context");
+ RETURN;
+ }
gimme = GIMME_V;
if (gimme == G_ARRAY) {
RETURNOP(do_kv());
{
djSP; dTARGET; dPOPss;
- if (PL_op->op_flags & OPf_MOD) {
+ if (PL_op->op_flags & OPf_MOD || LVRET) {
if (SvTYPE(TARG) < SVt_PVLV) {
sv_upgrade(TARG, SVt_PVLV);
sv_magic(TARG, Nullsv, '.', Nullch, 0);
if (cv) {
if (CvCLONE(cv))
cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
- if ((PL_op->op_private & OPpLVAL_INTRO) && !CvLVALUE(cv))
- DIE(aTHX_ "Can't modify non-lvalue subroutine call");
+ if ((PL_op->op_private & OPpLVAL_INTRO)) {
+ if (gv && GvCV(gv) == cv && (gv = gv_autoload4(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), FALSE)))
+ cv = GvCV(gv);
+ if (!CvLVALUE(cv))
+ DIE(aTHX_ "Can't modify non-lvalue subroutine call");
+ }
}
else
cv = (CV*)&PL_sv_undef;
else { /* Note: mark already snarfed by pp_list */
SV *tmpstr = POPs;
STRLEN len;
- bool isutf = DO_UTF8(tmpstr);
+ bool isutf;
SvSetSV(TARG, tmpstr);
SvPV_force(TARG, len);
+ isutf = DO_UTF8(TARG);
if (count != 1) {
if (count < 1)
SvCUR_set(TARG, 0);
if (SvIOK(TOPm1s)) {
bool auvok = SvUOK(TOPm1s);
bool buvok = SvUOK(TOPs);
-
+
if (!auvok && !buvok) { /* ## IV - IV ## */
IV aiv = SvIVX(TOPm1s);
IV biv = SvIVX(TOPs);
UV auv = SvUVX(TOPm1s);
UV buv = SvUVX(TOPs);
IV result;
-
+
if (auv >= buv) {
SP--;
SETu( auv - buv );
if (SvIOK(TOPm1s)) {
bool auvok = SvUOK(TOPm1s);
bool buvok = SvUOK(TOPs);
-
+
if (!auvok && !buvok) { /* ## IV < IV ## */
IV aiv = SvIVX(TOPm1s);
IV biv = SvIVX(TOPs);
if (SvIOK(TOPm1s)) {
bool auvok = SvUOK(TOPm1s);
bool buvok = SvUOK(TOPs);
-
+
if (!auvok && !buvok) { /* ## IV > IV ## */
IV aiv = SvIVX(TOPm1s);
IV biv = SvIVX(TOPs);
if (SvIOK(TOPm1s)) {
bool auvok = SvUOK(TOPm1s);
bool buvok = SvUOK(TOPs);
-
+
if (!auvok && !buvok) { /* ## IV <= IV ## */
IV aiv = SvIVX(TOPm1s);
IV biv = SvIVX(TOPs);
if (SvIOK(TOPm1s)) {
bool auvok = SvUOK(TOPm1s);
bool buvok = SvUOK(TOPs);
-
+
if (!auvok && !buvok) { /* ## IV >= IV ## */
IV aiv = SvIVX(TOPm1s);
IV biv = SvIVX(TOPs);
if (SvIOK(TOPm1s)) {
bool auvok = SvUOK(TOPm1s);
bool buvok = SvUOK(TOPs);
-
+
if (!auvok && !buvok) { /* ## IV <=> IV ## */
IV aiv = SvIVX(TOPm1s);
IV biv = SvIVX(TOPs);
sv_setsv(TARG, sv);
*SvPV_force(TARG, len) = *s == '-' ? '+' : '-';
}
- else if (DO_UTF8(sv) && *(U8*)s >= 0xc0 && isIDFIRST_utf8((U8*)s)) {
+ else if (DO_UTF8(sv) && UTF8_IS_START(*s) && isIDFIRST_utf8((U8*)s)) {
sv_setpvn(TARG, "-", 1);
sv_catsv(TARG, sv);
}
{
/* This will cache the NV value if string isn't actually integer */
IV iv = TOPi;
-
+
if (SvIOK(TOPs)) {
/* IVX is precise */
if (SvIsUV(TOPs)) {
IV_MIN and -IV_MIN should both be %100...00 and NV-able */
SETu(IV_MIN);
}
- }
+ }
}
} else{
NV value = TOPn;
I32 pos;
I32 rem;
I32 fail;
- I32 lvalue = PL_op->op_flags & OPf_MOD;
+ I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
char *tmps;
I32 arybase = PL_curcop->cop_arybase;
char *repl = 0;
STRLEN repl_len;
+ int num_args = PL_op->op_private & 7;
SvTAINTED_off(TARG); /* decontaminate */
SvUTF8_off(TARG); /* decontaminate */
- if (MAXARG > 2) {
- if (MAXARG > 3) {
+ if (num_args > 2) {
+ if (num_args > 3) {
sv = POPs;
repl = SvPV(sv, repl_len);
}
pos -= arybase;
rem = curlen-pos;
fail = rem;
- if (MAXARG > 2) {
+ if (num_args > 2) {
if (len < 0) {
rem += len;
if (rem < 0)
}
else {
pos += curlen;
- if (MAXARG < 3)
+ if (num_args < 3)
rem = curlen;
else if (len >= 0) {
rem = pos+len;
RETPUSHUNDEF;
}
else {
+ I32 upos = pos;
+ I32 urem = rem;
if (utfcurlen)
sv_pos_u2b(sv, &pos, &rem);
tmps += pos;
SvREFCNT_dec(LvTARG(TARG));
LvTARG(TARG) = SvREFCNT_inc(sv);
}
- LvTARGOFF(TARG) = pos;
- LvTARGLEN(TARG) = rem;
+ LvTARGOFF(TARG) = upos;
+ LvTARGLEN(TARG) = urem;
}
}
SPAGAIN;
register IV size = POPi;
register IV offset = POPi;
register SV *src = POPs;
- I32 lvalue = PL_op->op_flags & OPf_MOD;
+ I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
SvTAINTED_off(TARG); /* decontaminate */
if (lvalue) { /* it's an lvalue! */
PP(pp_ord)
{
djSP; dTARGET;
- UV value;
- SV *tmpsv = POPs;
+ SV *argsv = POPs;
STRLEN len;
- U8 *tmps = (U8*)SvPVx(tmpsv, len);
- STRLEN retlen;
+ U8 *s = (U8*)SvPVx(argsv, len);
- if ((*tmps & 0x80) && DO_UTF8(tmpsv))
- value = utf8_to_uv(tmps, len, &retlen, 0);
- else
- value = (UV)(*tmps & 255);
- XPUSHu(value);
+ XPUSHu(DO_UTF8(argsv) ? utf8_to_uv_simple(s, 0) : (*s & 0xff));
RETURN;
}
(void)SvUPGRADE(TARG,SVt_PV);
- if ((value > 255 && !IN_BYTE) || (value & 0x80 && PL_hints & HINT_UTF8) ) {
- SvGROW(TARG, UTF8_MAXLEN+1);
- tmps = SvPVX(TARG);
- tmps = (char*)uv_to_utf8((U8*)tmps, (UV)value);
+ if (value > 255 && !IN_BYTE) {
+ SvGROW(TARG, UNISKIP(value)+1);
+ tmps = (char*)uv_to_utf8((U8*)SvPVX(TARG), value);
SvCUR_set(TARG, tmps - SvPVX(TARG));
*tmps = '\0';
(void)SvPOK_only(TARG);
register U8 *s;
STRLEN slen;
- if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && (*s & 0xc0) == 0xc0) {
+ if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && UTF8_IS_START(*s)) {
STRLEN ulen;
U8 tmpbuf[UTF8_MAXLEN+1];
U8 *tend;
register U8 *s;
STRLEN slen;
- if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && (*s & 0xc0) == 0xc0) {
+ if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && UTF8_IS_START(*s)) {
STRLEN ulen;
U8 tmpbuf[UTF8_MAXLEN+1];
U8 *tend;
d = SvPVX(TARG);
if (DO_UTF8(sv)) {
while (len) {
- if (*s & 0x80) {
+ if (UTF8_IS_CONTINUED(*s)) {
STRLEN ulen = UTF8SKIP(s);
if (ulen > len)
ulen = len;
djSP; dMARK; dORIGMARK;
register SV** svp;
register AV* av = (AV*)POPs;
- register I32 lval = PL_op->op_flags & OPf_MOD;
+ register I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
I32 arybase = PL_curcop->cop_arybase;
I32 elem;
{
djSP; dMARK; dORIGMARK;
register HV *hv = (HV*)POPs;
- register I32 lval = PL_op->op_flags & OPf_MOD;
+ register I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
I32 realhv = (SvTYPE(hv) == SVt_PVHV);
if (!realhv && PL_op->op_private & OPpLVAL_INTRO)
DIE(aTHX_ PL_no_helem, SvPV(keysv, n_a));
}
if (PL_op->op_private & OPpLVAL_INTRO) {
- if (preeminent)
+ if (preeminent)
save_helem(hv, keysv, svp);
else {
STRLEN keylen;
char *key = SvPV(keysv, keylen);
- save_delete(hv, key, keylen);
+ SAVEDELETE(hv, savepvn(key,keylen), keylen);
}
}
}
U8* s = (U8*)SvPVX(TARG);
U8* send = (U8*)(s + len);
while (s < send) {
- if (*s < 0x80) {
+ if (UTF8_IS_ASCII(*s)) {
s++;
continue;
}
else {
+ if (!utf8_to_uv_simple(s, 0))
+ break;
up = (char*)s;
s += UTF8SKIP(s);
down = (char*)(s - 1);
- if (s > send || !((*down & 0xc0) == 0x80)) {
- if (ckWARN_d(WARN_UTF8))
- Perl_warner(aTHX_ WARN_UTF8,
- "Malformed UTF-8 character");
- break;
- }
+ /* reverse this character */
while (down > up) {
tmp = *up;
*up++ = *down;
while ((len > 0) && (s < strend)) {
auv = (auv << 7) | (*s & 0x7f);
- if (!(*s++ & 0x80)) {
+ if (UTF8_IS_ASCII(*s++)) {
bytes = 0;
sv = NEWSV(40, 0);
sv_setuv(sv, auv);
AV *ary;
register IV limit = POPi; /* note, negative is forever */
SV *sv = POPs;
- bool doutf8 = DO_UTF8(sv);
STRLEN len;
register char *s = SvPV(sv, len);
+ bool do_utf8 = DO_UTF8(sv);
char *strend = s + len;
register PMOP *pm;
register REGEXP *rx;
register SV *dstr;
register char *m;
I32 iters = 0;
- I32 maxiters = (strend - s) + 10;
+ STRLEN slen = do_utf8 ? utf8_length((U8*)s, (U8*)strend) : (strend - s);
+ I32 maxiters = slen + 10;
I32 i;
char *orig;
I32 origlimit = limit;
pm = (PMOP*)POPs;
#endif
if (!pm || !s)
- DIE(aTHX_ "panic: do_split");
+ DIE(aTHX_ "panic: pp_split");
rx = pm->op_pmregexp;
TAINT_IF((pm->op_pmflags & PMf_LOCALE) &&
sv_setpvn(dstr, s, m-s);
if (make_mortal)
sv_2mortal(dstr);
- if (doutf8)
+ if (do_utf8)
(void)SvUTF8_on(dstr);
XPUSHs(dstr);
sv_setpvn(dstr, s, m-s);
if (make_mortal)
sv_2mortal(dstr);
- if (doutf8)
+ if (do_utf8)
(void)SvUTF8_on(dstr);
XPUSHs(dstr);
s = m;
}
}
- else if ((rx->reganch & RE_USE_INTUIT) && !rx->nparens
+ else if (do_utf8 == ((rx->reganch & ROPT_UTF8) != 0) &&
+ (rx->reganch & RE_USE_INTUIT) && !rx->nparens
&& (rx->reganch & ROPT_CHECK_ALL)
&& !(rx->reganch & ROPT_ANCH)) {
int tail = (rx->reganch & RE_INTUIT_TAIL);
SV *csv = CALLREG_INTUIT_STRING(aTHX_ rx);
len = rx->minlen;
- if (len == 1 && !tail) {
+ if (len == 1 && !(rx->reganch & ROPT_UTF8) && !tail) {
STRLEN n_a;
char c = *SvPV(csv, n_a);
while (--limit) {
sv_setpvn(dstr, s, m-s);
if (make_mortal)
sv_2mortal(dstr);
- if (doutf8)
+ if (do_utf8)
(void)SvUTF8_on(dstr);
XPUSHs(dstr);
/* The rx->minlen is in characters but we want to step
* s ahead by bytes. */
- s = m + (doutf8 ? SvCUR(csv) : len);
+ if (do_utf8)
+ s = (char*)utf8_hop((U8*)m, len);
+ else
+ s = m + len; /* Fake \n at the end */
}
}
else {
sv_setpvn(dstr, s, m-s);
if (make_mortal)
sv_2mortal(dstr);
- if (doutf8)
+ if (do_utf8)
(void)SvUTF8_on(dstr);
XPUSHs(dstr);
/* The rx->minlen is in characters but we want to step
* s ahead by bytes. */
- s = m + (doutf8 ? SvCUR(csv) : len); /* Fake \n at the end */
+ if (do_utf8)
+ s = (char*)utf8_hop((U8*)m, len);
+ else
+ s = m + len; /* Fake \n at the end */
}
}
}
else {
- maxiters += (strend - s) * rx->nparens;
+ maxiters += slen * rx->nparens;
while (s < strend && --limit
/* && (!rx->check_substr
|| ((s = CALLREG_INTUIT_START(aTHX_ rx, sv, s, strend,
sv_setpvn(dstr, s, m-s);
if (make_mortal)
sv_2mortal(dstr);
- if (doutf8)
+ if (do_utf8)
(void)SvUTF8_on(dstr);
XPUSHs(dstr);
if (rx->nparens) {
dstr = NEWSV(33, 0);
if (make_mortal)
sv_2mortal(dstr);
- if (doutf8)
+ if (do_utf8)
(void)SvUTF8_on(dstr);
XPUSHs(dstr);
}
sv_setpvn(dstr, s, l);
if (make_mortal)
sv_2mortal(dstr);
- if (doutf8)
+ if (do_utf8)
(void)SvUTF8_on(dstr);
XPUSHs(dstr);
iters++;
projects / p5sagit/p5-mst-13.2.git / blobdiff