From 75a8525c7fadcd6a7a64708ce902f3213ce0d7aa Mon Sep 17 00:00:00 2001
From: michael <michael@freepascal.org>
Date: Sat, 28 Dec 2019 16:19:14 +0000
Subject: [PATCH] * Merging revisions 43802 from trunk:    
 ------------------------------------------------------------------------    
 r43802 | michael | 2019-12-28 15:10:59 +0100 (Sat, 28 Dec 2019) | 1 line

    * Fix bug ID #36486, add parameter to force use of largeint for sqlite
    ------------------------------------------------------------------------

git-svn-id: branches/fixes_3_2@43803 -
---
 .../fcl-db/src/sqldb/sqlite/sqlite3conn.pp    | 35 ++++++++++++++++++-
 packages/fcl-db/tests/testfieldtypes.pas      | 30 ++++++++++++++++
 2 files changed, 64 insertions(+), 1 deletion(-)

diff --git a/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp b/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
index 741a075f1e..94cb28b9af 100644
--- a/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
+++ b/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
@@ -108,6 +108,8 @@ Type
     function stringsquery(const asql: string): TArrayStringArray;
     procedure execsql(const asql: string);
     function GetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string; override;
+    function GetAlwaysUseBigint : Boolean; virtual;
+    Procedure SetAlwaysUseBigint(aValue : Boolean); virtual;
   public
     constructor Create(AOwner : TComponent); override;
     procedure GetFieldNames(const TableName : string; List :  TStrings); override;
@@ -123,6 +125,7 @@ Type
     procedure LoadExtension(const LibraryFile: string);
   Published
     Property OpenFlags : TSQLiteOpenFlags Read FOpenFlags Write SetOpenFlags default DefaultOpenFlags;
+    Property AlwaysUseBigint : Boolean Read GetAlwaysUseBigint Write SetAlwaysUseBigint;
   end;
 
   { TSQLite3ConnectionDef }
@@ -171,7 +174,6 @@ type
  public
    RowsAffected : Largeint;
  end;
-
 procedure freebindstring(astring: pointer); cdecl;
 begin
   StrDispose(astring);
@@ -302,6 +304,32 @@ begin
   FOpenFlags:=DefaultOpenFlags;
 end;
 
+Const
+  SUseBigint = 'AlwaysUseBigint';
+
+function TSQLite3Connection.GetAlwaysUseBigint : Boolean; 
+
+begin
+  Result:=Params.Values[SUseBigint]='1'
+end;
+
+Procedure TSQLite3Connection.SetAlwaysUseBigint(aValue : Boolean); 
+
+Var
+  I : Integer;
+
+begin
+  if aValue then 
+    Params.Values[SUseBigint]:='1'
+  else
+    begin
+    I:=Params.IndexOfName(SUseBigint);
+    if I<>-1 then 
+      Params.Delete(I);
+    end;    
+end;
+
+
 procedure TSQLite3Connection.LoadBlobIntoBuffer(FieldDef: TFieldDef; ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction : TSQLTransaction);
 
 var
@@ -504,6 +532,11 @@ begin
     size1:=0;
     size2:=0;
     case FT of
+      ftInteger,
+      ftSMallint,
+      ftWord: 
+        If AlwaysUseBigint then
+          ft:=ftLargeInt;
       ftString,
       ftFixedChar,
       ftFixedWideChar,
diff --git a/packages/fcl-db/tests/testfieldtypes.pas b/packages/fcl-db/tests/testfieldtypes.pas
index 2c8a633797..11367dbf39 100644
--- a/packages/fcl-db/tests/testfieldtypes.pas
+++ b/packages/fcl-db/tests/testfieldtypes.pas
@@ -133,6 +133,8 @@ type
     procedure TestQueryAfterReconnect; // bug 16438
 
     procedure TestStringsReplace;
+    // Test SQLIte3 AlwaysUseBigInt, introduced after bug ID 36486.
+    Procedure TestAlwaysUseBigint;
   end;
 
 
@@ -2427,6 +2429,34 @@ begin
     inherited RunTest;
 end;
 
+Procedure TTestFieldTypes.TestAlwaysUseBigint;
+
+var
+  I : byte;
+
+begin
+  If SQLConnType<>sqlite3 then
+    Ignore('Test only for SQLite');
+  TSQLDBConnector(DBConnector).Connection.Params.Values['AlwaysUseBigint']:='1';
+
+  CreateTableWithFieldType(ftInteger,'INT');
+  TestFieldDeclaration(ftLargeInt,8);
+
+  for i := 0 to testIntValuesCount-1 do
+    TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (' + inttostr(testIntValues[i]) + ')');
+
+  with TSQLDBConnector(DBConnector).Query do
+    begin
+    Open;
+    for i := 0 to testIntValuesCount-1 do
+      begin
+      AssertEquals(testIntValues[i],fields[0].AsLargeInt);
+      Next;
+      end;
+    close;
+    end;
+    
+end;
 
 initialization
   // Only test if using sqldb