Added recursion test, hoisted staleness() to Sector.pm, and refactored to write_bucke...
[dbsrgits/DBM-Deep.git] / t / 19_crossref.t
CommitLineData
ffed8b01 1use strict;
0e3e3555 2use warnings FATAL => 'all';
3
4use Test::More;
9d4fa373 5use Test::Exception;
0e3e3555 6use t::common qw( new_dbm );
ffed8b01 7
8use_ok( 'DBM::Deep' );
9
0e3e3555 10my $dbm_factory = new_dbm();
11while ( my $dbm_maker = $dbm_factory->() ) {
12 my $db = $dbm_maker->();
98ac82af 13
0e3e3555 14 SKIP: {
15 skip "Apparently, we cannot detect a tied scalar?", 1;
16 tie my $foo, 'Tied::Scalar';
17 throws_ok {
18 $db->{failure} = $foo;
19 } qr/Cannot store something that is tied\./, "tied scalar storage fails";
20 }
1cff45d7 21
0e3e3555 22 {
23 tie my @foo, 'Tied::Array';
24 throws_ok {
25 $db->{failure} = \@foo;
26 } qr/Cannot store something that is tied\./, "tied array storage fails";
27 }
1cff45d7 28
0e3e3555 29 {
30 tie my %foo, 'Tied::Hash';
31 throws_ok {
32 $db->{failure} = \%foo;
33 } qr/Cannot store something that is tied\./, "tied hash storage fails";
34 }
35
7c927437 36 # Need to create a second instance of a dbm here, but only of the type
37 # being tested.
38 if(0){
39 my $db2 = $dbm_maker->();
0e3e3555 40
41 $db2->import({
42 hash1 => {
43 subkey1 => "subvalue1",
44 subkey2 => "subvalue2",
45 }
46 });
7c927437 47 is( $db2->{hash1}{subkey1}, 'subvalue1', "Value1 imported correctly" );
48 is( $db2->{hash1}{subkey2}, 'subvalue2', "Value2 imported correctly" );
0e3e3555 49
7c927437 50 # Test cross-ref nested hash across DB objects
0e3e3555 51 throws_ok {
52 $db->{copy} = $db2->{hash1};
53 } qr/Cannot store values across DBM::Deep files\. Please use export\(\) instead\./, "cross-ref fails";
54
7c927437 55 # This error text is for when internal cross-refs are implemented:
56 # qr/Cannot cross-reference\. Use export\(\) instead\./
1cff45d7 57
7c927437 58 my $x = $db2->{hash1}->export;
59 $db->{copy} = $x;
0e3e3555 60 }
98ac82af 61
62 ##
0e3e3555 63 # Make sure $db has copy of $db2's hash structure
98ac82af 64 ##
7c927437 65# is( $db->{copy}{subkey1}, 'subvalue1', "Value1 copied correctly" );
66# is( $db->{copy}{subkey2}, 'subvalue2', "Value2 copied correctly" );
98ac82af 67}
ffed8b01 68
0e3e3555 69done_testing;
1cff45d7 70
71package Tied::Scalar;
72sub TIESCALAR { bless {}, $_[0]; }
73sub FETCH{}
74
75package Tied::Array;
76sub TIEARRAY { bless {}, $_[0]; }
77
78package Tied::Hash;
79sub TIEHASH { bless {}, $_[0]; }