This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate:
authorYitzchak Scott-Thoennes <sthoenna@efn.org>
Tue, 30 Sep 2003 06:01:50 +0000 (23:01 -0700)
committerNicholas Clark <nick@ccl4.org>
Sat, 18 Oct 2003 17:40:32 +0000 (17:40 +0000)
[ 21394]
Subject: misapplied patch 19452
Message-Id: <20030930130150.GA1436@efn.org>
p4raw-link: @21394 on //depot/perl: be85d34438445e22b1284a6bdfb03db1aac59f18

p4raw-id: //depot/maint-5.8/perl@21481
p4raw-edited: from //depot/perl@21480 'edit in' pp_hot.c (@21319..)

pp_hot.c

index e5b91fd..9353186 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -763,6 +763,7 @@ PP(pp_rv2hv)
 {
     dSP; dTOPss;
     HV *hv;
+    I32 gimme = GIMME_V;
 
     if (SvROK(sv)) {
       wasref:
@@ -776,7 +777,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;
@@ -793,7 +794,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);
@@ -818,7 +819,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;
                    }
@@ -853,7 +854,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);
@@ -862,14 +863,22 @@ 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;
+
+       /* 21394 adds this, but I'm not sure if it's safe in maint:
+       if (SvRMAGICAL(hv) && mg_find((SV *)hv, PERL_MAGIC_tied))
+           Perl_croak(aTHX_ "Can't provide tied hash usage; "
+                      "use keys(%%hash) to test if empty");
+       */
+
        if (SvTYPE(hv) == SVt_PVAV)
            hv = avhv_keys((AV*)hv);
+
        if (HvFILL(hv))
             Perl_sv_setpvf(aTHX_ TARG, "%"IVdf"/%"IVdf,
                           (IV)HvFILL(hv), (IV)HvMAX(hv) + 1);
@@ -877,8 +886,8 @@ PP(pp_rv2hv)
            sv_setiv(TARG, 0);
        
        SETTARG;
-       RETURN;
     }
+    RETURN;
 }
 
 STATIC int