Jelajahi Sumber

fcl-db: sqlite: map INTEGER PRIMARY KEY columns (ROWID) to TAutoIncField (as part of adding support for Refreshing AutoInc fields)
Update tests (use as test table FPDEV2, which is automatically removed at end of test, remove unused variables)

git-svn-id: trunk@29243 -

lacak 10 tahun lalu
induk
melakukan
6c10d2ddad

+ 37 - 15
packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

@@ -67,12 +67,12 @@ type
     procedure PrepareStatement(cursor: TSQLCursor; ATransaction : TSQLTransaction; buf: string; AParams : TParams); override;
     procedure Execute(cursor: TSQLCursor;atransaction:tSQLtransaction; AParams : TParams); override;
     function Fetch(cursor : TSQLCursor) : boolean; override;
-    procedure AddFieldDefs(cursor: TSQLCursor; FieldDefs : TfieldDefs); override;
+    procedure AddFieldDefs(cursor: TSQLCursor; FieldDefs : TFieldDefs); override;
     procedure UnPrepareStatement(cursor : TSQLCursor); override;
  
     procedure FreeFldBuffers(cursor : TSQLCursor); override;
-    function LoadField(cursor : TSQLCursor;FieldDef : TfieldDef;buffer : pointer; out CreateBlob : boolean) : boolean; override;
-    procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction : TSQLTransaction); override;
+    function LoadField(cursor : TSQLCursor; FieldDef : TFieldDef; buffer : pointer; out CreateBlob : boolean) : boolean; override;
+    procedure LoadBlobIntoBuffer(FieldDef: TFieldDef; ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction : TSQLTransaction); override;
 
     function GetTransactionHandle(trans : TSQLHandle): pointer; override;
     function Commit(trans : TSQLHandle) : boolean; override;
@@ -193,8 +193,9 @@ begin
     if P.IsNull then
       checkerror(sqlite3_bind_null(fstatement,I))
     else 
-      case P.datatype of
+      case P.DataType of
         ftInteger,
+        ftAutoInc,
         ftBoolean,
         ftSmallint: checkerror(sqlite3_bind_int(fstatement,I,P.AsInteger));
         ftWord:     checkerror(sqlite3_bind_int(fstatement,I,P.AsWord));
@@ -304,7 +305,7 @@ begin
   FieldNameQuoteChars:=DoubleQuotes;
 end;
 
-procedure TSQLite3Connection.LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction : TSQLTransaction); 
+procedure TSQLite3Connection.LoadBlobIntoBuffer(FieldDef: TFieldDef; ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction : TSQLTransaction);
 
 var
  int1: integer;
@@ -425,16 +426,31 @@ Const
 }
   );
 
-procedure TSQLite3Connection.AddFieldDefs(cursor: TSQLCursor;
-               FieldDefs: TfieldDefs);
+procedure TSQLite3Connection.AddFieldDefs(cursor: TSQLCursor; FieldDefs: TFieldDefs);
 var
- i     : integer;
- FN,FD : string;
- ft1   : tfieldtype;
+ i, fi : integer;
+ FN, FD, PrimaryKeyFields : string;
+ ft1   : TFieldType;
  size1, size2 : integer;
- fi    : integer;
  st    : psqlite3_stmt;
 
+ function GetPrimaryKeyFields: string;
+ var IndexDefs: TServerIndexDefs;
+     i: integer;
+ begin
+   if FieldDefs.Dataset is TSQLQuery then
+   begin
+     IndexDefs := (FieldDefs.DataSet as TSQLQuery).ServerIndexDefs;
+     for i:=IndexDefs.Count-1 downto 0 do
+       if ixPrimary in IndexDefs[i].Options then
+       begin
+         Result := IndexDefs[i].Fields;
+         Exit;
+       end;
+   end;
+   Result := '';
+ end;
+
  function ExtractPrecisionAndScale(decltype: string; var precision, scale: integer): boolean;
  var p: integer;
  begin
@@ -460,6 +476,7 @@ var
  end;
 
 begin
+  PrimaryKeyFields := GetPrimaryKeyFields;
   st:=TSQLite3Cursor(cursor).fstatement;
   for i:= 0 to sqlite3_column_count(st) - 1 do 
     begin
