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