Fix bug 36267 - assigning to a tied hash shouldn't change the

underlying hash. (It used to, if the underlying hash had had storage
allocated). This has the side effect of changing the return value from
hv_store and hv_store_ent for some tied hash scenarios. But *to*
something consistent (ly crazy)

p4raw-id: //depot/perl@27636

diff --git a/ext/XS/APItest/t/hash.t b/ext/XS/APItest/t/hash.t
index 7c60b64..880d972 100644 (file)
--- a/ext/XS/APItest/t/hash.t
+++ b/ext/XS/APItest/t/hash.t
@@ -49,7 +49,7 @@ main_tests (\@keys, \@testkeys, ' [utf8 hash]');
 {
   my %h = (a=>'cheat');
   tie %h, 'Tie::StdHash';
-  is (XS::APItest::Hash::store(\%h, chr 258,  1), 1);
+  is (XS::APItest::Hash::store(\%h, chr 258,  1), undef);
     
   ok (!exists $h{$utf8_for_258},
       "hv_store doesn't insert a key with the raw utf8 on a tied hash");
@@ -222,9 +222,9 @@ sub test_store {
   if (defined $class) {
     tie %h1, ref $class;
     tie %h2, ref $class;
-    $HV_STORE_IS_CRAZY = undef unless @$defaults;
+    $HV_STORE_IS_CRAZY = undef;
   }
-  is (XS::APItest::Hash::store_ent(\%h1, $key, 1), 1,
+  is (XS::APItest::Hash::store_ent(\%h1, $key, 1), $HV_STORE_IS_CRAZY,
       "hv_store_ent$message $printable"); 
   ok (brute_force_exists (\%h1, $key), "hv_store_ent$message $printable");
   is (XS::APItest::Hash::store(\%h2, $key,  1), $HV_STORE_IS_CRAZY,

diff --git a/hv.c b/hv.c
index 350ddd3..e92a365 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -582,7 +582,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                }
 
                TAINT_IF(save_taint);
-               if (!HvARRAY(hv) && !needs_store) {
+               if (!needs_store) {
                    if (flags & HVhek_FREEKEY)
                        Safefree(key);
                    return NULL;

diff --git a/t/op/tie.t b/t/op/tie.t
index 68a773d..1d676ea 100755 (executable)
--- a/t/op/tie.t
+++ b/t/op/tie.t
@@ -593,3 +593,22 @@ tie my $y, "main", 8;
 print $x | $y;
 EXPECT
 10
+########
+# Bug 36267
+sub TIEHASH  { bless {}, $_[0] }
+sub STORE    { $_[0]->{$_[1]} = $_[2] }
+sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
+sub NEXTKEY  { each %{$_[0]} }
+sub DELETE   { delete $_[0]->{$_[1]} }
+sub CLEAR    { %{$_[0]} = () }
+$h{b}=1;
+delete $h{b};
+print scalar keys %h, "\n";
+tie %h, 'main';
+$i{a}=1;
+%h = %i;
+untie %h;
+print scalar keys %h, "\n";
+EXPECT
+0
+0