From: Nicholas Clark <nick@ccl4.org>
Date: Tue, 18 Nov 2003 21:04:40 +0000 (+0000)
Subject: Whoops. We weren't actually testing hv_store_ent
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=858117f827a98da9ad03d6640608dcdd8266902d;p=p5sagit%2Fp5-mst-13.2.git

Whoops. We weren't actually testing hv_store_ent
We are now. Plus test hv_store for an initially empty hash.

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

diff --git a/ext/XS/APItest/APItest.xs b/ext/XS/APItest/APItest.xs
index b346588..2575348 100644
--- a/ext/XS/APItest/APItest.xs
+++ b/ext/XS/APItest/APItest.xs
@@ -36,6 +36,30 @@ delete(hash, key_sv)
         RETVAL
 
 SV *
+store_ent(hash, key, value)
+	PREINIT:
+	SV *copy;
+	HE *result;
+	INPUT:
+	HV *hash
+	SV *key
+	SV *value
+	CODE:
+	copy = newSV(0);
+	result = hv_store_ent(hash, key, copy, 0);
+	SvSetMagicSV(copy, value);
+	if (!result) {
+	    SvREFCNT_dec(copy);
+	    XSRETURN_EMPTY;
+	}
+	/* It's about to become mortal, so need to increase reference count.
+	 */
+	RETVAL = SvREFCNT_inc(HeVAL(result));
+        OUTPUT:
+        RETVAL
+
+
+SV *
 store(hash, key_sv, value)
 	PREINIT:
 	STRLEN len;
@@ -50,7 +74,7 @@ store(hash, key_sv, value)
 	key = SvPV(key_sv, len);
 	copy = newSV(0);
 	result = hv_store(hash, key, SvUTF8(key_sv) ? -len : len, copy, 0);
-	SvSetMagicSV(*result, value);
+	SvSetMagicSV(copy, value);
 	if (!result) {
 	    SvREFCNT_dec(copy);
 	    XSRETURN_EMPTY;
@@ -81,7 +105,6 @@ fetch(hash, key_sv)
 	RETVAL = newSVsv(*result);
         OUTPUT:
         RETVAL
-
 =pod
 
 sub TIEHASH  { bless {}, $_[0] }
diff --git a/ext/XS/APItest/t/hash.t b/ext/XS/APItest/t/hash.t
index 2a2a4e0..c4fa712 100644
--- a/ext/XS/APItest/t/hash.t
+++ b/ext/XS/APItest/t/hash.t
@@ -106,26 +106,27 @@ sub brute_force_exists {
 
 sub test_store {
   my $key = shift;
-  my $printable = join ',', map {ord} split //, $key;
-
-  # We are cheating - hv_store returns NULL for a store into an empty
-  # tied hash. This isn't helpful here.
-
-  my %h1 = (a=>'cheat');
-  is ($h1{$key} = 1, 1); 
-  ok (brute_force_exists (\%h1, $key), "hv_store_ent $printable");
-  my %h2 = (a=>'cheat');
-  is (XS::APItest::Hash::store(\%h2, $key,  1), 1);
-  ok (brute_force_exists (\%h2, $key), "hv_store $printable");
-  my %h3 = (a=>'cheat');
+  my $defaults = shift;
+  my $HV_STORE_IS_CRAZY = @$defaults ? 1 : undef;
+  my $name = join ',', map {ord} split //, $key;
+  $name .= ' (hash starts empty)' unless @$defaults;
+
+  my %h1 = @$defaults;
+  is (XS::APItest::Hash::store_ent (\%h1, $key, 1), 1, "hv_store_ent $name"); 
+  ok (brute_force_exists (\%h1, $key), "hv_store_ent $name");
+  my %h2 = @$defaults;
+  is (XS::APItest::Hash::store(\%h2, $key,  1), 1, "hv_store $name");
+  ok (brute_force_exists (\%h2, $key), "hv_store $name");
+  my %h3 = @$defaults;
   tie %h3, 'Tie::StdHash';
-  is ($h3{$key} = 1, 1); 
-  ok (brute_force_exists (\%h3, $key), "hv_store_ent tie $printable");
-
-  my %h4 = (a=>'cheat');
+  is (XS::APItest::Hash::store_ent (\%h3, $key, 1), 1,
+      "hv_store_ent tie $name");
+  ok (brute_force_exists (\%h3, $key), "hv_store_ent tie $name");
+  my %h4 = @$defaults;
   tie %h4, 'Tie::StdHash';
-  is (XS::APItest::Hash::store(\%h4, $key, 1), 1);
-  ok (brute_force_exists (\%h4, $key), "hv_store tie $printable");
+  is (XS::APItest::Hash::store(\%h4, $key, 1), $HV_STORE_IS_CRAZY,
+      "hv_store tie $name");
+  ok (brute_force_exists (\%h4, $key), "hv_store tie $name");
 }
 
 sub test_fetch_present {
@@ -159,7 +160,8 @@ foreach my $key (@testkeys) {
   test_fetch_present ($key);
   test_delete_present ($key);
 
-  test_store ($key);
+  test_store ($key, [a=>'cheat']);
+  test_store ($key, []);
 
   my $lckey = lc $key;
   test_absent ($lckey);