fix Cursor SYNOPSIS
[dbsrgits/DBIx-Class-Historic.git] / t / 752sqlite.t
CommitLineData
86a51471 1use strict;
2use warnings;
3
4use Test::More;
5use Test::Exception;
632d1e0f 6use Test::Warn;
2aeb3c7f 7use Time::HiRes 'time';
67b35a45 8use Config;
9
86a51471 10use lib qw(t/lib);
11use DBICTest;
12
67b35a45 13# savepoints test
14{
15 my $schema = DBICTest->init_schema(auto_savepoint => 1);
86a51471 16
67b35a45 17 my $ars = $schema->resultset('Artist');
86a51471 18
67b35a45 19 # test two-phase commit and inner transaction rollback from nested transactions
86a51471 20 $schema->txn_do(sub {
67b35a45 21 $ars->create({ name => 'in_outer_transaction' });
86a51471 22 $schema->txn_do(sub {
67b35a45 23 $ars->create({ name => 'in_inner_transaction' });
86a51471 24 });
67b35a45 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}
632d1e0f 46
2aeb3c7f 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
52for 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');
69CREATE TABLE artist (
70 artistid INTEGER PRIMARY KEY NOT NULL,
71 name varchar(100),
72 rank integer DEFAULT 13,
73 charfield char(10) NULL
74);
75DDL
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
08615cfb 109 # odd argument passing, because such nested crefs leak on 5.8
2aeb3c7f 110 lives_ok {
111 $schema->storage->txn_do (sub {
08615cfb 112 ok ($_[0]->find({ name => $_[1] }), "Artist still where we left it after cycle with comments on $prefix_comment");
113 }, $ars, $artist->name );
2aeb3c7f 114 } "Succesfull transaction with comments on $prefix_comment";
115 }
116}
117
118
67b35a45 119my $schema = DBICTest->init_schema();
86a51471 120
632d1e0f 121# make sure the side-effects of RT#67581 do not result in data loss
122my $row;
67b35a45 123warnings_exist { $row = $schema->resultset('Artist')->create ({ name => 'alpha rank', rank => 'abc' }) }
632d1e0f 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;
128is ($row->rank, 'abc', 'proper rank inserted into database');
129
67b35a45 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
2e092442 144SKIP: {
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 });
67b35a45 147
2e092442 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)");
67b35a45 166
167 $row->discard_changes;
168 is ($row->bigint, $bi, "value in database correct ($bi)");
169 }
170}
171
86a51471 172done_testing;
173
174# vim:sts=2 sw=2: