From: Nicholas Clark <nick@ccl4.org>
Date: Wed, 28 Nov 2007 17:47:20 +0000 (+0000)
Subject: Fix bless/readonly failure spotted by Jerry Hedden.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e0744413e6f127253b25f119fce72a814e2bf4fe;p=p5sagit%2Fp5-mst-13.2.git

Fix bless/readonly failure spotted by Jerry Hedden.

p4raw-id: //depot/perl@32533
---

diff --git a/sv.c b/sv.c
index 824db49..718e305 100644
--- a/sv.c
+++ b/sv.c
@@ -7979,6 +7979,8 @@ Perl_sv_bless(pTHX_ SV *sv, HV *stash)
         Perl_croak(aTHX_ "Can't bless non-reference value");
     tmpRef = SvRV(sv);
     if (SvFLAGS(tmpRef) & (SVs_OBJECT|SVf_READONLY)) {
+	if (SvIsCOW(tmpRef))
+	    sv_force_normal_flags(tmpRef, 0);
 	if (SvREADONLY(tmpRef))
 	    Perl_croak(aTHX_ PL_no_modify);
 	if (SvOBJECT(tmpRef)) {
diff --git a/t/op/bless.t b/t/op/bless.t
index d5ae885..14ef3d8 100644
--- a/t/op/bless.t
+++ b/t/op/bless.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan (106);
+plan (108);
 
 sub expected {
     my($object, $package, $type) = @_;
@@ -128,3 +128,14 @@ $h1 = bless {}, "H4";
 $c4 = eval { bless \$test, $h1 };
 is ($@, '', "class is an overloaded ref");
 expected($c4, 'C4', "SCALAR");
+
+{
+    my %h = 1..2;
+    my($k) = keys %h; 
+    my $x=\$k;
+    bless $x, 'pam';
+    is(ref $x, 'pam');
+
+    my $a = bless \(keys %h), 'zap';
+    is(ref $a, 'zap');
+}