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