1# -*- perl -*- 2# 3# Storable test for Set::Object objects 4 5use strict; 6 7BEGIN { 8 eval "use Storable qw(freeze thaw dclone)"; 9 if ($@) { 10 eval 'use Test::More skip_all => "Storable not installed"'; 11 exit(0); 12 } else { 13 eval 'use Test::More tests => 7'; 14 } 15} 16 17use_ok("Set::Object", qw(refaddr)); 18my $objects = [ map { bless { $_ => rand(42) }, $_ } 19 qw(Barnie Fred Wilma) ]; 20 21my $stored = freeze ($objects); 22is_deeply(thaw($stored), $objects, "Storable works"); 23 24my $set = Set::Object->new(@$objects); 25$stored = freeze($set); 26 27use Data::Dumper; 28#print Dumper $stored; 29 30my $returned = thaw($stored); 31#print "no segfault yet!\n"; 32#diag(Dumper($returned, $set)); 33is_deeply([ sort { ref($a) cmp ref($b) } $returned->members ], 34 [ sort { ref($a) cmp ref($b) } $set->members ], 35 "Set::Object serialises via Storable!"); 36isnt($$returned, $$set, "thaw returned a new Set::Object"); 37 38my $spawned = dclone($set); 39is_deeply([ sort { ref($a) cmp ref($b) } $spawned->members ], 40 [ sort { ref($a) cmp ref($b) } $set->members ], 41 "Set::Object dclones via Storable!"); 42isnt($$spawned, $$set, "dclone returned a new Set::Object"); 43 44my $old; 45my $test = dclone ($old = [ map { Set::Object->new() } (1..1000) ]); 46 47is(@$old, @$test, "empty sets"); 48 49