2 use warnings FATAL => 'all';
6 use t::common qw( new_dbm );
10 if ( $ENV{NO_TEST_TRANSACTIONS} ) {
15 my $dbm_factory = new_dbm(
21 while ( my $dbm_maker = $dbm_factory->() ) {
22 my $db1 = $dbm_maker->();
23 my $db2 = $dbm_maker->();
24 my $db3 = $dbm_maker->();
27 is( $db1->{foo}, 'bar', "Before transaction, DB1's foo is bar" );
28 is( $db2->{foo}, 'bar', "Before transaction, DB2's foo is bar" );
29 is( $db3->{foo}, 'bar', "Before transaction, DB3's foo is bar" );
33 is( $db1->{foo}, 'bar', "Before transaction work, DB1's foo is bar" );
34 is( $db2->{foo}, 'bar', "Before transaction work, DB2's foo is bar" );
35 is( $db3->{foo}, 'bar', "Before transaction work, DB3's foo is bar" );
39 is( $db1->{foo}, 'bar2', "After DB1 foo to bar2, DB1's foo is bar2" );
40 is( $db2->{foo}, 'bar', "After DB1 foo to bar2, DB2's foo is bar" );
41 is( $db3->{foo}, 'bar', "After DB1 foo to bar2, DB3's foo is bar" );
45 ok( exists $db1->{bar}, "After DB1 set bar to foo, DB1's bar exists" );
46 ok( !exists $db2->{bar}, "After DB1 set bar to foo, DB2's bar doesn't exist" );
47 ok( !exists $db3->{bar}, "After DB1 set bar to foo, DB3's bar doesn't exist" );
51 is( $db1->{foo}, 'bar2', "After DB2 transaction begin, DB1's foo is still bar2" );
52 is( $db2->{foo}, 'bar', "After DB2 transaction begin, DB2's foo is still bar" );
53 is( $db3->{foo}, 'bar', "After DB2 transaction begin, DB3's foo is still bar" );
55 ok( exists $db1->{bar}, "After DB2 transaction begin, DB1's bar exists" );
56 ok( !exists $db2->{bar}, "After DB2 transaction begin, DB2's bar doesn't exist" );
57 ok( !exists $db3->{bar}, "After DB2 transaction begin, DB3's bar doesn't exist" );
59 $db2->{foo} = 'bar333';
61 is( $db1->{foo}, 'bar2', "After DB2 foo to bar2, DB1's foo is bar2" );
62 is( $db2->{foo}, 'bar333', "After DB2 foo to bar2, DB2's foo is bar333" );
63 is( $db3->{foo}, 'bar', "After DB2 foo to bar2, DB3's foo is bar" );
65 $db2->{bar} = 'mybar';
67 ok( exists $db1->{bar}, "After DB2 set bar to mybar, DB1's bar exists" );
68 ok( exists $db2->{bar}, "After DB2 set bar to mybar, DB2's bar exists" );
69 ok( !exists $db3->{bar}, "After DB2 set bar to mybar, DB3's bar doesn't exist" );
71 is( $db1->{bar}, 'foo', "DB1's bar is still foo" );
72 is( $db2->{bar}, 'mybar', "DB2's bar is now mybar" );
74 $db2->{mykey} = 'myval';
76 ok( !exists $db1->{mykey}, "After DB2 set mykey to myval, DB1's mykey doesn't exist" );
77 ok( exists $db2->{mykey}, "After DB2 set mykey to myval, DB2's mykey exists" );
78 ok( !exists $db3->{mykey}, "After DB2 set mykey to myval, DB3's mykey doesn't exist" );
80 cmp_bag( [ keys %$db1 ], [qw( foo bar )], "DB1 keys correct" );
81 cmp_bag( [ keys %$db2 ], [qw( foo bar mykey )], "DB2 keys correct" );
82 cmp_bag( [ keys %$db3 ], [qw( foo )], "DB3 keys correct" );
86 is( $db1->{foo}, 'bar2', "After DB1 commit, DB1's foo is bar2" );
87 is( $db2->{foo}, 'bar333', "After DB1 commit, DB2's foo is bar333" );
88 is( $db3->{foo}, 'bar2', "After DB1 commit, DB3's foo is bar2" );
90 is( $db1->{bar}, 'foo', "DB1's bar is still foo" );
91 is( $db2->{bar}, 'mybar', "DB2's bar is still mybar" );
92 is( $db3->{bar}, 'foo', "DB3's bar is now foo" );
94 cmp_bag( [ keys %$db1 ], [qw( foo bar )], "DB1 keys correct" );
95 cmp_bag( [ keys %$db2 ], [qw( foo bar mykey )], "DB2 keys correct" );
96 cmp_bag( [ keys %$db3 ], [qw( foo bar )], "DB3 keys correct" );
100 is( $db1->{foo}, 'bar333', "After DB2 commit, DB1's foo is bar333" );
101 is( $db2->{foo}, 'bar333', "After DB2 commit, DB2's foo is bar333" );
102 is( $db3->{foo}, 'bar333', "After DB2 commit, DB3's foo is bar333" );
104 is( $db1->{bar}, 'mybar', "DB1's bar is now mybar" );
105 is( $db2->{bar}, 'mybar', "DB2's bar is still mybar" );
106 is( $db3->{bar}, 'mybar', "DB3's bar is now mybar" );
108 cmp_bag( [ keys %$db1 ], [qw( foo bar mykey )], "DB1 keys correct" );
109 cmp_bag( [ keys %$db2 ], [qw( foo bar mykey )], "DB2 keys correct" );
110 cmp_bag( [ keys %$db3 ], [qw( foo bar mykey )], "DB3 keys correct" );