5 use Test::More tests => 32;
6 use File::Temp qw( tempfile tempdir );
7 use Fcntl qw( :flock );
11 my $dir = tempdir( CLEANUP => 1 );
12 my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
14 my $db = DBM::Deep->new( $filename );
19 $db->{key1} = "value1";
20 $db->{key2} = "value2";
22 my @keys_1 = sort keys %$db;
24 $db->{key3} = $db->{key1};
26 my @keys_2 = sort keys %$db;
27 is( @keys_2 + 0, @keys_1 + 1, "Correct number of keys" );
31 "Keys still match after circular reference is added",
34 $db->{key4} = { 'foo' => 'bar' };
35 $db->{key5} = $db->{key4};
36 $db->{key6} = $db->{key5};
38 my @keys_3 = sort keys %$db;
40 is( @keys_3 + 0, @keys_2 + 3, "Correct number of keys" );
42 [ @keys_2, 'key4', 'key5', 'key6', ],
44 "Keys still match after circular reference is added (@keys_3)",
48 # Insert circular reference
52 my @keys_4 = sort keys %$db;
54 is( @keys_4 + 0, @keys_3 + 1, "Correct number of keys" );
56 [ 'circle', @keys_3 ],
58 "Keys still match after circular reference is added",
62 # Make sure keys exist in both places
64 is( $db->{key1}, 'value1', "The value is there directly" );
65 is( $db->{circle}{key1}, 'value1', "The value is there in one loop of the circle" );
66 is( $db->{circle}{circle}{key1}, 'value1', "The value is there in two loops of the circle" );
67 is( $db->{circle}{circle}{circle}{key1}, 'value1', "The value is there in three loops of the circle" );
70 # Make sure changes are reflected in both places
72 $db->{key1} = "another value";
74 isnt( $db->{key3}, 'another value', "Simple scalars are copied by value" );
76 is( $db->{key1}, 'another value', "The value is there directly" );
77 is( $db->{circle}{key1}, 'another value', "The value is there in one loop of the circle" );
78 is( $db->{circle}{circle}{key1}, 'another value', "The value is there in two loops of the circle" );
79 is( $db->{circle}{circle}{circle}{key1}, 'another value', "The value is there in three loops of the circle" );
81 $db->{circle}{circle}{circle}{circle}{key1} = "circles";
83 is( $db->{key1}, 'circles', "The value is there directly" );
84 is( $db->{circle}{key1}, 'circles', "The value is there in one loop of the circle" );
85 is( $db->{circle}{circle}{key1}, 'circles', "The value is there in two loops of the circle" );
86 is( $db->{circle}{circle}{circle}{key1}, 'circles', "The value is there in three loops of the circle" );
88 is( $db->{key4}{foo}, 'bar' );
89 is( $db->{key5}{foo}, 'bar' );
90 is( $db->{key6}{foo}, 'bar' );
92 $db->{key4}{foo2} = 'bar2';
93 is( $db->{key4}{foo2}, 'bar2' );
94 is( $db->{key5}{foo2}, 'bar2' );
95 is( $db->{key6}{foo2}, 'bar2' );
97 $db->{key4}{foo3} = 'bar3';
98 is( $db->{key4}{foo3}, 'bar3' );
99 is( $db->{key5}{foo3}, 'bar3' );
100 is( $db->{key6}{foo3}, 'bar3' );
102 $db->{key4}{foo4} = 'bar4';
103 is( $db->{key4}{foo4}, 'bar4' );
104 is( $db->{key5}{foo4}, 'bar4' );
105 is( $db->{key6}{foo4}, 'bar4' );