{
dSP; dTOPss;
HV *hv;
+ I32 gimme = GIMME_V;
if (SvROK(sv)) {
wasref:
RETURN;
}
else if (LVRET) {
- if (GIMME != G_SCALAR)
+ if (gimme != G_ARRAY)
Perl_croak(aTHX_ "Can't return hash to lvalue scalar context");
SETs((SV*)hv);
RETURN;
RETURN;
}
else if (LVRET) {
- if (GIMME == G_SCALAR)
+ if (gimme != G_ARRAY)
Perl_croak(aTHX_ "Can't return hash to lvalue"
" scalar context");
SETs((SV*)hv);
DIE(aTHX_ PL_no_usym, "a HASH");
if (ckWARN(WARN_UNINITIALIZED))
report_uninit();
- if (GIMME == G_ARRAY) {
+ if (gimme == G_ARRAY) {
SP--;
RETURN;
}
RETURN;
}
else if (LVRET) {
- if (GIMME == G_SCALAR)
+ if (gimme != G_ARRAY)
Perl_croak(aTHX_ "Can't return hash to lvalue"
" scalar context");
SETs((SV*)hv);
}
}
- if (GIMME == G_ARRAY) { /* array wanted */
+ if (gimme == G_ARRAY) { /* array wanted */
*PL_stack_sp = (SV*)hv;
return do_kv();
}
- else {
+ else if (gimme == G_SCALAR) {
dTARGET;
- if (HvFILL(hv))
- Perl_sv_setpvf(aTHX_ TARG, "%"IVdf"/%"IVdf,
- (IV)HvFILL(hv), (IV)HvMAX(hv) + 1);
- else
- sv_setiv(TARG, 0);
-
+ TARG = Perl_hv_scalar(aTHX_ hv);
SETTARG;
- RETURN;
}
+ RETURN;
}
STATIC void
HV *hash;
I32 i;
int magic;
+ int duplicates = 0;
+ SV **firsthashrelem = 0; /* "= 0" keeps gcc 2.95 quiet */
+
PL_delaymagic = DM_DELAY; /* catch simultaneous items */
+ gimme = GIMME_V;
/* If there's a common identifier on both sides we have to take
* special care that assigning the identifier on the left doesn't
hash = (HV*)sv;
magic = SvMAGICAL(hash) != 0;
hv_clear(hash);
+ firsthashrelem = relem;
while (relem < lastrelem) { /* gobble up all the rest */
HE *didstore;
if (*relem)
sv_setsv(tmpstr,*relem); /* value */
*(relem++) = tmpstr;
+ if (gimme != G_VOID && hv_exists_ent(hash, sv, 0))
+ /* key overwrites an existing entry */
+ duplicates += 2;
didstore = hv_store_ent(hash,sv,tmpstr,0);
if (magic) {
if (SvSMAGICAL(tmpstr))
if (PL_delaymagic & ~DM_DELAY) {
if (PL_delaymagic & DM_UID) {
#ifdef HAS_SETRESUID
- (void)setresuid(PL_uid,PL_euid,(Uid_t)-1);
+ (void)setresuid((PL_delaymagic & DM_RUID) ? PL_uid : (Uid_t)-1,
+ (PL_delaymagic & DM_EUID) ? PL_euid : (Uid_t)-1,
+ (Uid_t)-1);
#else
# ifdef HAS_SETREUID
- (void)setreuid(PL_uid,PL_euid);
+ (void)setreuid((PL_delaymagic & DM_RUID) ? PL_uid : (Uid_t)-1,
+ (PL_delaymagic & DM_EUID) ? PL_euid : (Uid_t)-1);
# else
# ifdef HAS_SETRUID
if ((PL_delaymagic & DM_UID) == DM_RUID) {
# endif /* HAS_SETRUID */
# ifdef HAS_SETEUID
if ((PL_delaymagic & DM_UID) == DM_EUID) {
- (void)seteuid(PL_uid);
+ (void)seteuid(PL_euid);
PL_delaymagic &= ~DM_EUID;
}
# endif /* HAS_SETEUID */
}
if (PL_delaymagic & DM_GID) {
#ifdef HAS_SETRESGID
- (void)setresgid(PL_gid,PL_egid,(Gid_t)-1);
+ (void)setresgid((PL_delaymagic & DM_RGID) ? PL_gid : (Gid_t)-1,
+ (PL_delaymagic & DM_EGID) ? PL_egid : (Gid_t)-1,
+ (Gid_t)-1);
#else
# ifdef HAS_SETREGID
- (void)setregid(PL_gid,PL_egid);
+ (void)setregid((PL_delaymagic & DM_RGID) ? PL_gid : (Gid_t)-1,
+ (PL_delaymagic & DM_EGID) ? PL_egid : (Gid_t)-1);
# else
# ifdef HAS_SETRGID
if ((PL_delaymagic & DM_GID) == DM_RGID) {
# endif /* HAS_SETRGID */
# ifdef HAS_SETEGID
if ((PL_delaymagic & DM_GID) == DM_EGID) {
- (void)setegid(PL_gid);
+ (void)setegid(PL_egid);
PL_delaymagic &= ~DM_EGID;
}
# endif /* HAS_SETEGID */
}
PL_delaymagic = 0;
- gimme = GIMME_V;
if (gimme == G_VOID)
SP = firstrelem - 1;
else if (gimme == G_SCALAR) {
dTARGET;
SP = firstrelem;
- SETi(lastrelem - firstrelem + 1);
+ SETi(lastrelem - firstrelem + 1 - duplicates);
}
else {
- if (ary || hash)
+ if (ary)
+ SP = lastrelem;
+ else if (hash) {
+ if (duplicates) {
+ /* Removes from the stack the entries which ended up as
+ * duplicated keys in the hash (fix for [perl #24380]) */
+ Move(firsthashrelem + duplicates,
+ firsthashrelem, duplicates, SV**);
+ lastrelem -= duplicates;
+ }
SP = lastrelem;
+ }
else
SP = firstrelem + (lastlelem - firstlelem);
lelem = firstlelem + (relem - firstrelem);
if (PL_op->op_flags & OPf_STACKED)
TARG = POPs;
+ else if (PL_op->op_private & OPpTARGET_MY)
+ GETTARGET;
else {
TARG = DEFSV;
EXTEND(SP,1);
/*SUPPRESS 560*/
if ((rx->startp[i] != -1) && rx->endp[i] != -1 ) {
len = rx->endp[i] - rx->startp[i];
+ s = rx->startp[i] + truebase;
if (rx->endp[i] < 0 || rx->startp[i] < 0 ||
len < 0 || len > strend - s)
DIE(aTHX_ "panic: pp_match start/end pointers");
- s = rx->startp[i] + truebase;
sv_setpvn(*SP, s, len);
if (DO_UTF8(TARG) && is_utf8_string((U8*)s, len))
SvUTF8_on(*SP);
for (;;) {
PUTBACK;
if (!sv_gets(sv, fp, offset)
- && (type == OP_GLOB || SNARF_EOF(gimme, PL_rs, io, sv)))
+ && (type == OP_GLOB
+ || SNARF_EOF(gimme, PL_rs, io, sv)
+ || PerlIO_error(fp)))
{
PerlIO_clearerr(fp);
if (IoFLAGS(io) & IOf_ARGV) {
dstr = (pm->op_pmflags & PMf_CONST) ? POPs : Nullsv;
if (PL_op->op_flags & OPf_STACKED)
TARG = POPs;
+ else if (PL_op->op_private & OPpTARGET_MY)
+ GETTARGET;
else {
TARG = DEFSV;
EXTEND(SP,1);
(void)POPMARK; /* pop dst */
SP = PL_stack_base + POPMARK; /* pop original mark */
if (gimme == G_SCALAR) {
- dTARGET;
- XPUSHi(items);
+ if (PL_op->op_private & OPpGREP_LEX) {
+ SV* sv = sv_newmortal();
+ sv_setiv(sv, items);
+ PUSHs(sv);
+ }
+ else {
+ dTARGET;
+ XPUSHi(items);
+ }
}
else if (gimme == G_ARRAY)
SP += items;
src = PL_stack_base[*PL_markstack_ptr];
SvTEMP_off(src);
- DEFSV = src;
+ if (PL_op->op_private & OPpGREP_LEX)
+ PAD_SVl(PL_op->op_targ) = src;
+ else
+ DEFSV = src;
RETURNOP(cLOGOP->op_other);
}
* Owing the speed considerations, we choose instead to search for
* the cv using find_runcv() when calling doeval().
*/
- if (CvDEPTH(cv) < 2)
- (void)SvREFCNT_inc(cv);
- else {
+ if (CvDEPTH(cv) >= 2) {
PERL_STACK_OVERFLOW_CHECK();
pad_push(padlist, CvDEPTH(cv), 1);
}