5 use Test::More tests => 11;
7 use t::common qw( new_fh );
12 my ($fh, $filename) = new_fh();
13 my $db = DBM::Deep->new({
19 # Create structure in memory
24 array1 => [ "elem0", "elem1", "elem2" ],
26 subkey1 => "subvalue1",
27 subkey2 => "subvalue2",
28 subkey3 => bless( {}, 'Foo' ),
32 $db->import( $struct );
39 array1 => [ 'elem0', 'elem1', 'elem2', ],
41 subkey1 => "subvalue1",
42 subkey2 => "subvalue2",
43 subkey3 => useclass( bless {}, 'Foo' ),
49 $struct->{foo} = 'bar';
50 is( $struct->{foo}, 'bar', "\$struct has foo and it's 'bar'" );
51 ok( !exists $db->{foo}, "\$db doesn't have the 'foo' key, so \$struct is not tied" );
53 $struct->{hash1}->{foo} = 'bar';
54 is( $struct->{hash1}->{foo}, 'bar', "\$struct->{hash1} has foo and it's 'bar'" );
55 ok( !exists $db->{hash1}->{foo}, "\$db->{hash1} doesn't have the 'foo' key, so \$struct->{hash1} is not tied" );
59 diag "\nThere seems to be a bug in Clone on Perl 5.9+ that is causing\nthese tests to fail."
62 my ($fh, $filename) = new_fh();
63 my $db = DBM::Deep->new({
65 type => DBM::Deep->TYPE_ARRAY,
72 { foo => [ 2 .. 4 ] },
75 $db->import( $struct );
82 useclass( bless( [], 'Bar' ) ),
83 { foo => [ 2 .. 4 ] },
89 is( $struct->[-1], 'bar', "\$struct has 'bar' at the end" );
90 ok( $db->[-1], "\$db doesn't have the 'bar' value at the end, so \$struct is not tied" );
93 # Failure case to verify that rollback occurs
95 my ($fh, $filename) = new_fh();
96 my $db = DBM::Deep->new({
111 $db->import( $struct );
113 like( $@, qr/Storage of references of type 'SCALAR' is not supported/, 'Error message correct' );
116 local $TODO = "Importing cannot occur within a transaction yet.";
122 "Everything matches",
129 Need to add tests for:
130 - Failure case (have something tied or a glob or something like that)
131 - Where we already have $db->{hash1} to make sure that it's not overwritten