Gecko [ www.blackthorn-inc.com ]

Linux cpanel2.daytoncreative.net 2.6.32-754.29.2.el6.x86_64 #1 SMP Tue May 12 17:39:04 UTC 2020 x86_64
Apache/2.4.43 (cPanel) OpenSSL/1.1.1g mod_bwlimited/1.4
Server IP : 70.62.220.67 & Your IP : 216.73.216.193
Domains : Cant Read [ /etc/named.conf ]
User : michaelgreg

Name	Size	Permission	Date
rebless.t	533 B	-r--r--r--	2014-12-27 11:48
refhash.t	8.64 KB	-r--r--r--	2014-12-27 11:48
storable.t	1.71 KB	-r--r--r--	2014-12-27 11:48
threaded.t	1.92 KB	-r--r--r--	2014-12-27 11:48

#!/usr/bin/perl -T -w

BEGIN {
    if( $ENV{PERL_CORE} ) {
        chdir 't';
        @INC = '../lib';
    }
}

BEGIN {
  unless ( eval { require Storable; 1 } ){
    print "1..0 # Skip -- Storable is not available\n";
    exit 0;
  }
}

use strict;

use Tie::RefHash;

use Storable qw/dclone nfreeze thaw/;

$\ = "\n";
print "1..42";

sub ok ($$) {
    print ( ( $_[0] ? "" : "not " ), "ok - $_[1]" );
}

sub is ($$$) {
    print ( ( ( $_[0] eq $_[1] ) ? "" : "not "), "ok - $_[2]" );
}

sub isa_ok ($$) {
    ok( eval { $_[0]->isa($_[1]) }, "the object isa $_[1]");
}

tie my %hash, "Tie::RefHash";

my $key = { foo => 1 };
$hash{$key} = "value";
$hash{non_ref} = "other";

foreach my $clone ( \%hash, dclone(\%hash), thaw(nfreeze(\%hash)) ){

ok( tied(%$clone), "copy is tied");
  isa_ok( tied(%$clone), "Tie::RefHash" );

my @keys = keys %$clone;
  is( scalar(@keys), 2, "two keys in clone");
  my $key = ref($keys[0]) ? shift @keys : pop @keys;
  my $reg = $keys[0];

ok( ref($key), "key is a ref after clone" );
  is( $key->{foo}, 1, "key serialized ok");

is( $clone->{$key}, "value", "and is still pointing at the same value" );

ok( !ref($reg), "regular key is non ref" );
  is( $clone->{$reg}, "other", "and is also a valid key" );
}

tie my %only_refs, "Tie::RefHash";
$only_refs{$key} = "value";

foreach my $clone ( \%only_refs, dclone(\%only_refs), thaw(nfreeze(\%only_refs)) ){

ok( tied(%$clone), "copy is tied");
  isa_ok( tied(%$clone), "Tie::RefHash" );

my @keys = keys %$clone;
  is( scalar(@keys), 1, "one key in clone");
  my $key = $keys[0];

ok( ref($key), "key is a ref after clone" );
  is( $key->{foo}, 1, "key serialized ok");

is( $clone->{$key}, "value", "and is still pointing at the same value" );
}