[perl.git] branch blead, updated. v5.13.9-34-gfd1d9b5

[Father Chrysostomos]

In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/fd1d9b5c785ad0e5340c74dd6f1be27a3735e829?hp=c0f8aaaaa842ec59ffd5f565760f0c9f7cfd674f>

- Log -----------------------------------------------------------------
commit fd1d9b5c785ad0e5340c74dd6f1be27a3735e829
Author: Father Chrysostomos <spr...@cpan.org>
Date:   Fri Jan 21 08:26:50 2011 -0800

    [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.
-----------------------------------------------------------------------

Summary of changes:
 pp.c       |    7 ++++++-
 t/op/ref.t |   22 +++++++++++++++++++++-
 2 files changed, 27 insertions(+), 2 deletions(-)

diff --git a/pp.c b/pp.c
index 0a955bb..d2bb466 100644
--- 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) {
diff --git a/t/op/ref.t b/t/op/ref.t
index 38c6800..bcd121a 100644
--- a/t/op/ref.t
+++ b/t/op/ref.t
@@ -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);

--
Perl5 Master Repository