t/752sqlite.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More;
   5 use Test::Exception;
   6 use Test::Warn;
   7 use Time::HiRes 'time';
   8 use Config;
   9
  10 use lib qw(t/lib);
  11 use DBICTest;
  12 use DBIx::Class::_Util qw(sigwarn_silencer modver_gt_or_eq);
  13
  14 # savepoints test
  15 {
  16   my $schema = DBICTest->init_schema(auto_savepoint => 1);
  17
  18   my $ars = $schema->resultset('Artist');
  19
  20   # test two-phase commit and inner transaction rollback from nested transactions
  21   $schema->txn_do(sub {
  22     $ars->create({ name => 'in_outer_transaction' });
  23     $schema->txn_do(sub {
  24       $ars->create({ name => 'in_inner_transaction' });
  25     });
  26     ok($ars->search({ name => 'in_inner_transaction' })->first,
  27       'commit from inner transaction visible in outer transaction');
  28     throws_ok {
  29       $schema->txn_do(sub {
  30         $ars->create({ name => 'in_inner_transaction_rolling_back' });
  31         die 'rolling back inner transaction';
  32       });
  33     } qr/rolling back inner transaction/, 'inner transaction rollback executed';
  34     $ars->create({ name => 'in_outer_transaction2' });
  35   });
  36
  37   ok($ars->search({ name => 'in_outer_transaction' })->first,
  38     'commit from outer transaction');
  39   ok($ars->search({ name => 'in_outer_transaction2' })->first,
  40     'second commit from outer transaction');
  41   ok($ars->search({ name => 'in_inner_transaction' })->first,
  42     'commit from inner transaction');
  43   is $ars->search({ name => 'in_inner_transaction_rolling_back' })->first,
  44     undef,
  45     'rollback from inner transaction';
  46 }
  47
  48 # check that we work somewhat OK with braindead SQLite transaction handling
  49 #
  50 # As per https://metacpan.org/source/ADAMK/DBD-SQLite-1.37/lib/DBD/SQLite.pm#L921
  51 # SQLite does *not* try to synchronize
  52 #
  53 # However DBD::SQLite 1.38_02 seems to fix this, with an accompanying test:
  54 # https://metacpan.org/source/ADAMK/DBD-SQLite-1.38_02/t/54_literal_txn.t
  55
  56 my $lit_txn_todo = modver_gt_or_eq('DBD::SQLite', '1.38_02')
  57   ? undef
  58   : "DBD::SQLite before 1.38_02 is retarded wrt detecting literal BEGIN/COMMIT statements"
  59 ;
  60
  61 for my $prefix_comment (qw/Begin_only Commit_only Begin_and_Commit/) {
  62   note "Testing with comment prefixes on $prefix_comment";
  63
  64   # FIXME warning won't help us for the time being
  65   # perhaps when (if ever) DBD::SQLite gets fixed,
  66   # we can do something extra here
  67   local $SIG{__WARN__} = sigwarn_silencer( qr/Internal transaction state .+? does not seem to match/ )
  68     if ( $lit_txn_todo && !$ENV{TEST_VERBOSE} );
  69
  70   my ($c_begin, $c_commit) = map { $prefix_comment =~ $_ ? 1 : 0 } (qr/Begin/, qr/Commit/);
  71
  72   my $schema = DBICTest->init_schema( no_deploy => 1 );
  73   my $ars = $schema->resultset('Artist');
  74
  75   ok (! $schema->storage->connected, 'No connection yet');
  76
  77   $schema->storage->dbh->do(<<'DDL');
  78 CREATE TABLE artist (
  79   artistid INTEGER PRIMARY KEY NOT NULL,
  80   name varchar(100),
  81   rank integer DEFAULT 13,
  82   charfield char(10) NULL
  83 );
  84 DDL
  85
  86   my $artist = $ars->create({ name => 'Artist_' . time() });
  87   is ($ars->count, 1, 'Inserted artist ' . $artist->name);
  88
  89   ok ($schema->storage->connected, 'Connected');
  90   ok ($schema->storage->_dbh->{AutoCommit}, 'DBD not in txn yet');
  91
  92   $schema->storage->dbh->do(join "\n",
  93     $c_begin ? '-- comment' : (),
  94     'BEGIN TRANSACTION'
  95   );
  96   ok ($schema->storage->connected, 'Still connected');
  97   {
  98     local $TODO = $lit_txn_todo if $c_begin;
  99     ok (! $schema->storage->_dbh->{AutoCommit}, "DBD aware of txn begin with comments on $prefix_comment");
 100   }
 101
 102   $schema->storage->dbh->do(join "\n",
 103     $c_commit ? '-- comment' : (),
 104     'COMMIT'
 105   );
 106   ok ($schema->storage->connected, 'Still connected');
 107   {
 108     local $TODO = $lit_txn_todo if $c_commit and ! $c_begin;
 109     ok ($schema->storage->_dbh->{AutoCommit}, "DBD aware txn ended with comments on $prefix_comment");
 110   }
 111
 112   is ($ars->count, 1, 'Inserted artists still there');
 113
 114   {
 115     # this never worked in the 1st place
 116     local $TODO = $lit_txn_todo if ! $c_begin and $c_commit;
 117
 118     # odd argument passing, because such nested crefs leak on 5.8
 119     lives_ok {
 120       $schema->storage->txn_do (sub {
 121         ok ($_[0]->find({ name => $_[1] }), "Artist still where we left it after cycle with comments on $prefix_comment");
 122       }, $ars, $artist->name );
 123     } "Succesfull transaction with comments on $prefix_comment";
 124   }
 125 }
 126
 127
 128 my $schema = DBICTest->init_schema();
 129
 130 # make sure the side-effects of RT#67581 do not result in data loss
 131 my $row;
 132 warnings_exist { $row = $schema->resultset('Artist')->create ({ name => 'alpha rank', rank => 'abc' }) }
 133   [qr/Non-integer value supplied for column 'rank' despite the integer datatype/],
 134   'proper warning on string insertion into an numeric column'
 135 ;
 136 $row->discard_changes;
 137 is ($row->rank, 'abc', 'proper rank inserted into database');
 138
 139 # and make sure we do not lose actual bigints
 140 {
 141   package DBICTest::BigIntArtist;
 142   use base 'DBICTest::Schema::Artist';
 143   __PACKAGE__->table('artist');
 144   __PACKAGE__->add_column(bigint => { data_type => 'bigint' });
 145 }
 146 $schema->register_class(BigIntArtist => 'DBICTest::BigIntArtist');
 147 $schema->storage->dbh_do(sub {
 148   $_[1]->do('ALTER TABLE artist ADD COLUMN bigint BIGINT');
 149 });
 150
 151 # test upper/lower boundaries for sqlite and some values inbetween
 152 # range is -(2**63) .. 2**63 - 1
 153 SKIP: {
 154   skip 'This perl does not seem to have 64bit int support - DBI roundtrip of large int will fail with DBD::SQLite < 1.37', 1
 155     if ($Config{ivsize} < 8 and ! modver_gt_or_eq('DBD::SQLite', '1.37') );
 156
 157   for my $bi (qw/
 158     -9223372036854775808
 159     -9223372036854775807
 160     -8694837494948124658
 161     -6848440844435891639
 162     -5664812265578554454
 163     -5380388020020483213
 164     -2564279463598428141
 165     2442753333597784273
 166     4790993557925631491
 167     6773854980030157393
 168     7627910776496326154
 169     8297530189347439311
 170     9223372036854775806
 171     9223372036854775807
 172   /) {
 173     $row = $schema->resultset('BigIntArtist')->create({ bigint => $bi });
 174     is ($row->bigint, $bi, "value in object correct ($bi)");
 175
 176     $row->discard_changes;
 177     is ($row->bigint, $bi, "value in database correct ($bi)");
 178   }
 179 }
 180
 181 done_testing;
 182
 183 # vim:sts=2 sw=2: