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

#!perl -w

BEGIN {
  chdir 't' if -d 't';
  @INC = '../lib';
  push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS';
  require Config; import Config;
  if ($Config{'extensions'} !~ /\bXS\/APItest\b/) {
    # Look, I'm using this fully-qualified variable more than once!
    my $arch = $MacPerl::Architecture;
    print "1..0 # Skip: XS::APItest was not built\n";
    exit 0;
  }
}

use strict;
use utf8;
use Tie::Hash;
use Test::More 'no_plan';

BEGIN {use_ok('XS::APItest')};

sub preform_test;
sub test_present;
sub test_absent;
sub test_delete_present;
sub test_delete_absent;
sub brute_force_exists;
sub test_store;
sub test_fetch_present;
sub test_fetch_absent;

my $utf8_for_258 = chr 258;
utf8::encode $utf8_for_258;

my @testkeys = ('N', chr 198, chr 256);
my @keys = (@testkeys, $utf8_for_258);

foreach (@keys) {
  utf8::downgrade $_, 1;
}
main_tests (\@keys, \@testkeys, '');

foreach (@keys) {
  utf8::upgrade $_;
}
main_tests (\@keys, \@testkeys, ' [utf8 hash]');

{
  my %h = (a=>'cheat');
  tie %h, 'Tie::StdHash';
  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");
}

{
    my $strtab = strtab();
    is (ref $strtab, 'HASH', "The shared string table quacks like a hash");
    my $wibble = "\0";
    eval {
	$strtab->{$wibble}++;
    };
    my $prefix = "Cannot modify shared string table in hv_";
    my $what = $prefix . 'fetch';
    like ($@, qr/^$what/,$what);
    eval {
	XS::APItest::Hash::store($strtab, 'Boom!',  1)
    };
    $what = $prefix . 'store';
    like ($@, qr/^$what/, $what);
    if (0) {
	A::B->method();
    }
    # DESTROY should be in there.
    eval {
	delete $strtab->{DESTROY};
    };
    $what = $prefix . 'delete';
    like ($@, qr/^$what/, $what);
    # I can't work out how to get to the code that flips the wasutf8 flag on
    # the hash key without some ikcy XS
}

{
    is_deeply([&XS::APItest::Hash::test_hv_free_ent], [2,2,1,1],
	      "hv_free_ent frees the value immediately");
    is_deeply([&XS::APItest::Hash::test_hv_delayfree_ent], [2,2,2,1],
	      "hv_delayfree_ent keeps the value around until FREETMPS");
}

foreach my $in ("", "N", "a\0b") {
    my $got = XS::APItest::Hash::test_share_unshare_pvn($in);
    is ($got, $in, "test_share_unshare_pvn");
}

if ($] > 5.009) {
    my %hash;
    XS::APItest::Hash::rot13_hash(\%hash);
    $hash{a}++; @hash{qw(p i e)} = (2, 4, 8);

    my @keys = sort keys %hash;
    is("@keys", join(' ', sort(rot13(qw(a p i e)))),
       "uvar magic called exactly once on store");

    is($hash{i}, 4);

    is(delete $hash{a}, 1);

    is(keys %hash, 3);
    @keys = sort keys %hash;
    is("@keys", join(' ', sort(rot13(qw(p i e)))));

    is (XS::APItest::Hash::delete_ent (\%hash, 'p',
				       XS::APItest::HV_DISABLE_UVAR_XKEY),
	undef, "Deleting a known key with conversion disabled fails (ent)");
    is(keys %hash, 3);

    is (XS::APItest::Hash::delete_ent (\%hash, 'p', 0),
	2, "Deleting a known key with conversion enabled works (ent)");
    is(keys %hash, 2);
    @keys = sort keys %hash;
    is("@keys", join(' ', sort(rot13(qw(i e)))));

    is (XS::APItest::Hash::delete (\%hash, 'i',
				   XS::APItest::HV_DISABLE_UVAR_XKEY),
	undef, "Deleting a known key with conversion disabled fails");
    is(keys %hash, 2);

    is (XS::APItest::Hash::delete (\%hash, 'i', 0),
	4, "Deleting a known key with conversion enabled works");
    is(keys %hash, 1);
    @keys = sort keys %hash;
    is("@keys", join(' ', sort(rot13(qw(e)))));

    $hash{f} = 9;
    is(keys %hash, 2);
    @keys = sort keys %hash;
    is("@keys", join(' ', sort(rot13(qw(e f)))));

    is (XS::APItest::Hash::store_ent(\%hash, 'g', 10), 10, "store_ent");
    is(keys %hash, 3);
    @keys = sort keys %hash;
    is("@keys", join(' ', sort(rot13(qw(e f g)))));

    is (XS::APItest::Hash::store(\%hash, 'h', 11), 11, "store");
    is(keys %hash, 4);
    @keys = sort keys %hash;
    is("@keys", join(' ', sort(rot13(qw(e f g h)))));

    is (XS::APItest::Hash::fetch_ent(\%hash, 'g'), 10, "fetch_ent");
    is (XS::APItest::Hash::fetch_ent(\%hash, rot13('g')), undef,
	"fetch_ent (missing)");

    is (XS::APItest::Hash::fetch(\%hash, 'h'), 11, "fetch");
    is (XS::APItest::Hash::fetch(\%hash, rot13('h')), undef,
	"fetch (missing)");

    ok (XS::APItest::Hash::exists_ent(\%hash, 'e'), "exists_ent");
    ok (!XS::APItest::Hash::exists_ent(\%hash, rot13('e')),
	"exists_ent (missing)");

    ok (XS::APItest::Hash::exists(\%hash, 'f'), "exists");
    ok (!XS::APItest::Hash::exists(\%hash, rot13('f')), "exists (missing)");
}

exit;

################################   The End   ################################

sub main_tests {
  my ($keys, $testkeys, $description) = @_;
  foreach my $key (@$testkeys) {
    my $lckey = ($key eq chr 198) ? chr 230 : lc $key;
    my $unikey = $key;
    utf8::encode $unikey;

    utf8::downgrade $key, 1;
    utf8::downgrade $lckey, 1;
    utf8::downgrade $unikey, 1;
    main_test_inner ($key, $lckey, $unikey, $keys, $description);

    utf8::upgrade $key;
    utf8::upgrade $lckey;
    utf8::upgrade $unikey;
    main_test_inner ($key, $lckey, $unikey, $keys,
		     $description . ' [key utf8 on]');
  }

  # hv_exists was buggy for tied hashes, in that the raw utf8 key was being
  # used - the utf8 flag was being lost.
  perform_test (\&test_absent, (chr 258), $keys, '');

  perform_test (\&test_fetch_absent, (chr 258), $keys, '');
  perform_test (\&test_delete_absent, (chr 258), $keys, '');
}

sub main_test_inner {
  my ($key, $lckey, $unikey, $keys, $description) = @_;
  perform_test (\&test_present, $key, $keys, $description);
  perform_test (\&test_fetch_present, $key, $keys, $description);
  perform_test (\&test_delete_present, $key, $keys, $description);

  perform_test (\&test_store, $key, $keys, $description, [a=>'cheat']);
  perform_test (\&test_store, $key, $keys, $description, []);

  perform_test (\&test_absent, $lckey, $keys, $description);
  perform_test (\&test_fetch_absent, $lckey, $keys, $description);
  perform_test (\&test_delete_absent, $lckey, $keys, $description);

  return if $unikey eq $key;

  perform_test (\&test_absent, $unikey, $keys, $description);
  perform_test (\&test_fetch_absent, $unikey, $keys, $description);
  perform_test (\&test_delete_absent, $unikey, $keys, $description);
}

sub perform_test {
  my ($test_sub, $key, $keys, $message, @other) = @_;
  my $printable = join ',', map {ord} split //, $key;

  my (%hash, %tiehash);
  tie %tiehash, 'Tie::StdHash';

  @hash{@$keys} = @$keys;
  @tiehash{@$keys} = @$keys;

  &$test_sub (\%hash, $key, $printable, $message, @other);
  &$test_sub (\%tiehash, $key, $printable, "$message tie", @other);
}

sub test_present {
  my ($hash, $key, $printable, $message) = @_;

  ok (exists $hash->{$key}, "hv_exists_ent present$message $printable");
  ok (XS::APItest::Hash::exists ($hash, $key),
      "hv_exists present$message $printable");
}

sub test_absent {
  my ($hash, $key, $printable, $message) = @_;

  ok (!exists $hash->{$key}, "hv_exists_ent absent$message $printable");
  ok (!XS::APItest::Hash::exists ($hash, $key),
      "hv_exists absent$message $printable");
}

sub test_delete_present {
  my ($hash, $key, $printable, $message) = @_;

  my $copy = {};
  my $class = tied %$hash;
  if (defined $class) {
    tie %$copy, ref $class;
  }
  $copy = {%$hash};
  ok (brute_force_exists ($copy, $key),
      "hv_delete_ent present$message $printable");
  is (delete $copy->{$key}, $key, "hv_delete_ent present$message $printable");
  ok (!brute_force_exists ($copy, $key),
      "hv_delete_ent present$message $printable");
  $copy = {%$hash};
  ok (brute_force_exists ($copy, $key),
      "hv_delete present$message $printable");
  is (XS::APItest::Hash::delete ($copy, $key), $key,
      "hv_delete present$message $printable");
  ok (!brute_force_exists ($copy, $key),
      "hv_delete present$message $printable");
}

sub test_delete_absent {
  my ($hash, $key, $printable, $message) = @_;

  my $copy = {};
  my $class = tied %$hash;
  if (defined $class) {
    tie %$copy, ref $class;
  }
  $copy = {%$hash};
  is (delete $copy->{$key}, undef, "hv_delete_ent absent$message $printable");
  $copy = {%$hash};
  is (XS::APItest::Hash::delete ($copy, $key), undef,
      "hv_delete absent$message $printable");
}

sub test_store {
  my ($hash, $key, $printable, $message, $defaults) = @_;
  my $HV_STORE_IS_CRAZY = 1;

  # We are cheating - hv_store returns NULL for a store into an empty
  # tied hash. This isn't helpful here.

  my $class = tied %$hash;

  my %h1 = @$defaults;
  my %h2 = @$defaults;
  if (defined $class) {
    tie %h1, ref $class;
    tie %h2, ref $class;
    $HV_STORE_IS_CRAZY = undef;
  }
  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,
      "hv_store$message $printable");
  ok (brute_force_exists (\%h2, $key), "hv_store$message $printable");
}

sub test_fetch_present {
  my ($hash, $key, $printable, $message) = @_;

  is ($hash->{$key}, $key, "hv_fetch_ent present$message $printable");
  is (XS::APItest::Hash::fetch ($hash, $key), $key,
      "hv_fetch present$message $printable");
}

sub test_fetch_absent {
  my ($hash, $key, $printable, $message) = @_;

  is ($hash->{$key}, undef, "hv_fetch_ent absent$message $printable");
  is (XS::APItest::Hash::fetch ($hash, $key), undef,
      "hv_fetch absent$message $printable");
}

sub brute_force_exists {
  my ($hash, $key) = @_;
  foreach (keys %$hash) {
    return 1 if $key eq $_;
  }
  return 0;
}

sub rot13 {
    my @results = map {my $a = $_; $a =~ tr/A-Za-z/N-ZA-Mn-za-m/; $a} @_;
    wantarray ? @results : $results[0];
}
Commit	Line	Data
0314122a NC	1	#!perl -w
	2
	3	BEGIN {
	4	chdir 't' if -d 't';
	5	@INC = '../lib';
	6	push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS';
	7	require Config; import Config;
	8	if ($Config{'extensions'} !~ /\bXS\/APItest\b/) {
	9	# Look, I'm using this fully-qualified variable more than once!
	10	my $arch = $MacPerl::Architecture;
	11	print "1..0 # Skip: XS::APItest was not built\n";
	12	exit 0;
	13	}
	14	}
	15
3128e575 NC	16	use strict;
3128e575 NC	17	use utf8;
0314122a	18	use Tie::Hash;
3128e575 NC	19	use Test::More 'no_plan';
3128e575 NC	20
55289a74	21	BEGIN {use_ok('XS::APItest')};
0314122a	22
3128e575 NC	23	sub preform_test;
	24	sub test_present;
	25	sub test_absent;
	26	sub test_delete_present;
	27	sub test_delete_absent;
	28	sub brute_force_exists;
	29	sub test_store;
	30	sub test_fetch_present;
	31	sub test_fetch_absent;
0314122a	32
b60cf05a NC	33	my $utf8_for_258 = chr 258;
b60cf05a NC	34	utf8::encode $utf8_for_258;
0314122a	35
3128e575	36	my @testkeys = ('N', chr 198, chr 256);
b60cf05a	37	my @keys = (@testkeys, $utf8_for_258);
0314122a	38
3128e575 NC	39	foreach (@keys) {
	40	utf8::downgrade $_, 1;
	41	}
	42	main_tests (\@keys, \@testkeys, '');
0314122a	43
3128e575 NC	44	foreach (@keys) {
	45	utf8::upgrade $_;
	46	}
	47	main_tests (\@keys, \@testkeys, ' [utf8 hash]');
0314122a	48
3128e575 NC	49	{
	50	my %h = (a=>'cheat');
	51	tie %h, 'Tie::StdHash';
1baaf5d7	52	is (XS::APItest::Hash::store(\%h, chr 258, 1), undef);
3128e575 NC	53
	54	ok (!exists $h{$utf8_for_258},
	55	"hv_store doesn't insert a key with the raw utf8 on a tied hash");
	56	}
0314122a	57
5d2b1485 NC	58	{
	59	my $strtab = strtab();
	60	is (ref $strtab, 'HASH', "The shared string table quacks like a hash");
8ca60cef	61	my $wibble = "\0";
5d2b1485	62	eval {
8ca60cef	63	$strtab->{$wibble}++;
5d2b1485 NC	64	};
	65	my $prefix = "Cannot modify shared string table in hv_";
	66	my $what = $prefix . 'fetch';
	67	like ($@, qr/^$what/,$what);
	68	eval {
	69	XS::APItest::Hash::store($strtab, 'Boom!', 1)
	70	};
	71	$what = $prefix . 'store';
	72	like ($@, qr/^$what/, $what);
	73	if (0) {
	74	A::B->method();
	75	}
	76	# DESTROY should be in there.
	77	eval {
	78	delete $strtab->{DESTROY};
	79	};
	80	$what = $prefix . 'delete';
	81	like ($@, qr/^$what/, $what);
	82	# I can't work out how to get to the code that flips the wasutf8 flag on
	83	# the hash key without some ikcy XS
	84	}
2dc92170 NC	85
	86	{
	87	is_deeply([&XS::APItest::Hash::test_hv_free_ent], [2,2,1,1],
	88	"hv_free_ent frees the value immediately");
	89	is_deeply([&XS::APItest::Hash::test_hv_delayfree_ent], [2,2,2,1],
	90	"hv_delayfree_ent keeps the value around until FREETMPS");
	91	}
35ab5632 NC	92
	93	foreach my $in ("", "N", "a\0b") {
	94	my $got = XS::APItest::Hash::test_share_unshare_pvn($in);
	95	is ($got, $in, "test_share_unshare_pvn");
	96	}
	97
55289a74	98	if ($] > 5.009) {
b54b4831 NC	99	my %hash;
	100	XS::APItest::Hash::rot13_hash(\%hash);
	101	$hash{a}++; @hash{qw(p i e)} = (2, 4, 8);
	102
	103	my @keys = sort keys %hash;
	104	is("@keys", join(' ', sort(rot13(qw(a p i e)))),
	105	"uvar magic called exactly once on store");
	106
	107	is($hash{i}, 4);
55289a74 NC	108
	109	is(delete $hash{a}, 1);
	110
	111	is(keys %hash, 3);
	112	@keys = sort keys %hash;
	113	is("@keys", join(' ', sort(rot13(qw(p i e)))));
	114
	115	is (XS::APItest::Hash::delete_ent (\%hash, 'p',
	116	XS::APItest::HV_DISABLE_UVAR_XKEY),
	117	undef, "Deleting a known key with conversion disabled fails (ent)");
	118	is(keys %hash, 3);
	119
	120	is (XS::APItest::Hash::delete_ent (\%hash, 'p', 0),
	121	2, "Deleting a known key with conversion enabled works (ent)");
	122	is(keys %hash, 2);
	123	@keys = sort keys %hash;
	124	is("@keys", join(' ', sort(rot13(qw(i e)))));
	125
	126	is (XS::APItest::Hash::delete (\%hash, 'i',
	127	XS::APItest::HV_DISABLE_UVAR_XKEY),
	128	undef, "Deleting a known key with conversion disabled fails");
	129	is(keys %hash, 2);
	130
	131	is (XS::APItest::Hash::delete (\%hash, 'i', 0),
	132	4, "Deleting a known key with conversion enabled works");
	133	is(keys %hash, 1);
	134	@keys = sort keys %hash;
	135	is("@keys", join(' ', sort(rot13(qw(e)))));
bdee33e4 NC	136
	137	$hash{f} = 9;
	138	is(keys %hash, 2);
	139	@keys = sort keys %hash;
	140	is("@keys", join(' ', sort(rot13(qw(e f)))));
	141
	142	is (XS::APItest::Hash::store_ent(\%hash, 'g', 10), 10, "store_ent");
	143	is(keys %hash, 3);
	144	@keys = sort keys %hash;
	145	is("@keys", join(' ', sort(rot13(qw(e f g)))));
	146
	147	is (XS::APItest::Hash::store(\%hash, 'h', 11), 11, "store");
	148	is(keys %hash, 4);
	149	@keys = sort keys %hash;
	150	is("@keys", join(' ', sort(rot13(qw(e f g h)))));
	151
	152	is (XS::APItest::Hash::fetch_ent(\%hash, 'g'), 10, "fetch_ent");
	153	is (XS::APItest::Hash::fetch_ent(\%hash, rot13('g')), undef,
	154	"fetch_ent (missing)");
	155
	156	is (XS::APItest::Hash::fetch(\%hash, 'h'), 11, "fetch");
	157	is (XS::APItest::Hash::fetch(\%hash, rot13('h')), undef,
	158	"fetch (missing)");
	159
	160	ok (XS::APItest::Hash::exists_ent(\%hash, 'e'), "exists_ent");
	161	ok (!XS::APItest::Hash::exists_ent(\%hash, rot13('e')),
	162	"exists_ent (missing)");
	163
	164	ok (XS::APItest::Hash::exists(\%hash, 'f'), "exists");
	165	ok (!XS::APItest::Hash::exists(\%hash, rot13('f')), "exists (missing)");
b54b4831 NC	166	}
b54b4831 NC	167
3128e575	168	exit;
0314122a	169
3128e575	170	################################ The End ################################
0314122a	171
3128e575 NC	172	sub main_tests {
	173	my ($keys, $testkeys, $description) = @_;
	174	foreach my $key (@$testkeys) {
	175	my $lckey = ($key eq chr 198) ? chr 230 : lc $key;
	176	my $unikey = $key;
	177	utf8::encode $unikey;
0314122a	178
3128e575 NC	179	utf8::downgrade $key, 1;
	180	utf8::downgrade $lckey, 1;
	181	utf8::downgrade $unikey, 1;
	182	main_test_inner ($key, $lckey, $unikey, $keys, $description);
0314122a	183
3128e575 NC	184	utf8::upgrade $key;
	185	utf8::upgrade $lckey;
	186	utf8::upgrade $unikey;
	187	main_test_inner ($key, $lckey, $unikey, $keys,
	188	$description . ' [key utf8 on]');
	189	}
0314122a	190
3128e575 NC	191	# hv_exists was buggy for tied hashes, in that the raw utf8 key was being
	192	# used - the utf8 flag was being lost.
	193	perform_test (\&test_absent, (chr 258), $keys, '');
0314122a	194
3128e575 NC	195	perform_test (\&test_fetch_absent, (chr 258), $keys, '');
3128e575 NC	196	perform_test (\&test_delete_absent, (chr 258), $keys, '');
0314122a NC	197	}
0314122a NC	198
3128e575 NC	199	sub main_test_inner {
	200	my ($key, $lckey, $unikey, $keys, $description) = @_;
	201	perform_test (\&test_present, $key, $keys, $description);
	202	perform_test (\&test_fetch_present, $key, $keys, $description);
	203	perform_test (\&test_delete_present, $key, $keys, $description);
b60cf05a	204
3128e575 NC	205	perform_test (\&test_store, $key, $keys, $description, [a=>'cheat']);
3128e575 NC	206	perform_test (\&test_store, $key, $keys, $description, []);
b60cf05a	207
3128e575 NC	208	perform_test (\&test_absent, $lckey, $keys, $description);
	209	perform_test (\&test_fetch_absent, $lckey, $keys, $description);
	210	perform_test (\&test_delete_absent, $lckey, $keys, $description);
b60cf05a	211
3128e575 NC	212	return if $unikey eq $key;
	213
	214	perform_test (\&test_absent, $unikey, $keys, $description);
	215	perform_test (\&test_fetch_absent, $unikey, $keys, $description);
	216	perform_test (\&test_delete_absent, $unikey, $keys, $description);
b60cf05a NC	217	}
b60cf05a NC	218
3128e575 NC	219	sub perform_test {
3128e575 NC	220	my ($test_sub, $key, $keys, $message, @other) = @_;
b60cf05a NC	221	my $printable = join ',', map {ord} split //, $key;
b60cf05a NC	222
3128e575 NC	223	my (%hash, %tiehash);
3128e575 NC	224	tie %tiehash, 'Tie::StdHash';
b60cf05a	225
3128e575 NC	226	@hash{@$keys} = @$keys;
3128e575 NC	227	@tiehash{@$keys} = @$keys;
b60cf05a	228
3128e575 NC	229	&$test_sub (\%hash, $key, $printable, $message, @other);
3128e575 NC	230	&$test_sub (\%tiehash, $key, $printable, "$message tie", @other);
b60cf05a NC	231	}
b60cf05a NC	232
3128e575 NC	233	sub test_present {
	234	my ($hash, $key, $printable, $message) = @_;
	235
	236	ok (exists $hash->{$key}, "hv_exists_ent present$message $printable");
	237	ok (XS::APItest::Hash::exists ($hash, $key),
	238	"hv_exists present$message $printable");
b60cf05a NC	239	}
b60cf05a NC	240
3128e575 NC	241	sub test_absent {
3128e575 NC	242	my ($hash, $key, $printable, $message) = @_;
858117f8	243
3128e575 NC	244	ok (!exists $hash->{$key}, "hv_exists_ent absent$message $printable");
	245	ok (!XS::APItest::Hash::exists ($hash, $key),
	246	"hv_exists absent$message $printable");
b60cf05a NC	247	}
b60cf05a NC	248
3128e575 NC	249	sub test_delete_present {
3128e575 NC	250	my ($hash, $key, $printable, $message) = @_;
b60cf05a	251
3128e575 NC	252	my $copy = {};
	253	my $class = tied %$hash;
	254	if (defined $class) {
	255	tie %$copy, ref $class;
	256	}
	257	$copy = {%$hash};
8829b5e2 NC	258	ok (brute_force_exists ($copy, $key),
8829b5e2 NC	259	"hv_delete_ent present$message $printable");
3128e575	260	is (delete $copy->{$key}, $key, "hv_delete_ent present$message $printable");
8829b5e2 NC	261	ok (!brute_force_exists ($copy, $key),
8829b5e2 NC	262	"hv_delete_ent present$message $printable");
3128e575	263	$copy = {%$hash};
8829b5e2 NC	264	ok (brute_force_exists ($copy, $key),
8829b5e2 NC	265	"hv_delete present$message $printable");
3128e575 NC	266	is (XS::APItest::Hash::delete ($copy, $key), $key,
3128e575 NC	267	"hv_delete present$message $printable");
8829b5e2 NC	268	ok (!brute_force_exists ($copy, $key),
8829b5e2 NC	269	"hv_delete present$message $printable");
b60cf05a NC	270	}
b60cf05a NC	271
3128e575 NC	272	sub test_delete_absent {
3128e575 NC	273	my ($hash, $key, $printable, $message) = @_;
b60cf05a	274
3128e575 NC	275	my $copy = {};
	276	my $class = tied %$hash;
	277	if (defined $class) {
	278	tie %$copy, ref $class;
	279	}
	280	$copy = {%$hash};
	281	is (delete $copy->{$key}, undef, "hv_delete_ent absent$message $printable");
	282	$copy = {%$hash};
	283	is (XS::APItest::Hash::delete ($copy, $key), undef,
	284	"hv_delete absent$message $printable");
b60cf05a NC	285	}
b60cf05a NC	286
3128e575 NC	287	sub test_store {
	288	my ($hash, $key, $printable, $message, $defaults) = @_;
	289	my $HV_STORE_IS_CRAZY = 1;
b60cf05a	290
3128e575 NC	291	# We are cheating - hv_store returns NULL for a store into an empty
3128e575 NC	292	# tied hash. This isn't helpful here.
0314122a	293
3128e575	294	my $class = tied %$hash;
0314122a	295
3128e575 NC	296	my %h1 = @$defaults;
	297	my %h2 = @$defaults;
	298	if (defined $class) {
	299	tie %h1, ref $class;
	300	tie %h2, ref $class;
1baaf5d7	301	$HV_STORE_IS_CRAZY = undef;
3128e575	302	}
1baaf5d7	303	is (XS::APItest::Hash::store_ent(\%h1, $key, 1), $HV_STORE_IS_CRAZY,
3128e575 NC	304	"hv_store_ent$message $printable");
	305	ok (brute_force_exists (\%h1, $key), "hv_store_ent$message $printable");
	306	is (XS::APItest::Hash::store(\%h2, $key, 1), $HV_STORE_IS_CRAZY,
	307	"hv_store$message $printable");
	308	ok (brute_force_exists (\%h2, $key), "hv_store$message $printable");
	309	}
