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 | |
66285e35 |
17 | SKIP: { |
18 | skip "This engine doesn't support singletons", 8 |
19 | unless $db->supports( 'singletons' ); |
20 | |
21 | $db->{a} = 1; |
22 | $db->{foo} = { a => 'b' }; |
23 | my $x = $db->{foo}; |
24 | my $y = $db->{foo}; |
25 | |
26 | is( $x, $y, "The references are the same" ); |
27 | |
28 | delete $db->{foo}; |
29 | is( $x, undef, "After deleting the DB location, external references are also undef (\$x)" ); |
30 | is( $y, undef, "After deleting the DB location, external references are also undef (\$y)" ); |
31 | is( eval { $x + 0 }, undef, "DBM::Deep::Null can be added to." ); |
32 | is( eval { $y + 0 }, undef, "DBM::Deep::Null can be added to." ); |
33 | is( $db->{foo}, undef, "The {foo} location is also undef." ); |
34 | |
35 | # These shenanigans work to get another hashref |
36 | # into the same data location as $db->{foo} was. |
37 | $db->{foo} = {}; |
38 | delete $db->{foo}; |
39 | $db->{foo} = {}; |
40 | $db->{bar} = {}; |
41 | |
42 | is( $x, undef, "After re-assigning to {foo}, external references to old values are still undef (\$x)" ); |
43 | is( $y, undef, "After re-assigning to {foo}, external references to old values are still undef (\$y)" ); |
44 | } |
c57b19c6 |
45 | } |
46 | |
47 | SKIP: { |
48 | skip "What do we do with external references and txns?", 2; |
0e3e3555 |
49 | |
50 | my $dbm_factory = new_dbm( |
51 | locking => 1, |
c57b19c6 |
52 | autoflush => 1, |
0e3e3555 |
53 | num_txns => 2, |
c57b19c6 |
54 | ); |
0e3e3555 |
55 | while ( my $dbm_maker = $dbm_factory->() ) { |
56 | my $db = $dbm_maker->(); |
c57b19c6 |
57 | |
0e3e3555 |
58 | $db->{foo} = { a => 'b' }; |
59 | my $x = $db->{foo}; |
c57b19c6 |
60 | |
0e3e3555 |
61 | $db->begin_work; |
c57b19c6 |
62 | |
0e3e3555 |
63 | $db->{foo} = { c => 'd' }; |
64 | my $y = $db->{foo}; |
c57b19c6 |
65 | |
0e3e3555 |
66 | # XXX What should happen here with $x and $y? |
67 | is( $x, $y ); |
68 | is( $x->{c}, 'd' ); |
c57b19c6 |
69 | |
0e3e3555 |
70 | $db->rollback; |
71 | } |
fb451ba6 |
72 | } |
0e3e3555 |
73 | |
74 | done_testing; |