#ifdef I_UNISTD
#include <unistd.h>
#endif
-#ifdef I_FCNTL
-#include <fcntl.h>
-#endif
-#ifdef I_SYS_FILE
-#include <sys/file.h>
-#endif
-
/* Hot code. */
char *s;
s = SvPV(TOPs,len);
sv_setpvn(TARG,s,len);
+ if (SvUTF8(TOPs) && !IN_BYTE)
+ SvUTF8_on(TARG);
SETTARG;
RETURN;
}
PP(pp_sassign)
{
djSP; dPOPTOPssrl;
- MAGIC *mg;
if (PL_op->op_private & OPpASSIGN_BACKWARDS) {
SV *temp;
s = SvPV(right,len);
if (SvOK(TARG)) {
#if defined(PERL_Y2KWARN)
- if ((SvIOK(right) || SvNOK(right)) && ckWARN(WARN_MISC)) {
+ if ((SvIOK(right) || SvNOK(right)) && ckWARN(WARN_Y2K)) {
STRLEN n;
char *s = SvPV(TARG,n);
if (n >= 2 && s[n-2] == '1' && s[n-1] == '9'
&& (n == 2 || !isDIGIT(s[n-3])))
{
- Perl_warner(aTHX_ WARN_MISC, "Possible Y2K bug: %s",
+ Perl_warner(aTHX_ WARN_Y2K, "Possible Y2K bug: %s",
"about to append an integer to '19'");
}
}
#endif
+ if (DO_UTF8(right))
+ sv_utf8_upgrade(TARG);
sv_catpvn(TARG,s,len);
+ if (!IN_BYTE) {
+ if (SvUTF8(right))
+ SvUTF8_on(TARG);
+ }
+ else if (!SvUTF8(right)) {
+ SvUTF8_off(TARG);
+ }
}
else
sv_setpvn(TARG,s,len); /* suppress warning */
gv = (GV*)*++MARK;
else
gv = PL_defoutgv;
- if (mg = SvTIED_mg((SV*)gv, 'q')) {
+ if ((mg = SvTIED_mg((SV*)gv, 'q'))) {
if (MARK == ORIGMARK) {
/* If using default handle then we need to make space to
* pass object as 1st arg, so move other args up ...
}
}
+STATIC int
+S_do_maybe_phash(pTHX_ AV *ary, SV **lelem, SV **firstlelem, SV **relem,
+ SV **lastrelem)
+{
+ OP *leftop;
+ I32 i;
+
+ leftop = ((BINOP*)PL_op)->op_last;
+ assert(leftop);
+ assert(leftop->op_type == OP_NULL && leftop->op_targ == OP_LIST);
+ leftop = ((LISTOP*)leftop)->op_first;
+ assert(leftop);
+ /* Skip PUSHMARK and each element already assigned to. */
+ for (i = lelem - firstlelem; i > 0; i--) {
+ leftop = leftop->op_sibling;
+ assert(leftop);
+ }
+ if (leftop->op_type != OP_RV2HV)
+ return 0;
+
+ /* pseudohash */
+ if (av_len(ary) > 0)
+ av_fill(ary, 0); /* clear all but the fields hash */
+ if (lastrelem >= relem) {
+ while (relem < lastrelem) { /* gobble up all the rest */
+ SV *tmpstr;
+ assert(relem[0]);
+ assert(relem[1]);
+ /* Avoid a memory leak when avhv_store_ent dies. */
+ tmpstr = sv_newmortal();
+ sv_setsv(tmpstr,relem[1]); /* value */
+ relem[1] = tmpstr;
+ if (avhv_store_ent(ary,relem[0],tmpstr,0))
+ (void)SvREFCNT_inc(tmpstr);
+ if (SvMAGICAL(ary) != 0 && SvSMAGICAL(tmpstr))
+ mg_set(tmpstr);
+ relem += 2;
+ TAINT_NOT;
+ }
+ }
+ if (relem == lastrelem)
+ return 1;
+ return 2;
+}
+
+STATIC void
+S_do_oddball(pTHX_ HV *hash, SV **relem, SV **firstrelem)
+{
+ if (*relem) {
+ SV *tmpstr;
+ if (ckWARN(WARN_MISC)) {
+ if (relem == firstrelem &&
+ SvROK(*relem) &&
+ (SvTYPE(SvRV(*relem)) == SVt_PVAV ||
+ SvTYPE(SvRV(*relem)) == SVt_PVHV))
+ {
+ Perl_warner(aTHX_ WARN_MISC,
+ "Reference found where even-sized list expected");
+ }
+ else
+ Perl_warner(aTHX_ WARN_MISC,
+ "Odd number of elements in hash assignment");
+ }
+ if (SvTYPE(hash) == SVt_PVAV) {
+ /* pseudohash */
+ tmpstr = sv_newmortal();
+ if (avhv_store_ent((AV*)hash,*relem,tmpstr,0))
+ (void)SvREFCNT_inc(tmpstr);
+ if (SvMAGICAL(hash) && SvSMAGICAL(tmpstr))
+ mg_set(tmpstr);
+ }
+ else {
+ HE *didstore;
+ tmpstr = NEWSV(29,0);
+ didstore = hv_store_ent(hash,*relem,tmpstr,0);
+ if (SvMAGICAL(hash)) {
+ if (SvSMAGICAL(tmpstr))
+ mg_set(tmpstr);
+ if (!didstore)
+ sv_2mortal(tmpstr);
+ }
+ }
+ TAINT_NOT;
+ }
+}
+
PP(pp_aassign)
{
djSP;
* special care that assigning the identifier on the left doesn't
* clobber a value on the right that's used later in the list.
*/
- if (PL_op->op_private & OPpASSIGN_COMMON) {
+ if (PL_op->op_private & (OPpASSIGN_COMMON)) {
EXTEND_MORTAL(lastrelem - firstrelem + 1);
- for (relem = firstrelem; relem <= lastrelem; relem++) {
- /*SUPPRESS 560*/
- if (sv = *relem) {
+ for (relem = firstrelem; relem <= lastrelem; relem++) {
+ /*SUPPRESS 560*/
+ if ((sv = *relem)) {
TAINT_NOT; /* Each item is independent */
- *relem = sv_mortalcopy(sv);
+ *relem = sv_mortalcopy(sv);
}
- }
+ }
}
relem = firstrelem;
lelem = firstlelem;
ary = Null(AV*);
hash = Null(HV*);
+
while (lelem <= lastlelem) {
TAINT_NOT; /* Each item stands on its own, taintwise. */
sv = *lelem++;
case SVt_PVAV:
ary = (AV*)sv;
magic = SvMAGICAL(ary) != 0;
-
+ if (PL_op->op_private & OPpASSIGN_HASH) {
+ switch (do_maybe_phash(ary, lelem, firstlelem, relem,
+ lastrelem))
+ {
+ case 0:
+ goto normal_array;
+ case 1:
+ do_oddball((HV*)ary, relem, firstrelem);
+ }
+ relem = lastrelem + 1;
+ break;
+ }
+ normal_array:
av_clear(ary);
av_extend(ary, lastrelem - relem);
i = 0;
TAINT_NOT;
}
break;
- case SVt_PVHV: {
+ case SVt_PVHV: { /* normal hash */
SV *tmpstr;
hash = (HV*)sv;
TAINT_NOT;
}
if (relem == lastrelem) {
- if (*relem) {
- HE *didstore;
- if (ckWARN(WARN_UNSAFE)) {
- if (relem == firstrelem &&
- SvROK(*relem) &&
- ( SvTYPE(SvRV(*relem)) == SVt_PVAV ||
- SvTYPE(SvRV(*relem)) == SVt_PVHV ) )
- Perl_warner(aTHX_ WARN_UNSAFE, "Reference found where even-sized list expected");
- else
- Perl_warner(aTHX_ WARN_UNSAFE, "Odd number of elements in hash assignment");
- }
- tmpstr = NEWSV(29,0);
- didstore = hv_store_ent(hash,*relem,tmpstr,0);
- if (magic) {
- if (SvSMAGICAL(tmpstr))
- mg_set(tmpstr);
- if (!didstore)
- sv_2mortal(tmpstr);
- }
- TAINT_NOT;
- }
+ do_oddball(hash, relem, firstrelem);
relem++;
}
}
truebase = t = s;
/* XXXX What part of this is needed with true \G-support? */
- if (global = pm->op_pmflags & PMf_GLOBAL) {
+ if ((global = pm->op_pmflags & PMf_GLOBAL)) {
rx->startp[0] = -1;
if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
MAGIC* mg = mg_find(TARG, 'g');
I32 gimme = GIMME_V;
MAGIC *mg;
- if (mg = SvTIED_mg((SV*)PL_last_in_gv, 'q')) {
+ if ((mg = SvTIED_mg((SV*)PL_last_in_gv, 'q'))) {
PUSHMARK(SP);
XPUSHs(SvTIED_obj((SV*)PL_last_in_gv, mg));
PUTBACK;
}
}
if (!fp) {
- if (ckWARN(WARN_CLOSED) && io && !(IoFLAGS(io) & IOf_START)) {
+ if (ckWARN2(WARN_GLOB,WARN_CLOSED) && io && !(IoFLAGS(io) & IOf_START)) {
if (type == OP_GLOB)
- Perl_warner(aTHX_ WARN_CLOSED,
+ Perl_warner(aTHX_ WARN_GLOB,
"glob failed (can't start child: %s)",
Strerror(errno));
else
(void)do_close(PL_last_in_gv, FALSE);
}
else if (type == OP_GLOB) {
- if (!do_close(PL_last_in_gv, FALSE) && ckWARN(WARN_CLOSED)) {
- Perl_warner(aTHX_ WARN_CLOSED,
+ if (!do_close(PL_last_in_gv, FALSE) && ckWARN(WARN_GLOB)) {
+ Perl_warner(aTHX_ WARN_GLOB,
"glob failed (child exited with status %d%s)",
(int)(STATUS_CURRENT >> 8),
(STATUS_CURRENT & 0x80) ? ", core dumped" : "");
SvREFCNT_dec(*itersvp);
- if (sv = (SvMAGICAL(av))
- ? *av_fetch(av, ++cx->blk_loop.iterix, FALSE)
- : AvARRAY(av)[++cx->blk_loop.iterix])
+ if ((sv = SvMAGICAL(av)
+ ? *av_fetch(av, ++cx->blk_loop.iterix, FALSE)
+ : AvARRAY(av)[++cx->blk_loop.iterix]))
SvTEMP_off(sv);
else
sv = &PL_sv_undef;
STRLEN len;
int force_on_match = 0;
I32 oldsave = PL_savestack_ix;
- I32 update_minmatch = 1;
/* known replacement string? */
dstr = (pm->op_pmflags & PMf_CONST) ? POPs : Nullsv;
SvCUR_set(TARG, m - s);
}
/*SUPPRESS 560*/
- else if (i = m - s) { /* faster from front */
+ else if ((i = m - s)) { /* faster from front */
d -= clen;
m = d;
sv_chop(TARG, d-i);
rxtainted |= RX_MATCH_TAINTED(rx);
m = rx->startp[0] + orig;
/*SUPPRESS 560*/
- if (i = m - s) {
+ if ((i = m - s)) {
if (s != d)
Move(s, d, i, char);
d += i;
sv_2mortal(*MARK);
}
else {
+ sv = SvREFCNT_inc(TOPs); /* FREETMPS could clobber it */
FREETMPS;
- *MARK = sv_mortalcopy(TOPs);
+ *MARK = sv_mortalcopy(sv);
+ SvREFCNT_dec(sv);
}
}
else
: "an uninitialized value");
}
else {
- mortalize:
/* Can be a localized value subject to deletion. */
PL_tmps_stack[++PL_tmps_ix] = *mark;
(void)SvREFCNT_inc(*mark);
sv_2mortal(*MARK);
}
else {
+ sv = SvREFCNT_inc(TOPs); /* FREETMPS could clobber it */
FREETMPS;
- *MARK = sv_mortalcopy(TOPs);
+ *MARK = sv_mortalcopy(sv);
+ SvREFCNT_dec(sv);
}
}
else
}
}
else {
- SvUPGRADE(dbsv, SVt_PVIV);
- SvIOK_on(dbsv);
+ (void)SvUPGRADE(dbsv, SVt_PVIV);
+ (void)SvIOK_on(dbsv);
SAVEIV(SvIVX(dbsv));
SvIVX(dbsv) = PTR2IV(cv); /* Do it the quickest way */
}
STATIC SV *
S_method_common(pTHX_ SV* meth, U32* hashp)
{
- djSP;
SV* sv;
SV* ob;
GV* gv;
*(PL_stack_base + TOPMARK + 1) = sv_2mortal(newRV((SV*)iogv));
}
- if (!ob || !SvOBJECT(ob))
+ if (!ob || !(SvOBJECT(ob)
+ || (SvTYPE(ob) == SVt_PVGV && (ob = (SV*)GvIO((GV*)ob))
+ && SvOBJECT(ob))))
+ {
Perl_croak(aTHX_ "Can't call method \"%s\" on unblessed reference",
name);
+ }
stash = SvSTASH(ob);
https://perl5.git.perl.org / perl5.git / blobdiff