Children are now tied directly instead of copied. This makes code behave more as...
[dbsrgits/DBM-Deep.git] / t / 19_crossref.t
CommitLineData
ffed8b01 1##
2# DBM::Deep Test
3##
4use strict;
9d4fa373 5use Test::More tests => 6;
6use Test::Exception;
98ac82af 7use File::Temp qw( tempfile tempdir );
58910373 8use Fcntl qw( :flock );
ffed8b01 9
10use_ok( 'DBM::Deep' );
11
98ac82af 12my $dir = tempdir( CLEANUP => 1 );
13my ($fh2, $filename2) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
58910373 14flock $fh2, LOCK_UN;
98ac82af 15my $db2 = DBM::Deep->new( $filename2 );
16
17{
18 my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
58910373 19 flock $fh, LOCK_UN;
98ac82af 20 my $db = DBM::Deep->new( $filename );
21
22 ##
23 # Create structure in $db
24 ##
25 $db->import(
26 hash1 => {
27 subkey1 => "subvalue1",
c9cec40e 28 subkey2 => "subvalue2",
98ac82af 29 }
30 );
98ac82af 31 is( $db->{hash1}{subkey1}, 'subvalue1', "Value imported correctly" );
32 is( $db->{hash1}{subkey2}, 'subvalue2', "Value imported correctly" );
33
34 ##
35 # Cross-ref nested hash accross DB objects
36 ##
9d4fa373 37 throws_ok {
38 $db2->{copy} = $db->{hash1};
39 } qr/Cannot cross-reference\. Use export\(\) instead/, "cross-ref fails";
40 $db2->{copy} = $db->{hash1}->export;
98ac82af 41}
ffed8b01 42
43##
44# Make sure $db2 has copy of $db's hash structure
45##
46is( $db2->{copy}{subkey1}, 'subvalue1', "Value copied correctly" );
47is( $db2->{copy}{subkey2}, 'subvalue2', "Value copied correctly" );