1use strict; 2use Test::More; 3use Test::Deep; 4use lib 't'; 5use common qw( new_dbm ); 6 7use_ok( 'DBM::Deep' ); 8 9my $dbm_factory = new_dbm( 10 locking => 1, 11 autoflush => 1, 12 num_txns => 2, 13); 14while ( my $dbm_maker = $dbm_factory->() ) { 15 my $db1 = $dbm_maker->(); 16 next unless $db1->supports('transactions'); 17 my $db2 = $dbm_maker->(); 18 19 $db1->{x} = { xy => { foo => 'y' } }; 20 is( $db1->{x}{xy}{foo}, 'y', "Before transaction, DB1's X is Y" ); 21 is( $db2->{x}{xy}{foo}, 'y', "Before transaction, DB2's X is Y" ); 22 23 cmp_bag( [ keys %$db1 ], [qw( x )], "DB1 keys correct" ); 24 cmp_bag( [ keys %$db2 ], [qw( x )], "DB2 keys correct" ); 25 26 cmp_bag( [ keys %{$db1->{x}} ], [qw( xy )], "DB1->X keys correct" ); 27 cmp_bag( [ keys %{$db2->{x}} ], [qw( xy )], "DB2->X keys correct" ); 28 29 cmp_bag( [ keys %{$db1->{x}{xy}} ], [qw( foo )], "DB1->X->XY keys correct" ); 30 cmp_bag( [ keys %{$db2->{x}{xy}} ], [qw( foo )], "DB2->X->XY keys correct" ); 31 32 $db1->begin_work; 33 34 cmp_bag( [ keys %$db1 ], [qw( x )], "DB1 keys correct" ); 35 cmp_bag( [ keys %$db2 ], [qw( x )], "DB2 keys correct" ); 36 37 cmp_bag( [ keys %{$db1->{x}} ], [qw( xy )], "DB1->X keys correct" ); 38 cmp_bag( [ keys %{$db2->{x}} ], [qw( xy )], "DB2->X keys correct" ); 39 40 cmp_bag( [ keys %{$db1->{x}{xy}} ], [qw( foo )], "DB1->X->XY keys correct" ); 41 cmp_bag( [ keys %{$db2->{x}{xy}} ], [qw( foo )], "DB2->X->XY keys correct" ); 42 43 is( $db1->{x}{xy}{foo}, 'y', "After transaction, DB1's X is Y" ); 44 is( $db2->{x}{xy}{foo}, 'y', "After transaction, DB2's X is Y" ); 45 46 $db1->{x} = { yz => { bar => 30 } }; 47 ok( !exists $db1->{x}{xy}, "DB1: After reassignment of X, X->XY is gone" ); 48 is( $db2->{x}{xy}{foo}, 'y', "DB2: After reassignment of DB1 X, X is Y" ); 49 50 cmp_bag( [ keys %{$db1->{x}} ], [qw( yz )], "DB1->X keys correct" ); 51 cmp_bag( [ keys %{$db2->{x}} ], [qw( xy )], "DB2->X keys correct" ); 52 53 $db1->rollback; 54 55 cmp_bag( [ keys %$db1 ], [qw( x )], "DB1 keys correct" ); 56 cmp_bag( [ keys %$db2 ], [qw( x )], "DB2 keys correct" ); 57 58 cmp_bag( [ keys %{$db1->{x}} ], [qw( xy )], "DB1->X keys correct" ); 59 cmp_bag( [ keys %{$db2->{x}} ], [qw( xy )], "DB2->X keys correct" ); 60 61 cmp_bag( [ keys %{$db1->{x}{xy}} ], [qw( foo )], "DB1->X->XY keys correct" ); 62 cmp_bag( [ keys %{$db2->{x}{xy}} ], [qw( foo )], "DB2->X->XY keys correct" ); 63 64 is( $db1->{x}{xy}{foo}, 'y', "Before transaction, DB1's X is Y" ); 65 is( $db2->{x}{xy}{foo}, 'y', "Before transaction, DB2's X is Y" ); 66 67 $db1->begin_work; 68 69 cmp_bag( [ keys %$db1 ], [qw( x )], "DB1 keys correct" ); 70 cmp_bag( [ keys %$db2 ], [qw( x )], "DB2 keys correct" ); 71 72 cmp_bag( [ keys %{$db1->{x}} ], [qw( xy )], "DB1->X keys correct" ); 73 cmp_bag( [ keys %{$db2->{x}} ], [qw( xy )], "DB2->X keys correct" ); 74 75 cmp_bag( [ keys %{$db1->{x}{xy}} ], [qw( foo )], "DB1->X->XY keys correct" ); 76 cmp_bag( [ keys %{$db2->{x}{xy}} ], [qw( foo )], "DB2->X->XY keys correct" ); 77 78 is( $db1->{x}{xy}{foo}, 'y', "After transaction, DB1's X is Y" ); 79 is( $db2->{x}{xy}{foo}, 'y', "After transaction, DB2's X is Y" ); 80 81 $db1->{x} = { yz => { bar => 30 } }; 82 ok( !exists $db1->{x}{xy}, "DB1: After reassignment of X, X->XY is gone" ); 83 is( $db2->{x}{xy}{foo}, 'y', "DB2: After reassignment of DB1 X, X->YZ is Y" ); 84 85 cmp_bag( [ keys %{$db1->{x}} ], [qw( yz )], "DB1->X keys correct" ); 86 cmp_bag( [ keys %{$db2->{x}} ], [qw( xy )], "DB2->X keys correct" ); 87 88 $db1->commit; 89 90 cmp_bag( [ keys %$db1 ], [qw( x )], "DB1 keys correct" ); 91 cmp_bag( [ keys %$db2 ], [qw( x )], "DB2 keys correct" ); 92 93 cmp_bag( [ keys %{$db1->{x}} ], [qw( yz )], "DB1->X keys correct" ); 94 cmp_bag( [ keys %{$db2->{x}} ], [qw( yz )], "DB2->X keys correct" ); 95 96 cmp_bag( [ keys %{$db1->{x}{yz}} ], [qw( bar )], "DB1->X->XY keys correct" ); 97 cmp_bag( [ keys %{$db2->{x}{yz}} ], [qw( bar )], "DB2->X->XY keys correct" ); 98} 99 100done_testing; 101