Commit | Line | Data |
867a26a0 |
1 | use strict; |
0e3e3555 |
2 | use warnings FATAL => 'all'; |
3 | |
4 | use Test::More; |
867a26a0 |
5 | use Test::Deep; |
0e3e3555 |
6 | use t::common qw( new_dbm ); |
867a26a0 |
7 | |
8 | use_ok( 'DBM::Deep' ); |
9 | |
0e3e3555 |
10 | my $dbm_factory = new_dbm( |
11 | locking => 1, |
12 | autoflush => 1, |
13 | ); |
14 | while ( my $dbm_maker = $dbm_factory->() ) { |
15 | my $db = $dbm_maker->(); |
867a26a0 |
16 | |
c57b19c6 |
17 | $db->{a} = 1; |
18 | $db->{foo} = { a => 'b' }; |
19 | my $x = $db->{foo}; |
20 | my $y = $db->{foo}; |
867a26a0 |
21 | |
888453b9 |
22 | is( $x, $y, "The references are the same" ); |
23 | |
24 | delete $db->{foo}; |
edd45134 |
25 | is( $x, undef, "After deleting the DB location, external references are also undef (\$x)" ); |
26 | is( $y, undef, "After deleting the DB location, external references are also undef (\$y)" ); |
27 | is( $x + 0, undef, "DBM::Deep::Null can be added to." ); |
28 | is( $y + 0, undef, "DBM::Deep::Null can be added to." ); |
29 | is( $db->{foo}, undef, "The {foo} location is also undef." ); |
c57b19c6 |
30 | |
31 | # These shenanigans work to get another hashref |
32 | # into the same data location as $db->{foo} was. |
33 | $db->{foo} = {}; |
34 | delete $db->{foo}; |
35 | $db->{foo} = {}; |
36 | $db->{bar} = {}; |
37 | |
edd45134 |
38 | is( $x, undef, "After re-assigning to {foo}, external references to old values are still undef (\$x)" ); |
39 | is( $y, undef, "After re-assigning to {foo}, external references to old values are still undef (\$y)" ); |
c57b19c6 |
40 | } |
41 | |
42 | SKIP: { |
43 | skip "What do we do with external references and txns?", 2; |
0e3e3555 |
44 | |
45 | my $dbm_factory = new_dbm( |
46 | locking => 1, |
c57b19c6 |
47 | autoflush => 1, |
0e3e3555 |
48 | num_txns => 2, |
c57b19c6 |
49 | ); |
0e3e3555 |
50 | while ( my $dbm_maker = $dbm_factory->() ) { |
51 | my $db = $dbm_maker->(); |
c57b19c6 |
52 | |
0e3e3555 |
53 | $db->{foo} = { a => 'b' }; |
54 | my $x = $db->{foo}; |
c57b19c6 |
55 | |
0e3e3555 |
56 | $db->begin_work; |
c57b19c6 |
57 | |
0e3e3555 |
58 | $db->{foo} = { c => 'd' }; |
59 | my $y = $db->{foo}; |
c57b19c6 |
60 | |
0e3e3555 |
61 | # XXX What should happen here with $x and $y? |
62 | is( $x, $y ); |
63 | is( $x->{c}, 'd' ); |
c57b19c6 |
64 | |
0e3e3555 |
65 | $db->rollback; |
66 | } |
fb451ba6 |
67 | } |
0e3e3555 |
68 | |
69 | done_testing; |