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 # Need to create a second instance of a dbm here, but only of the type
39 my $db2 = $dbm_maker->();
43 subkey1 => "subvalue1",
44 subkey2 => "subvalue2",
47 is( $db2->{hash1}{subkey1}, 'subvalue1', "Value1 imported correctly" );
48 is( $db2->{hash1}{subkey2}, 'subvalue2', "Value2 imported correctly" );
50 # Test cross-ref nested hash across DB objects
52 $db->{copy} = $db2->{hash1};
53 } qr/Cannot store values across DBM::Deep files\. Please use export\(\) instead\./, "cross-ref fails";
55 # This error text is for when internal cross-refs are implemented:
56 # qr/Cannot cross-reference\. Use export\(\) instead\./
58 my $x = $db2->{hash1}->export;
63 # Make sure $db has copy of $db2's hash structure
65 # is( $db->{copy}{subkey1}, 'subvalue1', "Value1 copied correctly" );
66 # is( $db->{copy}{subkey2}, 'subvalue2', "Value2 copied correctly" );
72 sub TIESCALAR { bless {}, $_[0]; }
76 sub TIEARRAY { bless {}, $_[0]; }
79 sub TIEHASH { bless {}, $_[0]; }