[perl.git] branch maint-5.12, updated. v5.12.3-10-gaf021af

In perl.git, the branch maint-5.12 has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/af021af6468a4ef90c28f5220360c0c329c195f1?hp=9d220e4240c1f6b6de17a6b0608f66088ddff181>

- Log -----------------------------------------------------------------
commit af021af6468a4ef90c28f5220360c0c329c195f1
Author: Father Chrysostomos <sprout@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:
 pod/perl5124delta.pod |    7 +++++++
 pp.c                  |    7 ++++++-
 t/op/ref.t            |   22 +++++++++++++++++++++-
 3 files changed, 34 insertions(+), 2 deletions(-)

diff --git a/pod/perl5124delta.pod b/pod/perl5124delta.pod
index 80a32b6..98f3a5a 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 0c58262..89a8409 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 019b47c..f4f112c 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);

--
Perl5 Master Repository

• [perl.git] branch maint-5.12, updated. v5.12.3-10-gaf021af by Leon Brocard