This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
MANIFEST adjustment.
[perl5.git] / pp_hot.c
index 70d4e6d..208d89b 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -795,6 +795,7 @@ PP(pp_rv2hv)
 {
     dSP; dTOPss;
     HV *hv;
+    I32 gimme = GIMME_V;
 
     if (SvROK(sv)) {
       wasref:
@@ -808,7 +809,7 @@ PP(pp_rv2hv)
            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;
@@ -825,7 +826,7 @@ PP(pp_rv2hv)
                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);
@@ -850,7 +851,7 @@ PP(pp_rv2hv)
                        DIE(aTHX_ PL_no_usym, "a HASH");
                    if (ckWARN(WARN_UNINITIALIZED))
                        report_uninit();
-                   if (GIMME == G_ARRAY) {
+                   if (gimme == G_ARRAY) {
                        SP--;
                        RETURN;
                    }
@@ -885,7 +886,7 @@ PP(pp_rv2hv)
                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);
@@ -894,21 +895,16 @@ PP(pp_rv2hv)
        }
     }
 
-    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
@@ -962,8 +958,12 @@ PP(pp_aassign)
     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
@@ -1017,6 +1017,7 @@ PP(pp_aassign)
                hash = (HV*)sv;
                magic = SvMAGICAL(hash) != 0;
                hv_clear(hash);
+               firsthashrelem = relem;
 
                while (relem < lastrelem) {     /* gobble up all the rest */
                    HE *didstore;
@@ -1028,6 +1029,9 @@ PP(pp_aassign)
                    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))
@@ -1062,10 +1066,13 @@ PP(pp_aassign)
     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) {
@@ -1075,7 +1082,7 @@ PP(pp_aassign)
 #    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 */
@@ -1091,10 +1098,13 @@ PP(pp_aassign)
        }
        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) {
@@ -1104,7 +1114,7 @@ PP(pp_aassign)
 #    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 */
@@ -1122,17 +1132,26 @@ PP(pp_aassign)
     }
     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);
@@ -1541,7 +1560,9 @@ Perl_do_readline(pTHX)
     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) {
@@ -1872,8 +1893,7 @@ PP(pp_iter)
     }
     if (sv && SvREFCNT(sv) == 0) {
        *itersvp = Nullsv;
-       Perl_croak(aTHX_
-           "Use of freed value in iteration (perhaps you modified the iterated array within the loop?)");
+       Perl_croak(aTHX_ "Use of freed value in iteration");
     }
 
     if (sv)