misapplied patch 19452

The pp_hot.c part of #19452 seems to have been messed up, possibly
introducing a bug.

This is what I sent (see bug #17718):

--- perl/pp_hot.c.orig	Thu May  1 05:26:22 2003
+++ perl/pp_hot.c	Tue May  6 14:35:10 2003
@@ -795,6 +795,7 @@
 {
     dSP; dTOPss;
     HV *hv;
+    I32 gimme = GIMME_V;
 
     if (SvROK(sv)) {
       wasref:
@@ -808,7 +809,7 @@
 	    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 @@
 		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 @@
 			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 @@
 		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,12 +895,15 @@
 	}
     }
 
-    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 (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 (HvFILL(hv))
             Perl_sv_setpvf(aTHX_ TARG, "%"IVdf"/%"IVdf,
 			   (IV)HvFILL(hv), (IV)HvMAX(hv) + 1);
@@ -907,8 +911,8 @@
 	    sv_setiv(TARG, 0);
 
 	SETTARG;
-	RETURN;
     }
+    RETURN;
 }
 
 STATIC void



and this is what got applied:

==== //depot/perl/pp_hot.c#318 (text) ====

@@ -795,6 +795,7 @@
 {
     dSP; dTOPss;
     HV *hv;
+    I32 gimme = GIMME_V;
 
     if (SvROK(sv)) {
       wasref:
@@ -808,7 +809,7 @@
 	    RETURN;
 	}
 	else if (LVRET) {
-	    if (GIMME == G_SCALAR)
+	    if (GIMME != G_SCALAR)
 		Perl_croak(aTHX_ "Can't return hash to lvalue scalar context");
 	    SETs((SV*)hv);
 	    RETURN;


which introduces a new bug:

$ ./perl -we'$y = \%x; sub x:lvalue {%$y} x = "a"'
Segmentation fault (core dumped)

$ ./perl -we'$y = \%x; sub x:lvalue {%$y} (x) = 1..2; print for %x'
Can't return hash to lvalue scalar context at -e line 1.

instead of the correct:

$ perl5.8.0 -we'$y = \%x; sub x:lvalue {%$y} x = "a"'
Can't return hash to lvalue scalar context at -e line 1.

$ perl5.8.0 -we'$y = \%x; sub x:lvalue {%$y} (x) = 1..2; print for %x'
12

• misapplied patch 19452 by Yitzchak Scott-Thoennes
• Re: misapplied patch 19452 by Abhijit Menon-Sen