0314122a	310
3128e575 NC	311	sub test_fetch_present {
3128e575 NC	312	my ($hash, $key, $printable, $message) = @_;
b60cf05a	313
3128e575 NC	314	is ($hash->{$key}, $key, "hv_fetch_ent present$message $printable");
	315	is (XS::APItest::Hash::fetch ($hash, $key), $key,
	316	"hv_fetch present$message $printable");
0314122a NC	317	}
0314122a NC	318
3128e575 NC	319	sub test_fetch_absent {
3128e575 NC	320	my ($hash, $key, $printable, $message) = @_;
b60cf05a	321
3128e575 NC	322	is ($hash->{$key}, undef, "hv_fetch_ent absent$message $printable");
	323	is (XS::APItest::Hash::fetch ($hash, $key), undef,
	324	"hv_fetch absent$message $printable");
	325	}
b60cf05a	326
3128e575 NC	327	sub brute_force_exists {
	328	my ($hash, $key) = @_;
	329	foreach (keys %$hash) {
	330	return 1 if $key eq $_;
	331	}
	332	return 0;
b60cf05a	333	}
b54b4831 NC	334
	335	sub rot13 {
	336	my @results = map {my $a = $_; $a =~ tr/A-Za-z/N-ZA-Mn-za-m/; $a} @_;
	337	wantarray ? @results : $results[0];
	338	}