From: Arthur Axel 'fREW' Schmidt <frioux@gmail.com>
Date: Sun, 12 Jun 2011 03:07:58 +0000 (-0500)
Subject: fix bigint handling in sqlite
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=67b35a45985a79c0a97a28921c7be4beff53f879;p=dbsrgits%2FDBIx-Class-Historic.git

fix bigint handling in sqlite
---

diff --git a/Changes b/Changes
index 99958f6..a513d00 100644
--- a/Changes
+++ b/Changes
@@ -24,6 +24,8 @@ Revision history for DBIx::Class
           masks missing dependency exceptions (RT#66823)
         - Fix bug in Schema::Versioned failing to insert a schema version row
           during upgrades at the turn of the second
+        - Fix incorrect bind of integers >= 2^^32 (bigint columns) to
+          SQL_INTEGER, resulting in silent conversion to '-1'
 
 0.08192 2011-05-10 04:20 (UTC)
     * Fixes
diff --git a/lib/DBIx/Class/Storage/DBI/SQLite.pm b/lib/DBIx/Class/Storage/DBI/SQLite.pm
index 6ca2cf5..a050797 100644
--- a/lib/DBIx/Class/Storage/DBI/SQLite.pm
+++ b/lib/DBIx/Class/Storage/DBI/SQLite.pm
@@ -91,7 +91,7 @@ sub deployment_statements {
 }
 
 sub bind_attribute_by_data_type {
-  $_[1] =~ /^ (?: int(?:eger)? | (?:tiny|small|medium|big)int ) $/ix
+  $_[1] =~ /^ (?: int(?:eger)? | (?:tiny|small|medium)int ) $/ix
     ? do { require DBI; DBI::SQL_INTEGER() }
     : undef
   ;
diff --git a/t/752sqlite.t b/t/752sqlite.t
index 31aacf6..1446128 100644
--- a/t/752sqlite.t
+++ b/t/752sqlite.t
@@ -4,49 +4,98 @@ use warnings;
 use Test::More;
 use Test::Exception;
 use Test::Warn;
+use Config;
+
 use lib qw(t/lib);
 use DBICTest;
 
-my $schema = DBICTest->init_schema(auto_savepoint => 1);
+# savepoints test
+{
+  my $schema = DBICTest->init_schema(auto_savepoint => 1);
 
-my $ars = $schema->resultset('Artist');
+  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' });
+  # test two-phase commit and inner transaction rollback from nested transactions
   $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 {
+    $ars->create({ name => 'in_outer_transaction' });
     $schema->txn_do(sub {
-      $ars->create({ name => 'in_inner_transaction_rolling_back' });
-      die 'rolling back inner transaction';
+      $ars->create({ name => 'in_inner_transaction' });
     });
-  } qr/rolling back inner transaction/, 'inner transaction rollback executed';
-  $ars->create({ name => 'in_outer_transaction2' });
-});
+    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' });
+  });
+
+  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';
+}
 
-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';
+my $schema = DBICTest->init_schema();
 
 # make sure the side-effects of RT#67581 do not result in data loss
 my $row;
-warnings_exist { $row = $ars->create ({ name => 'alpha rank', rank => 'abc' }) }
+warnings_exist { $row = $schema->resultset('Artist')->create ({ name => 'alpha rank', rank => 'abc' }) }
   [qr/Non-numeric value supplied for column 'rank' despite the numeric datatype/],
   'proper warning on string insertion into an numeric column'
 ;
 $row->discard_changes;
 is ($row->rank, 'abc', 'proper rank inserted into database');
 
+# and make sure we do not lose actual bigints
+{
+  package DBICTest::BigIntArtist;
+  use base 'DBICTest::Schema::Artist';
+  __PACKAGE__->table('artist');
+  __PACKAGE__->add_column(bigint => { data_type => 'bigint' });
+}
+$schema->register_class(BigIntArtist => 'DBICTest::BigIntArtist');
+$schema->storage->dbh_do(sub {
+  $_[1]->do('ALTER TABLE artist ADD COLUMN bigint BIGINT');
+});
+
+# test upper/lower boundaries for sqlite and some values inbetween
+# range is -(2**63) .. 2**63 - 1
+for my $bi (qw/
+  -9223372036854775808
+  -9223372036854775807
+  -8694837494948124658
+  -6848440844435891639
+  -5664812265578554454
+  -5380388020020483213
+  -2564279463598428141
+  2442753333597784273
+  4790993557925631491
+  6773854980030157393
+  7627910776496326154
+  8297530189347439311
+  9223372036854775806
+  9223372036854775807
+/) {
+  $row = $schema->resultset('BigIntArtist')->create({ bigint => $bi });
+  is ($row->bigint, $bi, "value in object correct ($bi)");
+
+  TODO: {
+    local $TODO = 'This perl does not seem to have 64bit int support - DBI roundtrip of large int will fail'
+      unless $Config{ivsize} >= 8;
+
+    $row->discard_changes;
+    is ($row->bigint, $bi, "value in database correct ($bi)");
+  }
+}
+
 done_testing;
 
 # vim:sts=2 sw=2: