t/33_transactions.t

   1 use strict;
   2 use warnings FATAL => 'all';
   3
   4 use Test::More;
   5 use Test::Deep;
   6 use Test::Exception;
   7 use t::common qw( new_dbm );
   8
   9 use_ok( 'DBM::Deep' );
  10
  11 my $dbm_factory = new_dbm(
  12     locking => 1,
  13     autoflush => 1,
  14     num_txns  => 16,
  15 );
  16 while ( my $dbm_maker = $dbm_factory->() ) {
  17     my $db1 = $dbm_maker->();
  18     next unless $db1->supports( 'transactions' );
  19
  20     my $db2 = $dbm_maker->();
  21
  22     $db1->{x} = 'y';
  23     is( $db1->{x}, 'y', "Before transaction, DB1's X is Y" );
  24     is( $db2->{x}, 'y', "Before transaction, DB2's X is Y" );
  25
  26     cmp_bag( [ keys %$db1 ], [qw( x )], "DB1 keys correct" );
  27     cmp_bag( [ keys %$db2 ], [qw( x )], "DB2 keys correct" );
  28
  29     throws_ok {
  30         $db1->rollback;
  31     } qr/Cannot rollback without an active transaction/, "Attempting to rollback without a transaction throws an error";
  32
  33     throws_ok {
  34         $db1->commit;
  35     } qr/Cannot commit without an active transaction/, "Attempting to commit without a transaction throws an error";
  36
  37     $db1->begin_work;
  38
  39     throws_ok {
  40         $db1->begin_work;
  41     } qr/Cannot begin_work within an active transaction/, "Attempting to begin_work within a transaction throws an error";
  42
  43     lives_ok {
  44         $db1->rollback;
  45     } "Rolling back an empty transaction is ok.";
  46
  47     cmp_bag( [ keys %$db1 ], [qw( x )], "DB1 keys correct" );
  48     cmp_bag( [ keys %$db2 ], [qw( x )], "DB2 keys correct" );
  49
  50     $db1->begin_work;
  51
  52     lives_ok {
  53         $db1->commit;
  54     } "Committing an empty transaction is ok.";
  55
  56     cmp_bag( [ keys %$db1 ], [qw( x )], "DB1 keys correct" );
  57     cmp_bag( [ keys %$db2 ], [qw( x )], "DB2 keys correct" );
  58
  59     $db1->begin_work;
  60
  61         cmp_bag( [ keys %$db1 ], [qw( x )], "DB1 keys correct" );
  62         cmp_bag( [ keys %$db2 ], [qw( x )], "DB2 keys correct" );
  63
  64         is( $db1->{x}, 'y', "DB1 transaction started, no actions - DB1's X is Y" );
  65         is( $db2->{x}, 'y', "DB1 transaction started, no actions - DB2's X is Y" );
  66
  67         $db2->{x} = 'a';
  68         is( $db1->{x}, 'y', "Within DB1 transaction, DB1's X is still Y" );
  69         is( $db2->{x}, 'a', "Within DB1 transaction, DB2's X is now A" );
  70
  71         $db1->{x} = 'z';
  72         is( $db1->{x}, 'z', "Within DB1 transaction, DB1's X is Z" );
  73         is( $db2->{x}, 'a', "Within DB1 transaction, DB2's X is still A" );
  74
  75         $db1->{z} = 'a';
  76         is( $db1->{z}, 'a', "Within DB1 transaction, DB1's Z is A" );
  77         ok( !exists $db2->{z}, "Since z was added after the transaction began, DB2 doesn't see it." );
  78
  79         $db2->{other_x} = 'foo';
  80         is( $db2->{other_x}, 'foo', "DB2 set other_x within DB1's transaction, so DB2 can see it" );
  81         ok( !exists $db1->{other_x}, "Since other_x was added after the transaction began, DB1 doesn't see it." );
  82
  83         # Reset to an expected value
  84         $db2->{x} = 'y';
  85         is( $db1->{x}, 'z', "Within DB1 transaction, DB1's X is istill Z" );
  86         is( $db2->{x}, 'y', "Within DB1 transaction, DB2's X is now Y" );
  87
  88         cmp_bag( [ keys %$db1 ], [qw( x z )], "DB1 keys correct" );
  89         cmp_bag( [ keys %$db2 ], [qw( x other_x )], "DB2 keys correct" );
  90
  91     $db1->rollback;
  92
  93     is( $db1->{x}, 'y', "After rollback, DB1's X is Y" );
  94     is( $db2->{x}, 'y', "After rollback, DB2's X is Y" );
  95
  96     is( $db1->{other_x}, 'foo', "After DB1 transaction is over, DB1 can see other_x" );
  97     is( $db2->{other_x}, 'foo', "After DB1 transaction is over, DB2 can still see other_x" );
  98
  99     $db1->begin_work;
 100
 101         cmp_bag( [ keys %$db1 ], [qw( x other_x )], "DB1 keys correct" );
 102         cmp_bag( [ keys %$db2 ], [qw( x other_x )], "DB2 keys correct" );
 103
 104         is( $db1->{x}, 'y', "DB1 transaction started, no actions - DB1's X is Y" );
 105         is( $db2->{x}, 'y', "DB1 transaction started, no actions - DB2's X is Y" );
 106
 107         $db1->{x} = 'z';
 108         is( $db1->{x}, 'z', "Within DB1 transaction, DB1's X is Z" );
 109         is( $db2->{x}, 'y', "Within DB1 transaction, DB2's X is still Y" );
 110
 111         $db2->{other_x} = 'bar';
 112         is( $db2->{other_x}, 'bar', "DB2 set other_x within DB1's transaction, so DB2 can see it" );
 113         is( $db1->{other_x}, 'foo', "Since other_x was modified after the transaction began, DB1 doesn't see the change." );
 114
 115         $db1->{z} = 'a';
 116         is( $db1->{z}, 'a', "Within DB1 transaction, DB1's Z is A" );
 117         ok( !exists $db2->{z}, "Since z was added after the transaction began, DB2 doesn't see it." );
 118
 119         cmp_bag( [ keys %$db1 ], [qw( x other_x z )], "DB1 keys correct" );
 120         cmp_bag( [ keys %$db2 ], [qw( x other_x )], "DB2 keys correct" );
 121
 122     $db1->commit;
 123
 124     is( $db1->{x}, 'z', "After commit, DB1's X is Z" );
 125     is( $db2->{x}, 'z', "After commit, DB2's X is Z" );
 126
 127     is( $db1->{z}, 'a', "After commit, DB1's Z is A" );
 128     is( $db2->{z}, 'a', "After commit, DB2's Z is A" );
 129
 130     is( $db1->{other_x}, 'bar', "After commit, DB1's other_x is bar" );
 131     is( $db2->{other_x}, 'bar', "After commit, DB2's other_x is bar" );
 132
 133     $db1->begin_work;
 134
 135         cmp_bag( [ keys %$db1 ], [qw( x z other_x )], "DB1 keys correct" );
 136         cmp_bag( [ keys %$db2 ], [qw( x z other_x )], "DB2 keys correct" );
 137
 138         is( $db1->{x}, 'z', "After commit, DB1's X is Z" );
 139         is( $db2->{x}, 'z', "After commit, DB2's X is Z" );
 140
 141         is( $db1->{z}, 'a', "After commit, DB1's Z is A" );
 142         is( $db2->{z}, 'a', "After commit, DB2's Z is A" );
 143
 144         is( $db1->{other_x}, 'bar', "After begin_work, DB1's other_x is still bar" );
 145         is( $db2->{other_x}, 'bar', "After begin_work, DB2's other_x is still bar" );
 146
 147         delete $db2->{other_x};
 148         ok( !exists $db2->{other_x}, "DB2 deleted other_x in DB1's transaction, so it can't see it anymore" );
 149         is( $db1->{other_x}, 'bar', "Since other_x was deleted after the transaction began, DB1 still sees it." );
 150
 151         cmp_bag( [ keys %$db1 ], [qw( x z other_x )], "DB1 keys correct" );
 152         cmp_bag( [ keys %$db2 ], [qw( x z )], "DB2 keys correct" );
 153
 154         delete $db1->{x};
 155         ok( !exists $db1->{x}, "DB1 deleted X in a transaction, so it can't see it anymore" );
 156         is( $db2->{x}, 'z', "But, DB2 can still see it" );
 157
 158         cmp_bag( [ keys %$db1 ], [qw( other_x z )], "DB1 keys correct" );
 159         cmp_bag( [ keys %$db2 ], [qw( x z )], "DB2 keys correct" );
 160
 161     $db1->rollback;
 162
 163     ok( !exists $db2->{other_x}, "It's still deleted for DB2" );
 164     ok( !exists $db1->{other_x}, "And now DB1 sees the deletion" );
 165
 166     is( $db1->{x}, 'z', "The transaction was rolled back, so DB1 can see X now" );
 167     is( $db2->{x}, 'z', "DB2 can still see it" );
 168
 169     cmp_bag( [ keys %$db1 ], [qw( x z )], "DB1 keys correct" );
 170     cmp_bag( [ keys %$db2 ], [qw( x z )], "DB2 keys correct" );
 171
 172     $db1->begin_work;
 173
 174         delete $db1->{x};
 175         ok( !exists $db1->{x}, "DB1 deleted X in a transaction, so it can't see it anymore" );
 176
 177         is( $db2->{x}, 'z', "But, DB2 can still see it" );
 178
 179         cmp_bag( [ keys %$db1 ], [qw( z )], "DB1 keys correct" );
 180         cmp_bag( [ keys %$db2 ], [qw( x z )], "DB2 keys correct" );
 181
 182     $db1->commit;
 183
 184     ok( !exists $db1->{x}, "The transaction was committed, so DB1 still deleted X" );
 185     ok( !exists $db2->{x}, "DB2 can now see the deletion of X" );
 186
 187     $db1->{foo} = 'bar';
 188     is( $db1->{foo}, 'bar', "Set foo to bar in DB1" );
 189     is( $db2->{foo}, 'bar', "Set foo to bar in DB2" );
 190
 191     cmp_bag( [ keys %$db1 ], [qw( foo z )], "DB1 keys correct" );
 192     cmp_bag( [ keys %$db2 ], [qw( foo z )], "DB2 keys correct" );
 193
 194     $db1->begin_work;
 195
 196         %$db1 = (); # clear()
 197         ok( !exists $db1->{foo}, "Cleared foo" );
 198         is( $db2->{foo}, 'bar', "But in DB2, we can still see it" );
 199
 200         cmp_bag( [ keys %$db1 ], [qw()], "DB1 keys correct" );
 201         cmp_bag( [ keys %$db2 ], [qw( foo z )], "DB2 keys correct" );
 202
 203     $db1->rollback;
 204
 205     is( $db1->{foo}, 'bar', "Rollback means 'foo' is still there" );
 206     is( $db2->{foo}, 'bar', "Rollback means 'foo' is still there" );
 207
 208     cmp_bag( [ keys %$db1 ], [qw( foo z )], "DB1 keys correct" );
 209     cmp_bag( [ keys %$db2 ], [qw( foo z )], "DB2 keys correct" );
 210
 211     SKIP: {
 212         skip "Optimize tests skipped on Win32", 7
 213             if $^O eq 'MSWin32' || $^O eq 'cygwin';
 214
 215         $db1->optimize;
 216
 217         is( $db1->{foo}, 'bar', 'After optimize, everything is ok' );
 218         is( $db2->{foo}, 'bar', 'After optimize, everything is ok' );
 219
 220         is( $db1->{z}, 'a', 'After optimize, everything is ok' );
 221         is( $db2->{z}, 'a', 'After optimize, everything is ok' );
 222
 223         cmp_bag( [ keys %$db1 ], [qw( foo z )], "DB1 keys correct" );
 224         cmp_bag( [ keys %$db2 ], [qw( foo z )], "DB2 keys correct" );
 225
 226         $db1->begin_work;
 227
 228             cmp_ok( $db1->_engine->trans_id, '==', 1, "Transaction ID has been reset after optimize" );
 229
 230         $db1->rollback;
 231     }
 232 }
 233
 234 done_testing;