@@ -472,6 +489,10 @@ begin
       ft1:=FieldMap[fi].t;
       break;
       end;
+    // Column declared as INTEGER PRIMARY KEY [AUTOINCREMENT] becomes ROWID for given table
+    // declared data type must be INTEGER (not INT, BIGINT, NUMERIC etc.)
+    if (FD='INTEGER') and SameText(FN, PrimaryKeyFields) then
+      ft1:=ftAutoInc;
     // In case of an empty fieldtype (FD='', which is allowed and used in calculated
     // columns (aggregates) and by pragma-statements) or an unknown fieldtype,
     // use the field's affinity:
@@ -506,9 +527,9 @@ begin
                  else if (size2-size1>MaxBCDPrecision-MaxBCDScale) or (size1>MaxBCDScale) then
                    ft1:=ftFmtBCD;
                end;
-      ftUnknown : DatabaseError('Unknown record type: '+FN);
+      ftUnknown : DatabaseErrorFmt('Unknown or unsupported data type %s of column %s', [FD, FN]);
     end; // Case
-    Fielddefs.Add(FieldDefs.MakeNameUnique(FN),ft1,size1,false,i+1);
+    FieldDefs.Add(FieldDefs.MakeNameUnique(FN),ft1,size1,false,i+1);
     end;
 end;
 
@@ -617,7 +638,7 @@ begin
   Result:=ComposeDateTime(ParseSQLiteDate(DS),ParseSQLiteTime(TS,False));
 end;
 
-function TSQLite3Connection.LoadField(cursor : TSQLCursor;FieldDef : TfieldDef;buffer : pointer; out CreateBlob : boolean) : boolean;
+function TSQLite3Connection.LoadField(cursor : TSQLCursor; FieldDef : TFieldDef; buffer : pointer; out CreateBlob : boolean) : boolean;
 
 var
  st1: TStorageType;
@@ -636,7 +657,8 @@ begin
   result:= st1 <> stnull;
   if Not result then 
     Exit;
-  case FieldDef.datatype of
+  case FieldDef.DataType of
+    ftAutoInc,
     ftInteger  : pinteger(buffer)^  := sqlite3_column_int(st,fnum);
     ftSmallInt : psmallint(buffer)^ := sqlite3_column_int(st,fnum);
     ftWord     : pword(buffer)^     := sqlite3_column_int(st,fnum);

+ 1 - 1
packages/fcl-db/tests/testfieldtypes.pas

@@ -833,7 +833,7 @@ begin
       begin
       datatype:='INTEGER PRIMARY KEY';
       values:='DEFAULT VALUES';
-      fieldtype:=ftInteger;
+      fieldtype:=ftAutoInc;
       updatable:=true;
       end;
     ssPostgreSQL:

+ 41 - 27
packages/fcl-db/tests/testsqldb.pas

@@ -185,7 +185,7 @@ end;
 
 Procedure TTestTSQLQuery.TestKeepOpenOnCommit;
 var Q: TSQLQuery;
-    I, J : Integer;
+    I: Integer;
 begin
   // Test that for a SQL query with Options=sqoKeepOpenOnCommit, calling commit does not close the dataset.
   // Test also that an edit still works.
@@ -216,7 +216,7 @@ begin
     Q.Close;
     Q.SQL.Text:='select * from testdiscon where (id=20) and (a=''abc'')';
     Q.Open;
-    AssertTrue('Have modified data record in database',not (Q.EOF AND Q.BOF));
+    AssertTrue('Have modified data record in database', not (Q.EOF AND Q.BOF));
     end;
 end;
 
@@ -266,7 +266,7 @@ end;
 
 Procedure TTestTSQLQuery.TestAutoApplyUpdatesPost;
 var Q: TSQLQuery;
-    I, J : Integer;
+    I: Integer;
 begin
   // Test that if sqoAutoApplyUpdates is in QueryOptions, then POST automatically does an ApplyUpdates
   // Test also that POST afterpost event is backwards compatible.
@@ -303,7 +303,7 @@ end;
 Procedure TTestTSQLQuery.TestAutoApplyUpdatesDelete;
 
 var Q: TSQLQuery;
-    I, J : Integer;
+    I: Integer;
 begin
   // Test that if sqoAutoApplyUpdates is in QueryOptions, then Delete automatically does an ApplyUpdates
   with SQLDBConnector do
