+BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) }
+
use strict;
use warnings;
use Time::HiRes 'time';
use Math::BigInt;
-use lib qw(t/lib);
-use DBICTest;
-use DBIx::Class::_Util qw(sigwarn_silencer modver_gt_or_eq);
-
-# savepoints test
-{
- my $schema = DBICTest->init_schema(auto_savepoint => 1);
-
- my $ars = $schema->resultset('Artist');
- # test two-phase commit and inner transaction rollback from nested transactions
- $schema->txn_do(sub {
- $ars->create({ name => 'in_outer_transaction' });
- $schema->txn_do(sub {
- $ars->create({ name => 'in_inner_transaction' });
- });
- ok($ars->search({ name => 'in_inner_transaction' })->first,
- 'commit from inner transaction visible in outer transaction');
- throws_ok {
- $schema->txn_do(sub {
- $ars->create({ name => 'in_inner_transaction_rolling_back' });
- die 'rolling back inner transaction';
- });
- } qr/rolling back inner transaction/, 'inner transaction rollback executed';
- $ars->create({ name => 'in_outer_transaction2' });
- });
+use DBICTest;
+use DBIx::Class::_Util qw( sigwarn_silencer modver_gt_or_eq modver_gt_or_eq_and_lt );
- ok($ars->search({ name => 'in_outer_transaction' })->first,
- 'commit from outer transaction');
- ok($ars->search({ name => 'in_outer_transaction2' })->first,
- 'second commit from outer transaction');
- ok($ars->search({ name => 'in_inner_transaction' })->first,
- 'commit from inner transaction');
- is $ars->search({ name => 'in_inner_transaction_rolling_back' })->first,
- undef,
- 'rollback from inner transaction';
-}
+# make one deploy() round before we load anything else - need this in order
+# to prime SQLT if we are using it (deep depchain is deep)
+DBICTest->init_schema( no_populate => 1 );
# check that we work somewhat OK with braindead SQLite transaction handling
#
#
# However DBD::SQLite 1.38_02 seems to fix this, with an accompanying test:
# https://metacpan.org/source/ADAMK/DBD-SQLite-1.38_02/t/54_literal_txn.t
-
my $lit_txn_todo = modver_gt_or_eq('DBD::SQLite', '1.38_02')
? undef
: "DBD::SQLite before 1.38_02 is retarded wrt detecting literal BEGIN/COMMIT statements"
}
}
+# test blank begin/svp/commit/begin cycle
+#
+# need to prime this for exotic testing scenarios
+# before testing for lack of warnings
+modver_gt_or_eq('DBD::SQLite', '1.33');
+
+warnings_are {
+ my $schema = DBICTest->init_schema( no_populate => 1 );
+ my $rs = $schema->resultset('Artist');
+ is ($rs->count, 0, 'Start with empty table');
+
+ for my $do_commit (1, 0) {
+ $schema->txn_begin;
+ $schema->svp_begin;
+ $schema->svp_rollback;
+
+ $schema->svp_begin;
+ $schema->svp_rollback;
+
+ $schema->svp_release;
+
+ $schema->svp_begin;
+
+ $schema->txn_rollback;
+
+ $schema->txn_begin;
+ $schema->svp_begin;
+ $schema->svp_rollback;
+
+ $schema->svp_begin;
+ $schema->svp_rollback;
+
+ $schema->svp_release;
+
+ $schema->svp_begin;
+
+ $do_commit ? $schema->txn_commit : $schema->txn_rollback;
+
+ is_deeply $schema->storage->savepoints, [], 'Savepoint names cleared away'
+ }
+
+ $schema->txn_do(sub {
+ ok (1, 'all seems fine');
+ });
+} [], 'No warnings emitted';
my $schema = DBICTest->init_schema();
is ($row->rank, 'abc', 'proper rank inserted into database');
# and make sure we do not lose actual bigints
+SKIP: {
+
+skip "Not testing bigint handling on known broken DBD::SQLite trial versions", 1
+ if modver_gt_or_eq_and_lt( 'DBD::SQLite', '1.45', '1.45_03' );
+
{
package DBICTest::BigIntArtist;
use base 'DBICTest::Schema::Artist';
$_[1]->do('ALTER TABLE artist ADD COLUMN bigint BIGINT');
});
-my $sqlite_broken_bigint = (
- modver_gt_or_eq('DBD::SQLite', '1.34') and ! modver_gt_or_eq('DBD::SQLite', '1.37')
-);
+my $sqlite_broken_bigint = modver_gt_or_eq_and_lt( 'DBD::SQLite', '1.34', '1.37' );
# 63 bit integer
my $many_bits = (Math::BigInt->new(2) ** 62);
1
2
- -9223372036854775808
-9223372036854775807
-8694837494948124658
-6848440844435891639
$sqlite_broken_bigint
? ()
: ( '2147483648', '2147483649' )
+ ,
+
+ # with newer compilers ( gcc 4.9+ ) older DBD::SQLite does not
+ # play well with the "Most Negative Number"
+ modver_gt_or_eq( 'DBD::SQLite', '1.33' )
+ ? ( '-9223372036854775808' )
+ : ()
+ ,
+
) {
# unsigned 32 bit ints have a range of −2,147,483,648 to 2,147,483,647
# alternatively expressed as the hexadecimal numbers below
my $v_desc = sprintf '%s (%d bit signed int)', $bi, $v_bits;
my @w;
- local $SIG{__WARN__} = sub { $_[0] =~ /datatype mismatch/ ? push @w, @_ : warn @_ };
+ local $SIG{__WARN__} = sub {
+ if ($_[0] =~ /datatype mismatch/) {
+ push @w, @_;
+ }
+ elsif ($_[0] =~ /An integer value occupying more than 32 bits was supplied .+ can not bind properly so DBIC will treat it as a string instead/ ) {
+ # do nothing, this warning will pop up here and there depending on
+ # DBD/bitness combination
+ # we don't want to test for it explicitly, we are just interested
+ # in the results matching at the end
+ }
+ else {
+ warn @_;
+ }
+ };
# some combinations of SQLite 1.35 and older 5.8 faimly is wonky
# instead of a warning we get a full exception. Sod it
eval {
$row = $schema->resultset('BigIntArtist')->create({ bigint => $bi });
} or do {
- fail("Exception on inserting $v_desc") unless $sqlite_broken_bigint;
+ fail("Exception on inserting $v_desc: $@") unless $sqlite_broken_bigint;
next;
};
"value in database correct ($v_desc)"
);
-# FIXME - temporary smoke-only escape
-SKIP: {
- skip 'Potential for false negatives - investigation pending', 1
- if DBICTest::RunMode->is_plain;
-
# check if math works
# start by adding/subtracting a 50 bit integer, and then divide by 2 for good measure
my ($sqlop, $expect) = $bi < 0
, "simple integer math with@{[ $dtype ? '' : 'out' ]} bindtype in database correct (base $v_desc)")
or diag sprintf '%s != %s', $row->bigint, $expect;
}
-# end of fixme
-}
is_deeply (\@w, [], "No mismatch warnings on bigint operations ($v_desc)" );
-}
+
+}}
done_testing;
projects / dbsrgits/DBIx-Class.git / blobdiff