[perl #81750] Perl 5.12: undef-as-hashref bug
authorFather Chrysostomos <sprout@cpan.org>
Fri, 21 Jan 2011 16:26:50 +0000 (08:26 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Fri, 21 Jan 2011 16:29:30 +0000 (08:29 -0800)
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.

pp.c
t/op/ref.t

diff --git a/pp.c b/pp.c
index 0a955bb..d2bb466 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -248,7 +248,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);
@@ -6319,6 +6322,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) {
index 38c6800..bcd121a 100644 (file)
@@ -9,7 +9,7 @@ BEGIN {
 use strict qw(refs subs);
 use re ();
 
-plan(200);
+plan(213);
 
 # Test glob operations.
 
@@ -671,6 +671,26 @@ is (runperl(
     "ok\n", 'freeing freed glob in global destruction');
 
 
+# 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);