@@ -341,7 +341,7 @@ end;
 
 Procedure TTestTSQLQuery.TestCheckRowsAffected;
 var Q: TSQLQuery;
-    I, J : Integer;
+    I: Integer;
 begin
   // Test that if sqoAutoApplyUpdates is in QueryOptions, then Delete automatically does an ApplyUpdates
   with SQLDBConnector do
@@ -367,7 +367,7 @@ end;
 
 Procedure TTestTSQLQuery.TestAutoCommit;
 var
-  I, J : Integer;
+  I : Integer;
 begin
   with SQLDBConnector do
     begin
@@ -399,8 +399,7 @@ end;
 Procedure TTestTSQLQuery.TestRefreshSQL;
 var
   Q: TSQLQuery;
-  T : TSQLTransaction;
-  I, J : Integer;
+
 begin
   with SQLDBConnector do
     begin
@@ -427,8 +426,6 @@ Procedure TTestTSQLQuery.TestGeneratedRefreshSQL;
 
 var
   Q: TSQLQuery;
-  T : TSQLTransaction;
-  I, J : Integer;
 
 begin
   with SQLDBConnector do
@@ -461,8 +458,6 @@ end;
 Procedure TTestTSQLQuery.TestGeneratedRefreshSQL1Field;
 var
   Q: TSQLQuery;
-  T : TSQLTransaction;
-  I, J : Integer;
 
 begin
   with SQLDBConnector do
@@ -569,27 +564,46 @@ begin
 end;
 
 Procedure TTestTSQLQuery.TestFetchAutoInc;
+var datatype: string;
+    id: largeint;
 begin
   with SQLDBConnector do
     begin
     if not (sqLastInsertID in Connection.ConnOptions) then
       Ignore(STestNotApplicable);
-    TryDropIfExist('testautoinc');
-    // Syntax may vary. This works for MySQL.
-    ExecuteDirect('create table testautoinc (id integer auto_increment, a varchar(5), constraint PK_AUTOINC primary key(id))');
+    case SQLServerType of
+      ssMySQL:
+        datatype := 'integer auto_increment';
+      ssSQLite:
+        datatype := 'integer';
+      else
+        Ignore(STestNotApplicable);
+    end;
+    TryDropIfExist('FPDEV2');
+    ExecuteDirect('create table FPDEV2 (id '+datatype+' primary key, f varchar(5))');
     CommitDDL;
     end;
-  FMyQ:=SQLDBConnector.Query;
-  FMyQ.SQL.Text:='select * from testautoinc';
-  FMyQ.Open;
-  FMyQ.Insert;
-  FMyQ.FieldByName('a').AsString:='b';
-  FMyQ.Post;
-  AssertTrue('ID field null after post',FMyQ.FieldByname('id').IsNull);
-  FMyQ.ApplyUpdates(0);
-  AssertTrue('ID field no longer null after applyupdates',Not FMyQ.FieldByname('id').IsNull);
-  // Should be 1 after the table was created, but this is not guaranteed... So we just test positive values.
-  AssertTrue('ID field has positive value',FMyQ.FieldByname('id').AsLargeInt>0);
+
+  with SQLDBConnector.Query do
+    begin
+    SQL.Text:='select * from FPDEV2';
+    Open;
+    Insert;
+    FieldByName('f').AsString:='a';
+    Post;
+    Append;
+    FieldByName('f').AsString:='b';
+    Post;
+    AssertTrue('ID field is not null after Post', FieldByName('id').IsNull);
+    First;
+    ApplyUpdates(0);
+    AssertTrue('ID field is still null after ApplyUpdates', Not FieldByName('id').IsNull);
+    // Should be 1 after the table was created, but this is not guaranteed... So we just test positive values.
+    id := FieldByName('id').AsLargeInt;
+    AssertTrue('ID field has not positive value', id>0);
+    Next;
+    AssertTrue('Next ID value is not greater than previous', FieldByName('id').AsLargeInt>id);
+    end;
 end;
 
 
@@ -645,7 +659,7 @@ procedure TTestTSQLConnection.TestImplicitTransactionOK;
 var
   Q : TSQLQuery;
   T : TSQLTransaction;
-  I, J : Integer;
+  I : Integer;
 begin
   with SQLDBConnector do
     begin