ext/XS-APItest/t/hash.t: Generalize to run on non-ASCII platforms

[perl5.git] / ext / XS-APItest / t / hash.t

diff --git a/ext/XS-APItest/t/hash.t b/ext/XS-APItest/t/hash.t
index f66edfa..ac8eebe 100644 (file)
--- a/ext/XS-APItest/t/hash.t
+++ b/ext/XS-APItest/t/hash.t
@@ -20,7 +20,7 @@ sub test_fetch_absent;
 my $utf8_for_258 = chr 258;
 utf8::encode $utf8_for_258;
 
-my @testkeys = ('N', chr 198, chr 256);
+my @testkeys = ('N', chr utf8::unicode_to_native(198), chr 256);
 my @keys = (@testkeys, $utf8_for_258);
 
 foreach (@keys) {
@@ -245,6 +245,42 @@ sub test_precomputed_hashes {
       'newHVhv on tied hash';
 }
 
+# helem and hslice on entry with null value
+# This is actually a test for a Perl operator, not an XS API test.  But it
+# requires a hash that can only be produced by XS (although recently it
+# could be encountered when tying hint hashes).
+{
+    my %h;
+    fill_hash_with_nulls(\%h);
+    eval{ $h{84} = 1 };
+    pass 'no crash when writing to hash elem with null value';
+    eval{ no # silly
+         warnings; # thank you!
+         @h{85} = 1 };
+    pass 'no crash when writing to hash elem with null value via slice';
+    eval { delete local $h{86} };
+    pass 'no crash during local deletion of hash elem with null value';
+    eval { delete local @h{87,88} };
+    pass 'no crash during local deletion of hash slice with null values';
+}
+
+# [perl #111000] Bug number eleventy-one thousand:
+#                hv_store should work on hint hashes
+eval q{
+    BEGIN {
+       XS::APItest::Hash::store \%^H, "XS::APItest/hash.t", undef;
+       delete $^H{"XS::APItest/hash.t"};
+    }
+};
+pass("hv_store works on the hint hash");
+
+{
+    # [perl #79074] HeSVKEY_force loses UTF8ness
+    my %hash = ( "\xff" => 1, "\x{100}" => 1 );
+    my @keys = sort ( XS::APItest::Hash::test_force_keys(\%hash) );
+    is_deeply(\@keys, [ sort keys %hash ], "check HeSVKEY_force()");
+}
+
 done_testing;
 exit;
 
@@ -360,7 +396,7 @@ sub test_U_hash {
 sub main_tests {
   my ($keys, $testkeys, $description) = @_;
   foreach my $key (@$testkeys) {
-    my $lckey = ($key eq chr 198) ? chr 230 : lc $key;
+    my $lckey = ($key eq chr utf8::unicode_to_native(198)) ? chr utf8::unicode_to_native(230) : lc $key;
     my $unikey = $key;
     utf8::encode $unikey;