1#!/usr/bin/perl -w 2 3BEGIN { 4 chdir 't' if -d 't'; 5 require './test.pl'; 6 set_up_inc( '../lib' ); 7 skip_all_without_dynamic_extension("Devel::Peek"); 8 skip_all_without_dynamic_extension("Hash::Util"); 9} 10 11use strict; 12use Devel::Peek; 13use Hash::Util qw(lock_keys_plus); 14 15my %hash = (chr 255 => 42, chr 256 => 6 * 9); 16lock_keys_plus(%hash, "baz"); 17 18my $tempfile = tempfile(); 19 20local *OLDERR; 21open(OLDERR, ">&STDERR") || die "Can't dup STDERR: $!"; 22open(STDERR, ">", $tempfile) || 23 die "Could not open '$tempfile' for write: $^E"; 24 25my $sep = "=-=-=-=\n"; 26Dump \%hash; 27print STDERR $sep; 28delete $hash{chr 255}; 29Internals::hv_clear_placeholders(%hash); 30Dump \%hash; 31print STDERR $sep; 32delete $hash{chr 256}; 33Internals::hv_clear_placeholders(%hash); 34Dump \%hash; 35 36open(STDERR, ">&OLDERR") || die "Can't dup OLDERR: $!"; 37open(my $fh, "<", $tempfile) || 38 die "Could not open '$tempfile' for read: $^E"; 39local $/; 40my $got = <$fh>; 41 42my ($first, $second, $third) = split $sep, $got; 43 44like($first, qr/\bPERL_MAGIC_rhash\b/, 'first dump has rhash magic'); 45like($second, qr/\bPERL_MAGIC_rhash\b/, 'second dump has rhash magic'); 46like($third, qr/\bPERL_MAGIC_rhash\b/, 'third dump has rhash magic'); 47 48like($first, qr/\bHASKFLAGS\b/, 'first dump has HASHKFLAGS set'); 49like($second, qr/\bHASKFLAGS\b/, 'second dump has HASHKFLAGS set'); 50unlike($third, qr/\bHASKFLAGS\b/, 'third dump has HASHKFLAGS clear'); 51 52like($first, qr/\bMG_LEN = 1\b/, 'first dump has 1 placeholder'); 53unlike($second, qr/\bMG_LEN\b/, 'second dump has 0 placeholders'); 54unlike($third, qr/\bMG_LEN\b/, 'third dump has 0 placeholders'); 55 56done_testing(); 57