}
STATIC void
-S_do_oddball(pTHX_ HV *hash, SV **relem, SV **firstrelem)
+S_do_oddball(pTHX_ SV **oddkey, SV **firstkey)
{
dVAR;
PERL_ARGS_ASSERT_DO_ODDBALL;
- if (*relem) {
+ if (*oddkey) {
if (ckWARN(WARN_MISC)) {
const char *err;
- if (relem == firstrelem &&
- SvROK(*relem) &&
- (SvTYPE(SvRV(*relem)) == SVt_PVAV ||
- SvTYPE(SvRV(*relem)) == SVt_PVHV))
+ if (oddkey == firstkey &&
+ SvROK(*oddkey) &&
+ (SvTYPE(SvRV(*oddkey)) == SVt_PVAV ||
+ SvTYPE(SvRV(*oddkey)) == SVt_PVHV))
{
err = "Reference found where even-sized list expected";
}
odd = ((lastrelem - firsthashrelem)&1)? 0 : 1;
if ( odd ) {
- do_oddball(hash, lastrelem, firsthashrelem);
- /* we have lelem to reuse, it's not needed anymore */
+ do_oddball(lastrelem, firsthashrelem);
+ /* we have firstlelem to reuse, it's not needed anymore
+ */
*(lastrelem+1) = &PL_sv_undef;
}
while (relem < lastrelem+odd) { /* gobble up all the rest */
HE *didstore;
assert(*relem);
- sv = lval ? sv_mortalcopy(*relem) : *relem;
+ /* Copy the key if aassign is called in lvalue context,
+ to avoid having the next op modify our rhs. Copy
+ it also if it is gmagical, lest it make the
+ hv_store_ent call below croak, leaking the value. */
+ sv = lval || SvGMAGICAL(*relem)
+ ? sv_mortalcopy(*relem)
+ : *relem;
relem++;
assert(*relem);
- tmpstr = sv_mortalcopy( *relem++ ); /* value */
+ SvGETMAGIC(*relem);
+ tmpstr = newSV(0);
+ sv_setsv_nomg(tmpstr,*relem++); /* value */
if (gimme == G_ARRAY) {
if (hv_exists_ent(hash, sv, 0))
/* key overwrites an existing entry */
duplicates += 2;
else {
/* copy element back: possibly to an earlier
- * stack location if we encountered dups earlier */
+ * stack location if we encountered dups earlier,
+ * possibly to a later stack location if odd */
*topelem++ = sv;
*topelem++ = tmpstr;
}
}
didstore = hv_store_ent(hash,sv,tmpstr,0);
- if (didstore) SvREFCNT_inc_simple_void_NN(tmpstr);
- if (magic) SvSETMAGIC(tmpstr);
+ if (magic) {
+ if (!didstore) sv_2mortal(tmpstr);
+ SvSETMAGIC(tmpstr);
+ }
TAINT_NOT;
}
LEAVE;
}
else {
if (ary || hash)
+ /* note that in this case *firstlelem may have been overwritten
+ by sv_undef in the odd hash case */
SP = lastrelem;
else {
SP = firstrelem + (lastlelem - firstlelem);
}
}
for (t1 = SvPVX_const(sv); *t1; t1++)
- if (!isALNUMC(*t1) &&
+ if (!isALPHANUMERIC(*t1) &&
strchr("$&*(){}[]'\";\\|?<>~`", *t1))
break;
if (*t1 && PerlLIO_lstat(SvPVX_const(sv), &PL_statbuf) < 0) {
as /x$r/, will set PL_tainted using TAINT_set, and thus RXf_TAINTED,
on the new pattern too.
-During execution of a pattern, locale-variant ops such as ALNUML set the
-local flag RF_tainted. At the end of execution, the engine sets the
-RXf_TAINTED_SEEN on the pattern if RF_tainted got set, or clears it
-otherwise.
+At the start of execution of a pattern, the RXf_TAINTED_SEEN flag on the
+regex is cleared; during execution, locale-variant ops such as POSIXL may
+set RXf_TAINTED_SEEN.
-In addition, RXf_TAINTED_SEEN is used post-execution by the get magic code
+RXf_TAINTED_SEEN is used post-execution by the get magic code
of $1 et al to indicate whether the returned value should be tainted.
It is the responsibility of the caller of the pattern (i.e. pp_match,
pp_subst etc) to set this flag for any other circumstances where $1 needs