2 use warnings FATAL => 'all';
6 use t::common qw( new_dbm );
10 my $dbm_factory = new_dbm();
11 while ( my $dbm_maker = $dbm_factory->() ) {
12 my $db = $dbm_maker->();
15 skip "Apparently, we cannot detect a tied scalar?", 1;
16 tie my $foo, 'Tied::Scalar';
18 $db->{failure} = $foo;
19 } qr/Cannot store something that is tied\./, "tied scalar storage fails";
23 tie my @foo, 'Tied::Array';
25 $db->{failure} = \@foo;
26 } qr/Cannot store something that is tied\./, "tied array storage fails";
30 tie my %foo, 'Tied::Hash';
32 $db->{failure} = \%foo;
33 } qr/Cannot store something that is tied\./, "tied hash storage fails";
36 my $dbm_factory2 = new_dbm();
37 while ( my $dbm_maker2 = $dbm_factory2->() ) {
38 my $db2 = $dbm_maker2->();
42 subkey1 => "subvalue1",
43 subkey2 => "subvalue2",
46 is( $db2->{hash1}{subkey1}, 'subvalue1', "Value imported correctly" );
47 is( $db2->{hash1}{subkey2}, 'subvalue2', "Value imported correctly" );
49 # Test cross-ref nested hash accross DB objects
51 $db->{copy} = $db2->{hash1};
52 } qr/Cannot store values across DBM::Deep files\. Please use export\(\) instead\./, "cross-ref fails";
54 # This error text is for when internal cross-refs are implemented
55 #} qr/Cannot cross-reference\. Use export\(\) instead\./
57 $db->{copy} = $db2->{hash1}->export;
61 # Make sure $db has copy of $db2's hash structure
63 is( $db->{copy}{subkey1}, 'subvalue1', "Value copied correctly" );
64 is( $db->{copy}{subkey2}, 'subvalue2', "Value copied correctly" );
70 sub TIESCALAR { bless {}, $_[0]; }
74 sub TIEARRAY { bless {}, $_[0]; }
77 sub TIEHASH { bless {}, $_[0]; }