r592@rob-kinyons-computer-2 (orig r10555): rkinyon | 2008-01-15 14:19:42 -0500
[dbsrgits/DBM-Deep.git] / t / 19_crossref.t
CommitLineData
ffed8b01 1##
2# DBM::Deep Test
3##
4use strict;
e137c258 5use Test::More tests => 9;
9d4fa373 6use Test::Exception;
fde3db1a 7use t::common qw( new_fh );
ffed8b01 8
9use_ok( 'DBM::Deep' );
10
fde3db1a 11my ($fh2, $filename2) = new_fh();
0856d3d8 12my $db2 = DBM::Deep->new( file => $filename2, fh => $fh2, );
98ac82af 13
e137c258 14SKIP: {
15 skip "Apparently, we cannot detect a tied scalar?", 1;
16 tie my $foo, 'Tied::Scalar';
17 throws_ok {
18 $db2->{failure} = $foo;
19 } qr/Cannot store something that is tied\./, "tied scalar storage fails";
20}
21
22{
23 tie my @foo, 'Tied::Array';
24 throws_ok {
25 $db2->{failure} = \@foo;
26 } qr/Cannot store something that is tied\./, "tied array storage fails";
27}
28
29{
30 tie my %foo, 'Tied::Hash';
31 throws_ok {
32 $db2->{failure} = \%foo;
33 } qr/Cannot store something that is tied\./, "tied hash storage fails";
34}
35
98ac82af 36{
fde3db1a 37 my ($fh, $filename) = new_fh();
0856d3d8 38 my $db = DBM::Deep->new( file => $filename, fh => $fh, );
98ac82af 39
40 ##
41 # Create structure in $db
42 ##
4301e879 43 $db->import({
98ac82af 44 hash1 => {
45 subkey1 => "subvalue1",
c9cec40e 46 subkey2 => "subvalue2",
98ac82af 47 }
4301e879 48 });
98ac82af 49 is( $db->{hash1}{subkey1}, 'subvalue1', "Value imported correctly" );
50 is( $db->{hash1}{subkey2}, 'subvalue2', "Value imported correctly" );
9a63e1f2 51
52 # Test cross-ref nested hash accross DB objects
9d4fa373 53 throws_ok {
54 $db2->{copy} = $db->{hash1};
e137c258 55 } qr/Cannot store values across DBM::Deep files\. Please use export\(\) instead\./, "cross-ref fails";
9a63e1f2 56
57 # This error text is for when internal cross-refs are implemented
58 #} qr/Cannot cross-reference\. Use export\(\) instead\./, "cross-ref fails";
59
9d4fa373 60 $db2->{copy} = $db->{hash1}->export;
98ac82af 61}
ffed8b01 62
63##
64# Make sure $db2 has copy of $db's hash structure
65##
66is( $db2->{copy}{subkey1}, 'subvalue1', "Value copied correctly" );
67is( $db2->{copy}{subkey2}, 'subvalue2', "Value copied correctly" );
e137c258 68
69package Tied::Scalar;
70sub TIESCALAR { bless {}, $_[0]; }
71sub FETCH{}
72
73package Tied::Array;
74sub TIEARRAY { bless {}, $_[0]; }
75
76package Tied::Hash;
77sub TIEHASH { bless {}, $_[0]; }