[perl #81750] Perl 5.12: undef-as-hashref bug

The addition of the boolkeys op type in commit 867fa1e2d did not
account for the fact that rv2hv (%{}) can sometimes return undef
(%$undef with strict refs turned off).

When the boolkeys op is created (and the rv2hv becomes its kid), the
rv2hv is flagged with OPf_REF, meaning that it must return a hash, not
the contents.

Perl_softrefxv in pp.c checks for that flag. If it is set, it dies
with ‘Can't use an undefined value as a HASH reference’ for unde-
fined values.

This commit changes it to make an exception if rv2hv->op_next is a
boolkeys op. It also changes pp_boolkeys to account for undef.

3 files changed, 34 insertions, 2 deletions

diff --git a/pod/perl5124delta.pod b/pod/perl5124delta.pod
index 80a32b6919..98f3a5af83 100644
--- a/pod/perl5124delta.pod
+++ b/pod/perl5124delta.pod
@@ -22,6 +22,13 @@ exist, they are bugs and reports are welcome.
 
 =head1 Selected Bug Fixes
 
+When strict "refs" mode is off, C<%{...}> in rvalue context returns
+C<undef> if its argument is undefined.  An optimisation introduced in Perl
+5.12.0 to make C<keys %{...}> faster when used as a boolean did not take
+this into account, causing C<keys %{+undef}> (and C<keys %$foo> when
+C<$foo> is undefined) to be an error, which it should be so in strict
+mode only [perl #81750].
+
 C<lc>, C<uc>, C<lcfirst>, and C<ucfirst> no longer return untainted strings
 when the argument is tainted. This has been broken since perl 5.8.9
 [perl #87336].
diff --git a/pp.c b/pp.c
index 0c58262a5d..89a8409ce8 100644
--- a/pp.c
+++ b/pp.c
@@ -242,7 +242,10 @@ Perl_softref2xv(pTHX_ SV *const sv, const char *const what,
 	    Perl_die(aTHX_ PL_no_usym, what);
     }
     if (!SvOK(sv)) {
-	if (PL_op->op_flags & OPf_REF)
+	if (
+	  PL_op->op_flags & OPf_REF &&
+	  PL_op->op_next->op_type != OP_BOOLKEYS
+	)
 	    Perl_die(aTHX_ PL_no_usym, what);
 	if (ckWARN(WARN_UNINITIALIZED))
 	    report_uninit(sv);
@@ -5988,6 +5991,8 @@ PP(pp_boolkeys)
     dSP;
     HV * const hv = (HV*)POPs;
     
+    if (SvTYPE(hv) != SVt_PVHV) { XPUSHs(&PL_sv_no); RETURN; }
+
     if (SvRMAGICAL(hv)) {
 	MAGIC * const mg = mg_find((SV*)hv, PERL_MAGIC_tied);
 	if (mg) {
diff --git a/t/op/ref.t b/t/op/ref.t
index 019b47cdce..f4f112cf7c 100644
--- a/t/op/ref.t
+++ b/t/op/ref.t
@@ -9,7 +9,7 @@ require 'test.pl';
 use strict qw(refs subs);
 use re ();
 
-plan(196);
+plan(209);
 
 # Test glob operations.
 
@@ -627,6 +627,26 @@ is( runperl(stderr => 1, prog => $hushed . 'for $a (3) {@b=sort {die} 4,5}'), "D
 is( runperl(stderr => 1, prog => 'my $i;for $i (1) { for $i (2) { } }'), "");
 
 
+# Test undefined hash references as arguments to %{} in boolean context
+# [perl #81750]
+{
+ no strict 'refs';
+ eval { my $foo; %$foo;             }; ok (!$@, '%$undef');
+ eval { my $foo; scalar %$foo;      }; ok (!$@, 'scalar %$undef');
+ eval { my $foo; !%$foo;            }; ok (!$@, '!%$undef');
+ eval { my $foo; if ( %$foo) {}     }; ok (!$@, 'if ( %$undef) {}');
+ eval { my $foo; if (!%$foo) {}     }; ok (!$@, 'if (!%$undef) {}');
+ eval { my $foo; unless ( %$foo) {} }; ok (!$@, 'unless ( %$undef) {}');
+ eval { my $foo; unless (!%$foo) {} }; ok (!$@, 'unless (!%$undef) {}');
+ eval { my $foo; 1 if %$foo;        }; ok (!$@, '1 if %$undef');
+ eval { my $foo; 1 if !%$foo;       }; ok (!$@, '1 if !%$undef');
+ eval { my $foo; 1 unless %$foo;    }; ok (!$@, '1 unless %$undef;');
+ eval { my $foo; 1 unless ! %$foo;  }; ok (!$@, '1 unless ! %$undef');
+ eval { my $foo;  %$foo ? 1 : 0;    }; ok (!$@, ' %$undef ? 1 : 0');
+ eval { my $foo; !%$foo ? 1 : 0;    }; ok (!$@, '!%$undef ? 1 : 0');
+}
+
+
 # Bit of a hack to make test.pl happy. There are 3 more tests after it leaves.
 $test = curr_test();
 curr_test($test + 3);