Browse Source

--- Merging r23790 into '.':
U packages/sqlite/src/sqlite3db.pas
--- Merging r24742 into '.':
U packages/fcl-db/src/sqldb/sqldb.pp
--- Merging r24768 into '.':
G packages/fcl-db/src/sqldb/sqldb.pp
--- Merging r24769 into '.':
U packages/fcl-db/src/base/bufdataset.pas
--- Merging r24770 into '.':
U packages/fcl-db/tests/sqldbtoolsunit.pas
U packages/fcl-db/tests/testbasics.pas
U packages/fcl-db/tests/dbtestframework_gui.lpi
U packages/fcl-db/tests/testdbbasics.pas
U packages/fcl-db/tests/testdbexport.pas
U packages/fcl-db/tests/toolsunit.pas
U packages/fcl-db/tests/testfieldtypes.pas
--- Merging r24771 into '.':
A packages/fcl-db/tests/reruntest.sh
A packages/fcl-db/tests/test-list.txt
A packages/fcl-db/tests/testleaks.sh
--- Merging r24795 into '.':
G packages/fcl-db/src/sqldb/sqldb.pp
--- Merging r24796 into '.':
G packages/fcl-db/src/base/bufdataset.pas
--- Merging r24797 into '.':
G packages/fcl-db/src/base/bufdataset.pas
--- Merging r24802 into '.':
G packages/fcl-db/tests/testdbbasics.pas
G packages/fcl-db/src/base/bufdataset.pas
--- Merging r24803 into '.':
G packages/fcl-db/src/sqldb/sqldb.pp
--- Merging r24880 into '.':
U packages/fcl-db/src/sqldb/odbc/odbcconn.pas
U packages/fcl-db/src/sqldb/interbase/ibconnection.pp
G packages/fcl-db/src/sqldb/sqldb.pp
U packages/fcl-db/src/sqldb/postgres/pqconnection.pp
G packages/fcl-db/tests/sqldbtoolsunit.pas
A packages/fcl-db/tests/testsqldb.pas
G packages/fcl-db/tests/testfieldtypes.pas
--- Merging r24881 into '.':
G packages/fcl-db/tests/toolsunit.pas
--- Merging r24883 into '.':
U packages/fcl-db/tests/dbtestframework_gui.lpr
U packages/fcl-db/tests/dbtestframework.pas
--- Merging r24888 into '.':
G packages/fcl-db/tests/testdbbasics.pas
G packages/fcl-db/tests/toolsunit.pas
U packages/fcl-db/tests/testsqldb.pas

# revisions: 23790,24742,24768,24769,24770,24771,24795,24796,24797,24802,24803,24880,24881,24883,24888
r23790 | michael | 2013-03-11 16:26:12 +0100 (Mon, 11 Mar 2013) | 1 line
Changed paths:
M /trunk/packages/sqlite/src/sqlite3db.pas

* Patch from Michael Fuchs to fix mem leakn (bug ID 23247)
r24742 | michael | 2013-06-01 20:23:41 +0200 (Sat, 01 Jun 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/sqldb.pp

* Refactor TSQLQuery to use TSQLStatement
r24768 | michael | 2013-06-02 15:13:42 +0200 (Sun, 02 Jun 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/sqldb.pp

* Fix some memory leaks (not all: see AppendDeleteCancelUpd)
r24769 | michael | 2013-06-02 15:13:54 +0200 (Sun, 02 Jun 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/base/bufdataset.pas

* Fix some memory leaks (not all: see AppendDeleteCancelUpd)
r24770 | michael | 2013-06-02 15:14:41 +0200 (Sun, 02 Jun 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-db/tests/dbtestframework_gui.lpi
M /trunk/packages/fcl-db/tests/sqldbtoolsunit.pas
M /trunk/packages/fcl-db/tests/testbasics.pas
M /trunk/packages/fcl-db/tests/testdbbasics.pas
M /trunk/packages/fcl-db/tests/testdbexport.pas
M /trunk/packages/fcl-db/tests/testfieldtypes.pas
M /trunk/packages/fcl-db/tests/toolsunit.pas

* Fix memory leaks in tests
r24771 | michael | 2013-06-02 15:16:15 +0200 (Sun, 02 Jun 2013) | 1 line
Changed paths:
A /trunk/packages/fcl-db/tests/reruntest.sh
A /trunk/packages/fcl-db/tests/test-list.txt
A /trunk/packages/fcl-db/tests/testleaks.sh

* Script to test for memory leaks
r24795 | lacak | 2013-06-03 08:29:51 +0200 (Mon, 03 Jun 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/sqldb.pp

fcl-db: sqldb: FSelectable must be set to true by default, to work for TSQLConnections which does not provide information about statement (if there will be resultset) at preparation stage.
r24796 | lacak | 2013-06-03 08:43:35 +0200 (Mon, 03 Jun 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/base/bufdataset.pas

fcl-db: formatting (unification char-case)
r24797 | lacak | 2013-06-03 12:56:31 +0200 (Mon, 03 Jun 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/base/bufdataset.pas

fcl-db: bufdataset: use call to FreeBlobBuffers instead of separate Freemem+Dispose
r24802 | lacak | 2013-06-04 07:47:36 +0200 (Tue, 04 Jun 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/base/bufdataset.pas
M /trunk/packages/fcl-db/tests/testdbbasics.pas

fcl-db: bufdataset: Fix wrong initialization of OrgBufID in new blob buffer.
r24803 | lacak | 2013-06-04 12:11:38 +0200 (Tue, 04 Jun 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/sqldb.pp

fcl-db: sqldb: Some SQLConnections does not support statement [un]preparation, so let them do cleanup f.e. cancel pending queries and/or free resultset when dataset is closed.
r24880 | lacak | 2013-06-12 13:01:59 +0200 (Wed, 12 Jun 2013) | 5 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/interbase/ibconnection.pp
M /trunk/packages/fcl-db/src/sqldb/odbc/odbcconn.pas
M /trunk/packages/fcl-db/src/sqldb/postgres/pqconnection.pp
M /trunk/packages/fcl-db/src/sqldb/sqldb.pp
M /trunk/packages/fcl-db/tests/sqldbtoolsunit.pas
M /trunk/packages/fcl-db/tests/testfieldtypes.pas
A /trunk/packages/fcl-db/tests/testsqldb.pas

fcl-db: sqldb:
- handle quoted table names when retrieving server index informations for quoted TableName
- reset updated flag of ServerIndexDefs when SQL.Text changes
- new tests unit for sqlDB
- tested for FB, MSSQL, MySQL, PostgreSQL, Sqlite, odbc_MSSQL, odbc_PostgreSQL, odbc_Firebird, odbc_MySQL
r24881 | lacak | 2013-06-12 14:30:56 +0200 (Wed, 12 Jun 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-db/tests/toolsunit.pas

fcl-db: tests: formatting (order methods)
r24883 | lacak | 2013-06-12 14:54:37 +0200 (Wed, 12 Jun 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-db/tests/dbtestframework.pas
M /trunk/packages/fcl-db/tests/dbtestframework_gui.lpr

fcl-db: tests: add TestSQLDB to dbtestframework
r24888 | lacak | 2013-06-13 13:46:42 +0200 (Thu, 13 Jun 2013) | 1 line
Changed paths:
M /trunk/packages/fcl-db/tests/testdbbasics.pas
M /trunk/packages/fcl-db/tests/testsqldb.pas
M /trunk/packages/fcl-db/tests/toolsunit.pas

fcl-db: tests: introduce TDBBasicsTestCase as ancestor for other test cases (call DBConnector.StartTest and StopTest from him)

git-svn-id: branches/fixes_2_6@25458 -

marco 12 years ago
parent
commit
897199af08

+ 4 - 0
.gitattributes

@@ -2017,12 +2017,14 @@ packages/fcl-db/tests/dbtestframework_gui.lpr svneol=native#text/plain
 packages/fcl-db/tests/inieditor.lfm svneol=native#text/plain
 packages/fcl-db/tests/inieditor.lfm svneol=native#text/plain
 packages/fcl-db/tests/inieditor.pas svneol=native#text/plain
 packages/fcl-db/tests/inieditor.pas svneol=native#text/plain
 packages/fcl-db/tests/memdstoolsunit.pas svneol=native#text/plain
 packages/fcl-db/tests/memdstoolsunit.pas svneol=native#text/plain
+packages/fcl-db/tests/reruntest.sh svneol=native#text/plain
 packages/fcl-db/tests/sdfdstoolsunit.pas svneol=native#text/plain
 packages/fcl-db/tests/sdfdstoolsunit.pas svneol=native#text/plain
 packages/fcl-db/tests/sqldbtoolsunit.pas svneol=native#text/plain
 packages/fcl-db/tests/sqldbtoolsunit.pas svneol=native#text/plain
 packages/fcl-db/tests/tcgensql.pas svneol=native#text/plain
 packages/fcl-db/tests/tcgensql.pas svneol=native#text/plain
 packages/fcl-db/tests/tcparser.pas svneol=native#text/plain
 packages/fcl-db/tests/tcparser.pas svneol=native#text/plain
 packages/fcl-db/tests/tcsdfdata.pp svneol=native#text/plain
 packages/fcl-db/tests/tcsdfdata.pp svneol=native#text/plain
 packages/fcl-db/tests/tcsqlscanner.pas svneol=native#text/plain
 packages/fcl-db/tests/tcsqlscanner.pas svneol=native#text/plain
+packages/fcl-db/tests/test-list.txt svneol=native#text/plain
 packages/fcl-db/tests/test.json svneol=native#text/plain
 packages/fcl-db/tests/test.json svneol=native#text/plain
 packages/fcl-db/tests/testbasics.pas svneol=native#text/plain
 packages/fcl-db/tests/testbasics.pas svneol=native#text/plain
 packages/fcl-db/tests/testbufdatasetstreams.pas svneol=native#text/plain
 packages/fcl-db/tests/testbufdatasetstreams.pas svneol=native#text/plain
@@ -2032,8 +2034,10 @@ packages/fcl-db/tests/testdbexport.pas svneol=native#text/plain
 packages/fcl-db/tests/testdddiff.pp svneol=native#text/plain
 packages/fcl-db/tests/testdddiff.pp svneol=native#text/plain
 packages/fcl-db/tests/testfieldtypes.pas svneol=native#text/plain
 packages/fcl-db/tests/testfieldtypes.pas svneol=native#text/plain
 packages/fcl-db/tests/testjsondataset.pp svneol=native#text/plain
 packages/fcl-db/tests/testjsondataset.pp svneol=native#text/plain
+packages/fcl-db/tests/testleaks.sh svneol=native#text/plain
 packages/fcl-db/tests/testspecifictbufdataset.pas svneol=native#text/plain
 packages/fcl-db/tests/testspecifictbufdataset.pas svneol=native#text/plain
 packages/fcl-db/tests/testspecifictdbf.pas svneol=native#text/plain
 packages/fcl-db/tests/testspecifictdbf.pas svneol=native#text/plain
+packages/fcl-db/tests/testsqldb.pas svneol=native#text/pascal
 packages/fcl-db/tests/testsqlfiles.lpi svneol=native#text/plain
 packages/fcl-db/tests/testsqlfiles.lpi svneol=native#text/plain
 packages/fcl-db/tests/testsqlfiles.lpr svneol=native#text/plain
 packages/fcl-db/tests/testsqlfiles.lpr svneol=native#text/plain
 packages/fcl-db/tests/testsqlscanner.lpi svneol=native#text/plain
 packages/fcl-db/tests/testsqlscanner.lpi svneol=native#text/plain

+ 76 - 68
packages/fcl-db/src/base/bufdataset.pas

@@ -461,9 +461,9 @@ type
     procedure SetBufUniDirectional(const AValue: boolean);
     procedure SetBufUniDirectional(const AValue: boolean);
     procedure InitDefaultIndexes;
     procedure InitDefaultIndexes;
   protected
   protected
-    procedure UpdateIndexDefs; override;
     function GetNewWriteBlobBuffer : PBlobBuffer;
     function GetNewWriteBlobBuffer : PBlobBuffer;
     procedure FreeBlobBuffer(var ABlobBuffer: PBlobBuffer);
     procedure FreeBlobBuffer(var ABlobBuffer: PBlobBuffer);
+    procedure UpdateIndexDefs; override;
     procedure SetRecNo(Value: Longint); override;
     procedure SetRecNo(Value: Longint); override;
     function  GetRecNo: Longint; override;
     function  GetRecNo: Longint; override;
     function GetChangeCount: integer; virtual;
     function GetChangeCount: integer; virtual;
@@ -507,7 +507,6 @@ type
     function LoadField(FieldDef : TFieldDef;buffer : pointer; out CreateBlob : boolean) : boolean; virtual;
     function LoadField(FieldDef : TFieldDef;buffer : pointer; out CreateBlob : boolean) : boolean; virtual;
     procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField); virtual; abstract;
     procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField); virtual; abstract;
     function IsReadFromPacket : Boolean;
     function IsReadFromPacket : Boolean;
-
   public
   public
     constructor Create(AOwner: TComponent); override;
     constructor Create(AOwner: TComponent); override;
     function GetFieldData(Field: TField; Buffer: Pointer;
     function GetFieldData(Field: TField; Buffer: Pointer;
@@ -1118,9 +1117,12 @@ begin
     begin
     begin
     FFileStream := TFileStream.Create(FileName,fmOpenRead);
     FFileStream := TFileStream.Create(FileName,fmOpenRead);
     FDatasetReader := GetPacketReader(dfAny, FFileStream);
     FDatasetReader := GetPacketReader(dfAny, FFileStream);
+    end;
+  if assigned(FDatasetReader) then
+    begin
     FReadFromFile := True;
     FReadFromFile := True;
+    IntLoadFielddefsFromFile;
     end;
     end;
-  if assigned(FDatasetReader) then IntLoadFielddefsFromFile;
 
 
   // This is to check if the dataset is actually created (By calling CreateDataset,
   // This is to check if the dataset is actually created (By calling CreateDataset,
   // reading from a stream in some other way implemented by a descendent)
   // reading from a stream in some other way implemented by a descendent)
@@ -1887,8 +1889,12 @@ begin
   // if the current update buffer matches, immediately return true
   // if the current update buffer matches, immediately return true
   if (FCurrentUpdateBuffer < length(FUpdateBuffer)) and (
   if (FCurrentUpdateBuffer < length(FUpdateBuffer)) and (
       FCurrentIndex.CompareBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData,@ABookmark) or
       FCurrentIndex.CompareBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData,@ABookmark) or
-      (IncludePrior and (FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind=ukDelete) and FCurrentIndex.CompareBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData,@ABookmark))) then
-    Result := True
+      (IncludePrior
+        and (FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind=ukDelete)
+        and  FCurrentIndex.CompareBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData,@ABookmark))) then
+     begin
+     Result := True;
+     end
   else
   else
     Result := GetRecordUpdateBuffer(ABookmark,IncludePrior);
     Result := GetRecordUpdateBuffer(ABookmark,IncludePrior);
 end;
 end;
@@ -1897,7 +1903,7 @@ function TCustomBufDataset.LoadBuffer(Buffer : TRecordBuffer): TGetResult;
 
 
 var NullMask        : pbyte;
 var NullMask        : pbyte;
     x               : longint;
     x               : longint;
-    CreateblobField : boolean;
+    CreateBlobField : boolean;
     BufBlob         : PBufBlobField;
     BufBlob         : PBufBlobField;
 
 
 begin
 begin
@@ -1921,9 +1927,9 @@ begin
 
 
   for x := 0 to FieldDefs.count-1 do
   for x := 0 to FieldDefs.count-1 do
     begin
     begin
-    if not LoadField(FieldDefs[x],buffer,CreateblobField) then
+    if not LoadField(FieldDefs[x],buffer,CreateBlobField) then
       SetFieldIsNull(NullMask,x)
       SetFieldIsNull(NullMask,x)
-    else if CreateblobField then
+    else if CreateBlobField then
       begin
       begin
       BufBlob := PBufBlobField(Buffer);
       BufBlob := PBufBlobField(Buffer);
       BufBlob^.BlobBuffer := GetNewBlobBuffer;
       BufBlob^.BlobBuffer := GetNewBlobBuffer;
@@ -1937,7 +1943,7 @@ end;
 function TCustomBufDataset.GetCurrentBuffer: TRecordBuffer;
 function TCustomBufDataset.GetCurrentBuffer: TRecordBuffer;
 begin
 begin
   if State = dsFilter then Result := FFilterBuffer
   if State = dsFilter then Result := FFilterBuffer
-  else if state = dsCalcFields then Result := CalcBuffer
+  else if State = dsCalcFields then Result := CalcBuffer
   else Result := ActiveBuffer;
   else Result := ActiveBuffer;
 end;
 end;
 
 
@@ -2054,7 +2060,6 @@ begin
     begin
     begin
     FCurrentUpdateBuffer := length(FUpdateBuffer);
     FCurrentUpdateBuffer := length(FUpdateBuffer);
     SetLength(FUpdateBuffer,FCurrentUpdateBuffer+1);
     SetLength(FUpdateBuffer,FCurrentUpdateBuffer+1);
-
     FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer := IntAllocRecordBuffer;
     FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer := IntAllocRecordBuffer;
     move(RemRec^, FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer^,FRecordSize);
     move(RemRec^, FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer^,FRecordSize);
     end
     end
@@ -2091,30 +2096,34 @@ var StoreRecBM     : TBufBookmark;
     StoreUpdBuf    : integer;
     StoreUpdBuf    : integer;
     Bm             : TBufBookmark;
     Bm             : TBufBookmark;
   begin
   begin
-    with AUpdBuffer do if assigned(BookmarkData.BookmarkData) then // this is used to exclude buffers which are already handled
+    with AUpdBuffer do
       begin
       begin
-      if (UpdateKind = ukModify) then
+      if Not assigned(BookmarkData.BookmarkData) then
+        exit;// this is used to exclude buffers which are already handled
+      Case UpdateKind of
+      ukModify:
         begin
         begin
         FCurrentIndex.GotoBookmark(@BookmarkData);
         FCurrentIndex.GotoBookmark(@BookmarkData);
         move(TRecordBuffer(OldValuesBuffer)^,TRecordBuffer(FCurrentIndex.CurrentBuffer)^,FRecordSize);
         move(TRecordBuffer(OldValuesBuffer)^,TRecordBuffer(FCurrentIndex.CurrentBuffer)^,FRecordSize);
         FreeRecordBuffer(OldValuesBuffer);
         FreeRecordBuffer(OldValuesBuffer);
-        end
-      else if (UpdateKind = ukDelete) and (assigned(OldValuesBuffer)) then
-        begin
-        FCurrentIndex.GotoBookmark(@NextBookmarkData);
-        FCurrentIndex.InsertRecordBeforeCurrentRecord(TRecordBuffer(BookmarkData.BookmarkData));
-        FCurrentIndex.ScrollBackward;
-        move(TRecordBuffer(OldValuesBuffer)^,TRecordBuffer(FCurrentIndex.CurrentBuffer)^,FRecordSize);
-
-{        for x := length(FUpdateBuffer)-1 downto 0 do
+        end;
+      ukDelete:
+        if (assigned(OldValuesBuffer)) then
           begin
           begin
-          if (FUpdateBuffer[x].UpdateKind=ukDelete) and FCurrentIndex.CompareBookmarks(@FUpdateBuffer[x].NextBookmarkData,@BookmarkData) then
-            CancelUpdBuffer(FUpdateBuffer[x]);
-          end;}
-        FreeRecordBuffer(OldValuesBuffer);
-        inc(FBRecordCount);
-        end
-      else if (UpdateKind = ukInsert) then
+          FCurrentIndex.GotoBookmark(@NextBookmarkData);
+          FCurrentIndex.InsertRecordBeforeCurrentRecord(TRecordBuffer(BookmarkData.BookmarkData));
+          FCurrentIndex.ScrollBackward;
+          move(TRecordBuffer(OldValuesBuffer)^,TRecordBuffer(FCurrentIndex.CurrentBuffer)^,FRecordSize);
+
+          {for x := length(FUpdateBuffer)-1 downto 0 do
+            begin
+            if (FUpdateBuffer[x].UpdateKind=ukDelete) and FCurrentIndex.CompareBookmarks(@FUpdateBuffer[x].NextBookmarkData,@BookmarkData) then
+              CancelUpdBuffer(FUpdateBuffer[x]);
+            end;}
+          FreeRecordBuffer(OldValuesBuffer);
+          inc(FBRecordCount);
+          end  ;
+      ukInsert:
         begin
         begin
         // Process all update buffers linked to this record before this record is removed
         // Process all update buffers linked to this record before this record is removed
         StoreUpdBuf:=FCurrentUpdateBuffer;
         StoreUpdBuf:=FCurrentUpdateBuffer;
@@ -2123,7 +2132,10 @@ var StoreRecBM     : TBufBookmark;
         if GetRecordUpdateBuffer(Bm,True,False) then
         if GetRecordUpdateBuffer(Bm,True,False) then
           begin
           begin
           repeat
           repeat
-          if (FCurrentUpdateBuffer<>StoreUpdBuf) then CancelUpdBuffer(FUpdateBuffer[FCurrentUpdateBuffer]);
+          if (FCurrentUpdateBuffer<>StoreUpdBuf) then
+            begin
+            CancelUpdBuffer(FUpdateBuffer[FCurrentUpdateBuffer]);
+            end;
           until not GetRecordUpdateBuffer(Bm,True,True);
           until not GetRecordUpdateBuffer(Bm,True,True);
           end;
           end;
         FCurrentUpdateBuffer:=StoreUpdBuf;
         FCurrentUpdateBuffer:=StoreUpdBuf;
@@ -2143,6 +2155,7 @@ var StoreRecBM     : TBufBookmark;
         FreeRecordBuffer(TmpBuf);
         FreeRecordBuffer(TmpBuf);
         dec(FBRecordCount);
         dec(FBRecordCount);
         end;
         end;
+      end;
       BookmarkData.BookmarkData:=nil;
       BookmarkData.BookmarkData:=nil;
       end;
       end;
   end;
   end;
@@ -2252,25 +2265,27 @@ procedure TCustomBufDataset.MergeChangeLog;
 var r            : Integer;
 var r            : Integer;
 
 
 begin
 begin
+  for r:=0 to length(FUpdateBuffer)-1 do
+    if assigned(FUpdateBuffer[r].OldValuesBuffer) then
+      FreeMem(FUpdateBuffer[r].OldValuesBuffer);
   SetLength(FUpdateBuffer,0);
   SetLength(FUpdateBuffer,0);
 
 
   if assigned(FUpdateBlobBuffers) then for r:=0 to length(FUpdateBlobBuffers)-1 do
   if assigned(FUpdateBlobBuffers) then for r:=0 to length(FUpdateBlobBuffers)-1 do
-   if assigned(FUpdateBlobBuffers[r]) then
-    begin
-    if FUpdateBlobBuffers[r]^.OrgBufID >= 0 then
+    if assigned(FUpdateBlobBuffers[r]) then
       begin
       begin
-      Freemem(FBlobBuffers[FUpdateBlobBuffers[r]^.OrgBufID]^.Buffer);
-      Dispose(FBlobBuffers[FUpdateBlobBuffers[r]^.OrgBufID]);
-      FBlobBuffers[FUpdateBlobBuffers[r]^.OrgBufID] :=FUpdateBlobBuffers[r];
-      end
-    else
-      begin
-      setlength(FBlobBuffers,length(FBlobBuffers)+1);
-      FUpdateBlobBuffers[r]^.OrgBufID := high(FBlobBuffers);
-      FBlobBuffers[high(FBlobBuffers)] := FUpdateBlobBuffers[r];
-
+      // update blob buffer is already referenced from record buffer (see InternalPost)
+      if FUpdateBlobBuffers[r]^.OrgBufID >= 0 then
+        begin
+        FreeBlobBuffer(FBlobBuffers[FUpdateBlobBuffers[r]^.OrgBufID]);
+        FBlobBuffers[FUpdateBlobBuffers[r]^.OrgBufID] := FUpdateBlobBuffers[r];
+        end
+      else
+        begin
+        setlength(FBlobBuffers,length(FBlobBuffers)+1);
+        FUpdateBlobBuffers[r]^.OrgBufID := high(FBlobBuffers);
+        FBlobBuffers[high(FBlobBuffers)] := FUpdateBlobBuffers[r];
+        end;
       end;
       end;
-    end;
   SetLength(FUpdateBlobBuffers,0);
   SetLength(FUpdateBlobBuffers,0);
 end;
 end;
 
 
@@ -2281,12 +2296,8 @@ Var i            : integer;
 
 
 begin
 begin
   if assigned(FUpdateBlobBuffers) then for i:=0 to length(FUpdateBlobBuffers)-1 do
   if assigned(FUpdateBlobBuffers) then for i:=0 to length(FUpdateBlobBuffers)-1 do
-   if assigned(FUpdateBlobBuffers[i]) and (FUpdateBlobBuffers[i]^.FieldNo>0) then
-    begin
-    Reallocmem(FUpdateBlobBuffers[i]^.Buffer,0);
-    Dispose(FUpdateBlobBuffers[i]);
-    FUpdateBlobBuffers[i] := nil;
-    end;
+    if assigned(FUpdateBlobBuffers[i]) and (FUpdateBlobBuffers[i]^.FieldNo>0) then
+      FreeBlobBuffer(FUpdateBlobBuffers[i]);
 end;
 end;
 
 
 procedure TCustomBufDataset.InternalPost;
 procedure TCustomBufDataset.InternalPost;
@@ -2320,7 +2331,6 @@ begin
       FAutoIncField.AsInteger := FAutoIncValue;
       FAutoIncField.AsInteger := FAutoIncValue;
       inc(FAutoIncValue);
       inc(FAutoIncValue);
       end;
       end;
-
     // The active buffer is the newly created TDataset record,
     // The active buffer is the newly created TDataset record,
     // from which the bookmark is set to the record where the new record should be
     // from which the bookmark is set to the record where the new record should be
     // inserted
     // inserted
@@ -2472,7 +2482,7 @@ var
     TmpRecBuffer : PBufRecLinkItem;
     TmpRecBuffer : PBufRecLinkItem;
 
 
 begin
 begin
-  checkbrowsemode;
+  CheckBrowseMode;
   if value > RecordCount then
   if value > RecordCount then
     begin
     begin
     repeat until (getnextpacket < FPacketRecords) or (value <= RecordCount) or (FPacketRecords = -1);
     repeat until (getnextpacket < FPacketRecords) or (value <= RecordCount) or (FPacketRecords = -1);
@@ -2495,7 +2505,7 @@ Var abuf            :  TRecordBuffer;
 begin
 begin
   abuf := GetCurrentBuffer;
   abuf := GetCurrentBuffer;
   // If abuf isn't assigned, the recordset probably isn't opened.
   // If abuf isn't assigned, the recordset probably isn't opened.
-  if assigned(abuf) and (FBRecordCount>0) and (state <> dsInsert) then
+  if assigned(abuf) and (FBRecordCount>0) and (State <> dsInsert) then
     Result:=FCurrentIndex.GetRecNo(PBufBookmark(abuf+FRecordSize))
     Result:=FCurrentIndex.GetRecNo(PBufBookmark(abuf+FRecordSize))
   else
   else
     result := 0;
     result := 0;
@@ -2533,7 +2543,7 @@ begin
   setlength(FBlobBuffers,length(FBlobBuffers)+1);
   setlength(FBlobBuffers,length(FBlobBuffers)+1);
   new(ABlobBuffer);
   new(ABlobBuffer);
   fillbyte(ABlobBuffer^,sizeof(ABlobBuffer^),0);
   fillbyte(ABlobBuffer^,sizeof(ABlobBuffer^),0);
-  ABlobBuffer^.OrgBufID := high(FUpdateBlobBuffers);
+  ABlobBuffer^.OrgBufID := high(FBlobBuffers);
   FBlobBuffers[high(FBlobBuffers)] := ABlobBuffer;
   FBlobBuffers[high(FBlobBuffers)] := ABlobBuffer;
   result := ABlobBuffer;
   result := ABlobBuffer;
 end;
 end;
@@ -2565,7 +2575,7 @@ begin
   Case Origin of
   Case Origin of
     soFromBeginning : FPosition:=Offset;
     soFromBeginning : FPosition:=Offset;
     soFromEnd       : FPosition:=FBlobBuffer^.Size+Offset;
     soFromEnd       : FPosition:=FBlobBuffer^.Size+Offset;
-    soFromCurrent   : FpoSition:=FPosition+Offset;
+    soFromCurrent   : FPosition:=FPosition+Offset;
   end;
   end;
   Result:=FPosition;
   Result:=FPosition;
 end;
 end;
@@ -2603,24 +2613,24 @@ var bufblob : TBufBlobField;
 
 
 begin
 begin
   FDataset := Field.DataSet as TCustomBufDataset;
   FDataset := Field.DataSet as TCustomBufDataset;
-  if mode = bmread then
+  if Mode = bmRead then
     begin
     begin
-    if not field.getData(@bufblob) then
+    if not Field.GetData(@bufblob) then
       DatabaseError(SFieldIsNull);
       DatabaseError(SFieldIsNull);
     if not assigned(bufblob.BlobBuffer) then with FDataSet do
     if not assigned(bufblob.BlobBuffer) then with FDataSet do
       begin
       begin
       FBlobBuffer := GetNewBlobBuffer;
       FBlobBuffer := GetNewBlobBuffer;
       bufblob.BlobBuffer := FBlobBuffer;
       bufblob.BlobBuffer := FBlobBuffer;
-      LoadBlobIntoBuffer(FieldDefs[field.FieldNo-1],@bufblob);
+      LoadBlobIntoBuffer(FieldDefs[Field.FieldNo-1],@bufblob);
       end
       end
     else
     else
       FBlobBuffer := bufblob.BlobBuffer;
       FBlobBuffer := bufblob.BlobBuffer;
     end
     end
-  else if mode=bmWrite then with FDataSet as TCustomBufDataset do
+  else if Mode=bmWrite then with FDataSet as TCustomBufDataset do
     begin
     begin
     FBlobBuffer := GetNewWriteBlobBuffer;
     FBlobBuffer := GetNewWriteBlobBuffer;
     FBlobBuffer^.FieldNo := Field.FieldNo;
     FBlobBuffer^.FieldNo := Field.FieldNo;
-    if (field.getData(@bufblob)) and assigned(bufblob.BlobBuffer) then
+    if (Field.GetData(@bufblob)) and assigned(bufblob.BlobBuffer) then
       FBlobBuffer^.OrgBufID := bufblob.BlobBuffer^.OrgBufID
       FBlobBuffer^.OrgBufID := bufblob.BlobBuffer^.OrgBufID
     else
     else
       FBlobBuffer^.OrgBufID := -1;
       FBlobBuffer^.OrgBufID := -1;
@@ -2633,22 +2643,19 @@ var bufblob : TBufBlobField;
 
 
 begin
 begin
   result := nil;
   result := nil;
-  if mode=bmread then
+  if Mode = bmRead then
     begin
     begin
-    if not field.getData(@bufblob) then
+    if not Field.GetData(@bufblob) then
       exit;
       exit;
 
 
-    result := TBufBlobStream.Create(Field as tblobfield,bmread);
+    result := TBufBlobStream.Create(Field as TBlobField, bmRead);
     end
     end
-  else if mode=bmWrite then
+  else if Mode = bmWrite then
     begin
     begin
-    if not (state in [dsEdit, dsInsert, dsFilter, dsCalcFields]) then
-      begin
+    if not (State in [dsEdit, dsInsert, dsFilter, dsCalcFields]) then
       DatabaseErrorFmt(SNotEditing,[Name],self);
       DatabaseErrorFmt(SNotEditing,[Name],self);
-      exit;
-      end;
 
 
-    result := TBufBlobStream.Create(Field as tblobfield,bmWrite);
+    result := TBufBlobStream.Create(Field as TBlobField, bmWrite);
 
 
     if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
     if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
       DataEvent(deFieldChange, Ptrint(Field));
       DataEvent(deFieldChange, Ptrint(Field));
@@ -2931,6 +2938,7 @@ begin
 
 
       FFilterBuffer:=IntAllocRecordBuffer;
       FFilterBuffer:=IntAllocRecordBuffer;
       fillchar(FFilterBuffer^,FNullmaskSize,0);
       fillchar(FFilterBuffer^,FNullmaskSize,0);
+
       FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer := FFilterBuffer;
       FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer := FFilterBuffer;
       FDatasetReader.RestoreRecord(self);
       FDatasetReader.RestoreRecord(self);
 
 

+ 6 - 1
packages/fcl-db/src/sqldb/interbase/ibconnection.pp

@@ -1379,6 +1379,11 @@ begin
   if not assigned(Transaction) then
   if not assigned(Transaction) then
     DatabaseError(SErrConnTransactionnSet);
     DatabaseError(SErrConnTransactionnSet);
 
 
+  if (length(TableName)>2) and (TableName[1]='"') and (TableName[length(TableName)]='"') then
+    TableName := AnsiDequotedStr(TableName, '"')
+  else
+    TableName := UpperCase(TableName);
+
   qry := tsqlquery.Create(nil);
   qry := tsqlquery.Create(nil);
   qry.transaction := Transaction;
   qry.transaction := Transaction;
   qry.database := Self;
   qry.database := Self;
@@ -1402,7 +1407,7 @@ begin
               'rel_con.rdb$index_name = ind.rdb$index_name '+
               'rel_con.rdb$index_name = ind.rdb$index_name '+
             'where '+
             'where '+
               '(ind_seg.rdb$index_name = ind.rdb$index_name) and '+
               '(ind_seg.rdb$index_name = ind.rdb$index_name) and '+
-              '(ind.rdb$relation_name=''' +  UpperCase(TableName) +''') '+
+              '(ind.rdb$relation_name=' + QuotedStr(TableName) + ') '+
             'order by '+
             'order by '+
               'ind.rdb$index_name;');
               'ind.rdb$index_name;');
     open;
     open;

+ 8 - 0
packages/fcl-db/src/sqldb/odbc/odbcconn.pas

@@ -1284,6 +1284,7 @@ end;
 
 
 procedure TODBCConnection.UpdateIndexDefs(IndexDefs: TIndexDefs; TableName: string);
 procedure TODBCConnection.UpdateIndexDefs(IndexDefs: TIndexDefs; TableName: string);
 var
 var
+  Len: integer;
   StmtHandle:SQLHSTMT;
   StmtHandle:SQLHSTMT;
   Res:SQLRETURN;
   Res:SQLRETURN;
   IndexDef: TIndexDef;
   IndexDef: TIndexDef;
@@ -1299,6 +1300,13 @@ var
 const
 const
   DEFAULT_NAME_LEN = 255;
   DEFAULT_NAME_LEN = 255;
 begin
 begin
+  Len := length(TableName);
+  if Len > 2 then
+    if (TableName[1] in ['"','`']) and (TableName[Len]  in ['"','`']) then
+      TableName := AnsiDequotedStr(TableName, TableName[1])
+    else if (TableName[1] in ['[']) and (TableName[Len] in [']']) then
+      TableName := copy(TableName, 2, Len-2);
+
   // allocate statement handle
   // allocate statement handle
   StmtHandle := SQL_NULL_HANDLE;
   StmtHandle := SQL_NULL_HANDLE;
   ODBCCheckResult(
   ODBCCheckResult(

+ 7 - 1
packages/fcl-db/src/sqldb/postgres/pqconnection.pp

@@ -1041,11 +1041,17 @@ end;
 procedure TPQConnection.UpdateIndexDefs(IndexDefs : TIndexDefs;TableName : string);
 procedure TPQConnection.UpdateIndexDefs(IndexDefs : TIndexDefs;TableName : string);
 
 
 var qry : TSQLQuery;
 var qry : TSQLQuery;
+    relname : string;
 
 
 begin
 begin
   if not assigned(Transaction) then
   if not assigned(Transaction) then
     DatabaseError(SErrConnTransactionnSet);
     DatabaseError(SErrConnTransactionnSet);
 
 
+  if (length(TableName)>2) and (TableName[1]='"') and (TableName[length(TableName)]='"') then
+    relname := QuotedStr(AnsiDequotedStr(TableName, '"'))
+  else
+    relname := 'lower(' + QuotedStr(TableName) + ')';  // unquoted names are stored lower case in PostgreSQL which is incompatible with the SQL standard
+
   qry := tsqlquery.Create(nil);
   qry := tsqlquery.Create(nil);
   qry.transaction := Transaction;
   qry.transaction := Transaction;
   qry.database := Self;
   qry.database := Self;
@@ -1072,7 +1078,7 @@ begin
               '(ia.attrelid = i.indexrelid) and '+
               '(ia.attrelid = i.indexrelid) and '+
               '(ic.oid = i.indexrelid) and '+
               '(ic.oid = i.indexrelid) and '+
               '(ta.attnum = i.indkey[ia.attnum-1]) and '+
               '(ta.attnum = i.indkey[ia.attnum-1]) and '+
-              '(upper(tc.relname)=''' +  UpperCase(TableName) +''') '+
+              '(tc.relname = ' + relname + ') '+
             'order by '+
             'order by '+
               'ic.relname;');
               'ic.relname;');
     open;
     open;

+ 310 - 169
packages/fcl-db/src/sqldb/sqldb.pp

@@ -221,20 +221,27 @@ type
     FDatabase: TSQLConnection;
     FDatabase: TSQLConnection;
     FParams: TParams;
     FParams: TParams;
     FSQL: TStrings;
     FSQL: TStrings;
-    FSQLBuf : String;
+    FOrigSQL : String;
+    FServerSQL : String;
     FTransaction: TSQLTransaction;
     FTransaction: TSQLTransaction;
     FDatasource : TDatasource;
     FDatasource : TDatasource;
     FParseSQL: Boolean;
     FParseSQL: Boolean;
-    procedure OnChangeSQL(Sender : TObject);
     procedure SetDatabase(AValue: TSQLConnection);
     procedure SetDatabase(AValue: TSQLConnection);
-    procedure SetDataSource(AValue: TDatasource);
     procedure SetParams(AValue: TParams);
     procedure SetParams(AValue: TParams);
     procedure SetSQL(AValue: TStrings);
     procedure SetSQL(AValue: TStrings);
     procedure SetTransaction(AValue: TSQLTransaction);
     procedure SetTransaction(AValue: TSQLTransaction);
     Function GetPrepared : Boolean;
     Function GetPrepared : Boolean;
   Protected
   Protected
+    procedure OnChangeSQL(Sender : TObject); virtual;
+    function GetDataSource: TDatasource; Virtual;
+    procedure SetDataSource(AValue: TDatasource); virtual;
+    procedure AllocateCursor;
+    procedure DeAllocateCursor;
     Function GetSchemaType : TSchemaType; virtual;
     Function GetSchemaType : TSchemaType; virtual;
+    Function GetSchemaObjectName : String; virtual;
+    Function GetSchemaPattern: String; virtual;
     Function IsSelectable : Boolean ; virtual;
     Function IsSelectable : Boolean ; virtual;
+    procedure GetStatementInfo(Var ASQL: String; Full: Boolean; ASchema: TSchemaType; out Info: TSQLStatementInfo); virtual;
     Procedure DoExecute; virtual;
     Procedure DoExecute; virtual;
     procedure DoPrepare; virtual;
     procedure DoPrepare; virtual;
     procedure DoUnPrepare; virtual;
     procedure DoUnPrepare; virtual;
@@ -247,7 +254,7 @@ type
     Property Transaction : TSQLTransaction Read FTransaction Write SetTransaction;
     Property Transaction : TSQLTransaction Read FTransaction Write SetTransaction;
     Property SQL : TStrings Read FSQL Write SetSQL;
     Property SQL : TStrings Read FSQL Write SetSQL;
     Property Params : TParams Read FParams Write SetParams;
     Property Params : TParams Read FParams Write SetParams;
-    Property Datasource : TDatasource Read FDataSource Write SetDataSource;
+    Property Datasource : TDatasource Read GetDataSource Write SetDataSource;
     Property ParseSQL : Boolean Read FParseSQL Write FParseSQL;
     Property ParseSQL : Boolean Read FParseSQL Write FParseSQL;
     Property CheckParams : Boolean Read FCheckParams Write FCheckParams default true;
     Property CheckParams : Boolean Read FCheckParams Write FCheckParams default true;
   Public
   Public
@@ -276,24 +283,26 @@ type
 
 
   TCustomSQLQuery = class (TCustomBufDataset)
   TCustomSQLQuery = class (TCustomBufDataset)
   private
   private
-    FCheckParams: Boolean;
-    FCursor              : TSQLCursor;
+    // FCheckParams: Boolean;
+    // FCursor              : TSQLCursor;
+    FParams: TParams;
+    FSchemaType: TSchemaType;
+//    FSQL: TStringlist;
     FUpdateable          : boolean;
     FUpdateable          : boolean;
     FTableName           : string;
     FTableName           : string;
-    FSQL                 : TStringList;
+    FStatement           : TCustomSQLStatement;
     FUpdateSQL,
     FUpdateSQL,
     FInsertSQL,
     FInsertSQL,
     FDeleteSQL           : TStringList;
     FDeleteSQL           : TStringList;
     FIsEOF               : boolean;
     FIsEOF               : boolean;
     FLoadingFieldDefs    : boolean;
     FLoadingFieldDefs    : boolean;
     FUpdateMode          : TUpdateMode;
     FUpdateMode          : TUpdateMode;
-    FParams              : TParams;
     FusePrimaryKeyAsKey  : Boolean;
     FusePrimaryKeyAsKey  : Boolean;
     FSQLBuf              : String;
     FSQLBuf              : String;
     FWhereStartPos       : integer;
     FWhereStartPos       : integer;
     FWhereStopPos        : integer;
     FWhereStopPos        : integer;
-    FParseSQL            : boolean;
-    FMasterLink          : TMasterParamsDatalink;
+    // FParseSQL            : boolean;
+//    FMasterLink          : TMasterParamsDatalink;
 //    FSchemaInfo          : TSchemaInfo;
 //    FSchemaInfo          : TSchemaInfo;
 
 
     FServerFilterText    : string;
     FServerFilterText    : string;
@@ -302,7 +311,6 @@ type
     FServerIndexDefs     : TServerIndexDefs;
     FServerIndexDefs     : TServerIndexDefs;
 
 
     // Used by SetSchemaType
     // Used by SetSchemaType
-    FSchemaType          : TSchemaType;
     FSchemaObjectName    : string;
     FSchemaObjectName    : string;
     FSchemaPattern       : string;
     FSchemaPattern       : string;
 
 
@@ -310,24 +318,31 @@ type
     FDeleteQry,
     FDeleteQry,
     FInsertQry           : TCustomSQLQuery;
     FInsertQry           : TCustomSQLQuery;
     procedure FreeFldBuffers;
     procedure FreeFldBuffers;
+    function GetCheckParams: Boolean;
+    function GetParams: TParams;
+    function GetParseSQL: Boolean;
     function GetServerIndexDefs: TServerIndexDefs;
     function GetServerIndexDefs: TServerIndexDefs;
+    function GetSQL: TStringlist;
     function GetStatementType : TStatementType;
     function GetStatementType : TStatementType;
+    procedure SetCheckParams(AValue: Boolean);
     procedure SetDeleteSQL(const AValue: TStringlist);
     procedure SetDeleteSQL(const AValue: TStringlist);
     procedure SetInsertSQL(const AValue: TStringlist);
     procedure SetInsertSQL(const AValue: TStringlist);
+    procedure SetParams(AValue: TParams);
     procedure SetParseSQL(AValue : Boolean);
     procedure SetParseSQL(AValue : Boolean);
     procedure SetSQL(const AValue: TStringlist);
     procedure SetSQL(const AValue: TStringlist);
     procedure SetUpdateSQL(const AValue: TStringlist);
     procedure SetUpdateSQL(const AValue: TStringlist);
     procedure SetUsePrimaryKeyAsKey(AValue : Boolean);
     procedure SetUsePrimaryKeyAsKey(AValue : Boolean);
     procedure SetUpdateMode(AValue : TUpdateMode);
     procedure SetUpdateMode(AValue : TUpdateMode);
-    procedure OnChangeSQL(Sender : TObject);
+//    procedure OnChangeSQL(Sender : TObject);
     procedure OnChangeModifySQL(Sender : TObject);
     procedure OnChangeModifySQL(Sender : TObject);
     procedure Execute;
     procedure Execute;
-    Function SQLParser(const ASQL : string) : TStatementType;
+//    Function SQLParser(const ASQL : string) : TStatementType;
     procedure ApplyFilter;
     procedure ApplyFilter;
     Function AddFilter(SQLstr : string) : string;
     Function AddFilter(SQLstr : string) : string;
   protected
   protected
     // abstract & virtual methods of TBufDataset
     // abstract & virtual methods of TBufDataset
     function Fetch : boolean; override;
     function Fetch : boolean; override;
+    Function Cursor : TSQLCursor;
     function LoadField(FieldDef : TFieldDef;buffer : pointer; out CreateBlob : boolean) : boolean; override;
     function LoadField(FieldDef : TFieldDef;buffer : pointer; out CreateBlob : boolean) : boolean; override;
     // abstract & virtual methods of TDataset
     // abstract & virtual methods of TDataset
     procedure UpdateServerIndexDefs; virtual;
     procedure UpdateServerIndexDefs; virtual;
@@ -395,16 +410,16 @@ type
   // protected
   // protected
     property SchemaType : TSchemaType read FSchemaType default stNoSchema;
     property SchemaType : TSchemaType read FSchemaType default stNoSchema;
     property Transaction;
     property Transaction;
-    property SQL : TStringlist read FSQL write SetSQL;
+    property SQL : TStringlist read GetSQL write SetSQL;
     property UpdateSQL : TStringlist read FUpdateSQL write SetUpdateSQL;
     property UpdateSQL : TStringlist read FUpdateSQL write SetUpdateSQL;
     property InsertSQL : TStringlist read FInsertSQL write SetInsertSQL;
     property InsertSQL : TStringlist read FInsertSQL write SetInsertSQL;
     property DeleteSQL : TStringlist read FDeleteSQL write SetDeleteSQL;
     property DeleteSQL : TStringlist read FDeleteSQL write SetDeleteSQL;
-    property Params : TParams read FParams write FParams;
+    property Params : TParams read GetParams Write SetParams;
     property UpdateMode : TUpdateMode read FUpdateMode write SetUpdateMode default upWhereKeyOnly;
     property UpdateMode : TUpdateMode read FUpdateMode write SetUpdateMode default upWhereKeyOnly;
     property UsePrimaryKeyAsKey : boolean read FUsePrimaryKeyAsKey write SetUsePrimaryKeyAsKey default true;
     property UsePrimaryKeyAsKey : boolean read FUsePrimaryKeyAsKey write SetUsePrimaryKeyAsKey default true;
     property StatementType : TStatementType read GetStatementType;
     property StatementType : TStatementType read GetStatementType;
-    property ParseSQL : Boolean read FParseSQL write SetParseSQL default true;
-    Property CheckParams : Boolean Read FCheckParams Write FCheckParams default true;
+    property ParseSQL : Boolean read GetParseSQL write SetParseSQL default true;
+    Property CheckParams : Boolean Read GetCheckParams Write SetCheckParams default true;
     Property DataSource : TDatasource Read GetDataSource Write SetDatasource;
     Property DataSource : TDatasource Read GetDataSource Write SetDatasource;
     property ServerFilter: string read FServerFilterText write SetServerFilterText;
     property ServerFilter: string read FServerFilterText write SetServerFilterText;
     property ServerFiltered: Boolean read FServerFiltered write SetServerFiltered default False;
     property ServerFiltered: Boolean read FServerFiltered write SetServerFiltered default False;
@@ -699,7 +714,7 @@ begin
   If (FParams.Count>0) and Assigned(FDatasource) then
   If (FParams.Count>0) and Assigned(FDatasource) then
     ; // FMasterLink.CopyParamsFromMaster(False);
     ; // FMasterLink.CopyParamsFromMaster(False);
   If LogEvent(detExecute) then
   If LogEvent(detExecute) then
-    Log(detExecute,FSQLBuf);
+    Log(detExecute,FServerSQL);
   Database.Execute(FCursor,Transaction, FParams);
   Database.Execute(FCursor,Transaction, FParams);
 end;
 end;
 
 
@@ -770,29 +785,64 @@ begin
   Result:=stNoSchema
   Result:=stNoSchema
 end;
 end;
 
 
+function TCustomSQLStatement.GetSchemaObjectName: String;
+begin
+  Result:='';
+end;
+
+function TCustomSQLStatement.GetSchemaPattern: String;
+begin
+  Result:='';
+end;
+
 function TCustomSQLStatement.IsSelectable: Boolean;
 function TCustomSQLStatement.IsSelectable: Boolean;
 begin
 begin
   Result:=False;
   Result:=False;
 end;
 end;
 
 
+
+procedure TCustomSQLStatement.GetStatementInfo(var ASQL: String; Full: Boolean;
+  ASchema: TSchemaType; out Info: TSQLStatementInfo);
+
+begin
+  Info:=Database.GetStatementInfo(ASQL,Full,ASchema);
+end;
+
+procedure TCustomSQLStatement.AllocateCursor;
+
+begin
+  if not assigned(FCursor) then
+    FCursor:=Database.AllocateCursorHandle;
+end;
+
+procedure TCustomSQLStatement.DeAllocateCursor;
+begin
+  if Assigned(FCursor) and Assigned(Database) then
+    DataBase.DeAllocateCursorHandle(FCursor);
+end;
+
 procedure TCustomSQLStatement.DoPrepare;
 procedure TCustomSQLStatement.DoPrepare;
 
 
 var
 var
   StmType: TStatementType;
   StmType: TStatementType;
-
+  I : TSQLStatementInfo;
 begin
 begin
-  FSQLBuf := TrimRight(FSQL.Text);
-  if (FSQLBuf='') then
+  if GetSchemaType=stNoSchema then
+    FOrigSQL := TrimRight(FSQL.Text)
+  else
+    FOrigSQL := Database.GetSchemaInfoSQL(GetSchemaType, GetSchemaObjectName, GetSchemaPattern);
+  if (FOrigSQL='') then
     DatabaseError(SErrNoStatement);
     DatabaseError(SErrNoStatement);
-  StmType:=Database.GetStatementInfo(FSQLBuf,ParseSQL,GetSchemaType).StatementType;
-  if not assigned(FCursor) then
-    FCursor:=Database.AllocateCursorHandle;
-  FCursor.FSelectable:=False;
+  FServerSQL:=FOrigSQL;
+  GetStatementInfo(FServerSQL,ParseSQL,GetSchemaType,I);
+  StmType:=I.StatementType;
+  AllocateCursor;
+  FCursor.FSelectable:=True; // let PrepareStatement and/or Execute alter it
   FCursor.FStatementType:=StmType;
   FCursor.FStatementType:=StmType;
   FCursor.FSchemaType:=GetSchemaType;
   FCursor.FSchemaType:=GetSchemaType;
   If LogEvent(detPrepare) then
   If LogEvent(detPrepare) then
-    Log(detPrepare,FSQLBuf);
-  Database.PrepareStatement(FCursor,Transaction,FSQLBuf,FParams);
+    Log(detPrepare,FServerSQL);
+  Database.PrepareStatement(FCursor,Transaction,FServerSQL,FParams);
 end;
 end;
 
 
 procedure TCustomSQLStatement.Prepare;
 procedure TCustomSQLStatement.Prepare;
@@ -807,18 +857,19 @@ begin
     Database.Open;
     Database.Open;
   if not Transaction.Active then
   if not Transaction.Active then
     Transaction.StartTransaction;
     Transaction.StartTransaction;
-  DoPrepare;
+  try
+    DoPrepare;
+  except
+    if assigned(FCursor) then
+      DataBase.DeAllocateCursorHandle(FCursor);
+    Raise;
+  end;
 end;
 end;
 
 
 procedure TCustomSQLStatement.Execute;
 procedure TCustomSQLStatement.Execute;
 begin
 begin
-  try
-    Prepare;
-    DoExecute;
-  finally
-    if (not Prepared) and (assigned(database)) and (assigned(FCursor))
-      then database.UnPrepareStatement(FCursor);
-  end;
+  Prepare;
+  DoExecute;
 end;
 end;
 
 
 procedure TCustomSQLStatement.DoUnPrepare;
 procedure TCustomSQLStatement.DoUnPrepare;
@@ -828,12 +879,17 @@ begin
     If Assigned(Database) then
     If Assigned(Database) then
       begin
       begin
       DataBase.UnPrepareStatement(FCursor);
       DataBase.UnPrepareStatement(FCursor);
-      DataBase.DeAllocateCursorHandle(FCursor);
+      DeAllocateCursor;
       end
       end
     else // this should never happen. It means a cursor handle leaks in the DB itself.
     else // this should never happen. It means a cursor handle leaks in the DB itself.
       FreeAndNil(FCursor);
       FreeAndNil(FCursor);
 end;
 end;
 
 
+function TCustomSQLStatement.GetDataSource: TDatasource;
+begin
+  Result:=FDatasource;
+end;
+
 procedure TCustomSQLStatement.Unprepare;
 procedure TCustomSQLStatement.Unprepare;
 begin
 begin
   if Prepared then
   if Prepared then
@@ -1283,13 +1339,13 @@ begin
 end;
 end;
 
 
 { TCustomSQLQuery }
 { TCustomSQLQuery }
+(*
 procedure TCustomSQLQuery.OnChangeSQL(Sender : TObject);
 procedure TCustomSQLQuery.OnChangeSQL(Sender : TObject);
 
 
 var ConnOptions : TConnOptions;
 var ConnOptions : TConnOptions;
     NewParams: TParams;
     NewParams: TParams;
 
 
 begin
 begin
-  UnPrepare;
   FSchemaType:=stNoSchema;
   FSchemaType:=stNoSchema;
   if (FSQL <> nil) and CheckParams then
   if (FSQL <> nil) and CheckParams then
     begin
     begin
@@ -1306,10 +1362,9 @@ begin
     finally
     finally
       NewParams.Free;
       NewParams.Free;
     end;
     end;
-    If Assigned(FMasterLink) then
-      FMasterLink.RefreshParamNames;
     end;
     end;
 end;
 end;
+*)
 
 
 function TCustomSQLQuery.ParamByName(const AParamName: String): TParam;
 function TCustomSQLQuery.ParamByName(const AParamName: String): TParam;
 
 
@@ -1328,6 +1383,8 @@ procedure TCustomSQLQuery.SetTransaction(Value: TDBTransaction);
 begin
 begin
   UnPrepare;
   UnPrepare;
   inherited;
   inherited;
+  If Assigned(FStatement) then
+    FStatement.Transaction:=TSQLTransaction(Value);
   If (Transaction<>Nil) and (Database=Nil) then
   If (Transaction<>Nil) and (Database=Nil) then
     Database:=TSQLTransaction(Transaction).Database;
     Database:=TSQLTransaction(Transaction).Database;
 end;
 end;
@@ -1342,19 +1399,27 @@ begin
     if assigned(value) and not (Value is TSQLConnection) then
     if assigned(value) and not (Value is TSQLConnection) then
       DatabaseErrorFmt(SErrNotASQLConnection,[value.Name],self);
       DatabaseErrorFmt(SErrNotASQLConnection,[value.Name],self);
     UnPrepare;
     UnPrepare;
-    if assigned(FCursor) then TSQLConnection(DataBase).DeAllocateCursorHandle(FCursor);
     db := TSQLConnection(Value);
     db := TSQLConnection(Value);
+    If Assigned(FStatement) then
+      FStatement.Database:=DB;
     inherited setdatabase(value);
     inherited setdatabase(value);
+(*
+     FStatement.Database:=Db,
+    if assigned(FCursor) then TSQLConnection(DataBase).DeAllocateCursorHandle(FCursor);
+*)
     if assigned(value) and (Transaction = nil) and (Assigned(db.Transaction)) then
     if assigned(value) and (Transaction = nil) and (Assigned(db.Transaction)) then
       transaction := Db.Transaction;
       transaction := Db.Transaction;
-    OnChangeSQL(Self);
+//    FStatement.OnChangeSQL(Self);
     end;
     end;
 end;
 end;
 
 
 function TCustomSQLQuery.IsPrepared: Boolean;
 function TCustomSQLQuery.IsPrepared: Boolean;
 
 
 begin
 begin
-  Result := Assigned(FCursor) and FCursor.FPrepared;
+  if Assigned(Fstatement) then
+    Result := FStatement.Prepared
+  else
+    Result := False;
 end;
 end;
 
 
 function TCustomSQLQuery.AddFilter(SQLstr: string): string;
 function TCustomSQLQuery.AddFilter(SQLstr: string): string;
@@ -1381,17 +1446,11 @@ var S : String;
 
 
 begin
 begin
   FreeFldBuffers;
   FreeFldBuffers;
-  TSQLConnection(Database).UnPrepareStatement(FCursor);
+  FStatement.Unprepare;
   FIsEOF := False;
   FIsEOF := False;
-  inherited internalclose;
-
-  s := FSQLBuf;
-
-  if ServerFiltered then s := AddFilter(s);
-
-  TSQLConnection(Database).PrepareStatement(FCursor,(Transaction as TSQLTransaction),S,FParams);
-
-  Execute;
+  inherited InternalClose;
+  FStatement.DoPrepare;
+  FStatement.DoExecute;
   inherited InternalOpen;
   inherited InternalOpen;
   First;
   First;
 end;
 end;
@@ -1409,11 +1468,13 @@ end;
 procedure TCustomSQLQuery.SetServerFiltered(Value: Boolean);
 procedure TCustomSQLQuery.SetServerFiltered(Value: Boolean);
 
 
 begin
 begin
-  if Value and not FParseSQL then DatabaseErrorFmt(SNoParseSQL,['Filtering ']);
+  if Value and not ParseSQL then
+    DatabaseErrorFmt(SNoParseSQL,['Filtering ']);
   if (ServerFiltered <> Value) then
   if (ServerFiltered <> Value) then
     begin
     begin
     FServerFiltered := Value;
     FServerFiltered := Value;
-    if active then ApplyFilter;
+    if active then
+      ApplyFilter;
     end;
     end;
 end;
 end;
 
 
@@ -1427,72 +1488,41 @@ begin
 end;
 end;
 
 
 procedure TCustomSQLQuery.Prepare;
 procedure TCustomSQLQuery.Prepare;
-var
-  db     : tsqlconnection;
-  sqltr  : tsqltransaction;
-  StmType: TStatementType;
 
 
 begin
 begin
-  if not IsPrepared then
-    begin
-    db := TSQLConnection(Database);
-    sqltr := (transaction as tsqltransaction);
-    if not assigned(Db) then
-      DatabaseError(SErrDatabasenAssigned);
-    if not assigned(sqltr) then
-      DatabaseError(SErrTransactionnSet);
-
-    if not Db.Connected then db.Open;
-    if not sqltr.Active then sqltr.StartTransaction;
-
-    if FSchemaType=stNoSchema then
-      FSQLBuf := TrimRight(FSQL.Text)
-    else
-      FSQLBuf := db.GetSchemaInfoSQL(FSchemaType, FSchemaObjectName, FSchemaPattern);
-
-    if FSQLBuf = '' then
-      DatabaseError(SErrNoStatement);
-
-    StmType:=SQLParser(FSQLBuf);
-
-    // There may no error occur between the allocation of the cursor and
-    // the preparation of the cursor. Because internalclose (which is called in
-    // case of an exception) assumes that allocated cursors are also prepared,
-    // and thus calls unprepare.
-    // A call to unprepare while the cursor is not prepared at all can lead to
-    // unpredictable results.
-    if not assigned(FCursor) then
-      FCursor := Db.AllocateCursorHandle;
-    FCursor.FSelectable:=True; // let PrepareStatement and/or Execute alter it
-    FCursor.FStatementType:=StmType;
-    FCursor.FSchemaType := FSchemaType;
-    if ServerFiltered then
-      begin
-      If LogEvent(detPrepare) then
-        Log(detPrepare,AddFilter(FSQLBuf));
-      Db.PrepareStatement(FCursor,sqltr,AddFilter(FSQLBuf),FParams)
-      end
-    else
-      begin
-      If LogEvent(detPrepare) then
-        Log(detPrepare,FSQLBuf);
-      Db.PrepareStatement(FCursor,sqltr,FSQLBuf,FParams);
-      end;
-    FCursor.FInitFieldDef := FCursor.FSelectable;
-    end;
+  FStatement.Prepare;
+  If Assigned(Fstatement.FCursor) then
+    With FStatement.FCursor do
+      FInitFieldDef:=FSelectable;
 end;
 end;
 
 
 procedure TCustomSQLQuery.UnPrepare;
 procedure TCustomSQLQuery.UnPrepare;
 
 
 begin
 begin
   CheckInactive;
   CheckInactive;
-  if IsPrepared then with TSQLConnection(DataBase) do
-    UnPrepareStatement(FCursor);
+  If Assigned(FStatement) then
+    FStatement.Unprepare;
 end;
 end;
 
 
 procedure TCustomSQLQuery.FreeFldBuffers;
 procedure TCustomSQLQuery.FreeFldBuffers;
 begin
 begin
-  if assigned(FCursor) then TSQLConnection(Database).FreeFldBuffers(FCursor);
+  if assigned(Cursor) then
+     TSQLConnection(Database).FreeFldBuffers(Cursor);
+end;
+
+function TCustomSQLQuery.GetCheckParams: Boolean;
+begin
+  Result:=FStatement.CheckParams;
+end;
+
+function TCustomSQLQuery.GetParams: TParams;
+begin
+  Result:=FStatement.Params;
+end;
+
+function TCustomSQLQuery.GetParseSQL: Boolean;
+begin
+  Result:=FStatement.ParseSQL;
 end;
 end;
 
 
 function TCustomSQLQuery.GetServerIndexDefs: TServerIndexDefs;
 function TCustomSQLQuery.GetServerIndexDefs: TServerIndexDefs;
@@ -1500,36 +1530,40 @@ begin
   Result := FServerIndexDefs;
   Result := FServerIndexDefs;
 end;
 end;
 
 
+function TCustomSQLQuery.GetSQL: TStringlist;
+begin
+  Result:=TStringList(Fstatement.SQL);
+end;
+
 function TCustomSQLQuery.Fetch : boolean;
 function TCustomSQLQuery.Fetch : boolean;
 begin
 begin
-  if not FCursor.FSelectable then
+  if Not Assigned(Cursor) then
     Exit;
     Exit;
-
-  if not FIsEof then FIsEOF := not TSQLConnection(Database).Fetch(FCursor);
+  if not Cursor.FSelectable then
+    Exit;
+  if not FIsEof then FIsEOF := not TSQLConnection(Database).Fetch(Cursor);
   Result := not FIsEOF;
   Result := not FIsEOF;
 end;
 end;
 
 
+function TCustomSQLQuery.Cursor: TSQLCursor;
+begin
+  Result:=FStatement.Cursor;
+end;
+
 procedure TCustomSQLQuery.Execute;
 procedure TCustomSQLQuery.Execute;
 begin
 begin
-  If (FParams.Count>0) and Assigned(FMasterLink) then
-    FMasterLink.CopyParamsFromMaster(False);
-  If LogEvent(detExecute) then
-    Log(detExecute,FSQLBuf);
-  TSQLConnection(Database).Execute(FCursor,Transaction as TSQLTransaction, FParams);
+  FStatement.Execute;
 end;
 end;
 
 
 function TCustomSQLQuery.LoadField(FieldDef : TFieldDef;buffer : pointer; out CreateBlob : boolean) : boolean;
 function TCustomSQLQuery.LoadField(FieldDef : TFieldDef;buffer : pointer; out CreateBlob : boolean) : boolean;
 
 
 begin
 begin
-  result := TSQLConnection(Database).LoadField(FCursor,FieldDef,buffer, Createblob)
+  result := TSQLConnection(Database).LoadField(Cursor,FieldDef,buffer, Createblob)
 end;
 end;
 
 
 function TCustomSQLQuery.RowsAffected: TRowsCount;
 function TCustomSQLQuery.RowsAffected: TRowsCount;
 begin
 begin
-  Result := -1;
-  if not Assigned(Database) then Exit;
-  //assert(Database is TSQLConnection);
-  Result := TSQLConnection(Database).RowsAffected(FCursor);
+  Result:=Fstatement.RowsAffected;
 end;
 end;
 
 
 procedure TCustomSQLQuery.InternalAddRecord(Buffer: Pointer; AAppend: Boolean);
 procedure TCustomSQLQuery.InternalAddRecord(Buffer: Pointer; AAppend: Boolean);
@@ -1541,9 +1575,16 @@ procedure TCustomSQLQuery.InternalClose;
 begin
 begin
   if not IsReadFromPacket then
   if not IsReadFromPacket then
     begin
     begin
-    if assigned(FCursor) and FCursor.FSelectable then FreeFldBuffers;
-    // Database and FCursor could be nil, for example if the database is not assigned, and .open is called
-    if (not IsPrepared) and (assigned(database)) and (assigned(FCursor)) then TSQLConnection(database).UnPrepareStatement(FCursor);
+    if assigned(Cursor) and Cursor.FSelectable then
+      FreeFldBuffers;
+    // Some SQLConnections does not support statement [un]preparation,
+    //  so let them do cleanup f.e. cancel pending queries and/or free resultset
+    if not Prepared then FStatement.DoUnprepare;
+    end
+  else
+    begin
+    if assigned(Cursor) then
+      FStatement.DeAllocateCursor;
     end;
     end;
   if DefaultFields then
   if DefaultFields then
     DestroyFields;
     DestroyFields;
@@ -1552,7 +1593,7 @@ begin
   if assigned(FInsertQry) then FreeAndNil(FInsertQry);
   if assigned(FInsertQry) then FreeAndNil(FInsertQry);
   if assigned(FDeleteQry) then FreeAndNil(FDeleteQry);
   if assigned(FDeleteQry) then FreeAndNil(FDeleteQry);
 //  FRecordSize := 0;
 //  FRecordSize := 0;
-  inherited internalclose;
+  inherited InternalClose;
 end;
 end;
 
 
 procedure TCustomSQLQuery.InternalInitFieldDefs;
 procedure TCustomSQLQuery.InternalInitFieldDefs;
@@ -1565,28 +1606,30 @@ begin
   try
   try
     FieldDefs.Clear;
     FieldDefs.Clear;
     if not Assigned(Database) then DatabaseError(SErrDatabasenAssigned);
     if not Assigned(Database) then DatabaseError(SErrDatabasenAssigned);
-    TSQLConnection(Database).AddFieldDefs(FCursor,FieldDefs);
+    TSQLConnection(Database).AddFieldDefs(Cursor,FieldDefs);
   finally
   finally
     FLoadingFieldDefs := False;
     FLoadingFieldDefs := False;
-    if Assigned(FCursor) then FCursor.FInitFieldDef := false;
+    if Assigned(Cursor) then Cursor.FInitFieldDef := false;
   end;
   end;
 end;
 end;
 
 
 
 
 
 
+(*
 function TCustomSQLQuery.SQLParser(const ASQL : string) : TStatementType;
 function TCustomSQLQuery.SQLParser(const ASQL : string) : TStatementType;
 
 
 Var
 Var
   I : TSQLStatementInfo;
   I : TSQLStatementInfo;
 
 
 begin
 begin
-  I:=(Database as TSQLConnection).GetStatementInfo(ASQL,ParseSQL,FSchemaType);
+  I:=(Database as TSQLConnection).GetStatementInfo(ASQL,ParseSQL,SchemaType);
   FTableName:=I.TableName;
   FTableName:=I.TableName;
   FUpdateable:=I.Updateable;
   FUpdateable:=I.Updateable;
   FWhereStartPos:=I.WhereStartPos;
   FWhereStartPos:=I.WhereStartPos;
   FWhereStopPos:=I.WhereStopPos;
   FWhereStopPos:=I.WhereStopPos;
   Result:=I.StatementType;
   Result:=I.StatementType;
 end;
 end;
+*)
 
 
 Function TSQLConnection.GetStatementInfo(const ASQL : string; Full : Boolean; ASchema : TSchemaType) : TSQLStatementInfo;
 Function TSQLConnection.GetStatementInfo(const ASQL : string; Full : Boolean; ASchema : TSchemaType) : TSQLStatementInfo;
 
 
@@ -1772,16 +1815,15 @@ begin
   ReadFromFile:=IsReadFromPacket;
   ReadFromFile:=IsReadFromPacket;
   if ReadFromFile then
   if ReadFromFile then
     begin
     begin
-    if not assigned(FCursor) then
-      FCursor := TSQLConnection(Database).AllocateCursorHandle;
-    FCursor.FSelectable:=True;
-    FCursor.FStatementType:=stSelect;
+    FStatement.AllocateCursor;
+    Cursor.FSelectable:=True;
+    Cursor.FStatementType:=stSelect;
     FUpdateable:=True;
     FUpdateable:=True;
     end
     end
   else
   else
     Prepare;
     Prepare;
 
 
-  if not FCursor.FSelectable then
+  if not Cursor.FSelectable then
     DatabaseError(SErrNoSelectStatement,Self);
     DatabaseError(SErrNoSelectStatement,Self);
 
 
   if not ReadFromFile then
   if not ReadFromFile then
@@ -1793,12 +1835,12 @@ begin
       UpdateServerIndexDefs;
       UpdateServerIndexDefs;
 
 
     Execute;
     Execute;
-    if not FCursor.FSelectable then
+    if not Cursor.FSelectable then
       DatabaseError(SErrNoSelectStatement,Self);
       DatabaseError(SErrNoSelectStatement,Self);
 
 
     // InternalInitFieldDef is only called after a prepare. i.e. not twice if
     // InternalInitFieldDef is only called after a prepare. i.e. not twice if
     // a dataset is opened - closed - opened.
     // a dataset is opened - closed - opened.
-    if FCursor.FInitFieldDef then InternalInitFieldDefs;
+    if Cursor.FInitFieldDef then InternalInitFieldDefs;
     if DefaultFields then
     if DefaultFields then
       begin
       begin
       CreateFields;
       CreateFields;
@@ -1848,18 +1890,122 @@ begin
     Prepare;
     Prepare;
     Execute;
     Execute;
   finally
   finally
-    // FCursor has to be assigned, or else the prepare went wrong before PrepareStatment was
-    // called, so UnPrepareStatement shoudn't be called either
-    if (not IsPrepared) and (assigned(database)) and (assigned(FCursor)) then TSQLConnection(database).UnPrepareStatement(FCursor);
+    // Cursor has to be assigned, or else the prepare went wrong before PrepareStatment was
+    //   called, so UnPrepareStatement shoudn't be called either
+    // Don't deallocate cursor; f.e. RowsAffected is requested later
+    if not Prepared and (assigned(Database)) and (assigned(Cursor)) then TSQLConnection(Database).UnPrepareStatement(Cursor);
   end;
   end;
 end;
 end;
 
 
+Type
+
+  { TQuerySQLStatement }
+
+  TQuerySQLStatement = Class(TCustomSQLStatement)
+  protected
+    FMasterLink: TMasterParamsDataLink;
+    FQuery : TCustomSQLQuery;
+    function GetDataSource: TDatasource; override;
+    procedure SetDataSource(AValue: TDatasource); override;
+    Function GetSchemaType : TSchemaType; override;
+    Function GetSchemaObjectName : String; override;
+    Function GetSchemaPattern: String; override;
+    procedure GetStatementInfo(Var ASQL: String; Full: Boolean; ASchema: TSchemaType; out Info: TSQLStatementInfo); override;
+    procedure OnChangeSQL(Sender : TObject); override;
+  Public
+    destructor Destroy; override;
+  end;
+
+{ TQuerySQLStatement }
+
+function TQuerySQLStatement.GetDataSource: TDatasource;
+begin
+  Result:=inherited GetDataSource;
+
+end;
+
+procedure TQuerySQLStatement.SetDataSource(AValue: TDatasource);
+begin
+  inherited SetDataSource(AValue);
+  If Assigned(AValue) then
+    begin
+    AValue.FreeNotification(Self);
+    If (FMasterLink=Nil) then
+      FMasterLink:=TMasterParamsDataLink.Create(FQuery);
+    FMasterLink.Datasource:=AValue;
+    end
+  else
+    FreeAndNil(FMasterLink);
+end;
+
+function TQuerySQLStatement.GetSchemaType: TSchemaType;
+begin
+  if Assigned(FQuery) then
+    Result:=FQuery.FSchemaType
+  else
+    Result:=stNoSchema;
+end;
+
+function TQuerySQLStatement.GetSchemaObjectName: String;
+begin
+  if Assigned(FQuery) then
+    Result:=FQuery.FSchemaObjectname
+  else
+    Result:=inherited GetSchemaObjectName;
+end;
+
+function TQuerySQLStatement.GetSchemaPattern: String;
+begin
+  if Assigned(FQuery) then
+    Result:=FQuery.FSchemaPattern
+  else
+    Result:=inherited GetSchemaPattern;
+end;
+
+procedure TQuerySQLStatement.GetStatementInfo(var ASQL: String; Full: Boolean;
+  ASchema: TSchemaType; out Info: TSQLStatementInfo);
+begin
+  inherited GetStatementInfo(ASQL, Full, ASchema, Info);
+  If Assigned(FQuery) then
+    begin
+    FQuery.FWhereStartPos:=Info.WhereStartPos;
+    FQuery.FWhereStopPos:=Info.WhereStopPos;
+    FQuery.FUpdateable:=info.Updateable;
+    FQuery.FTableName:=Info.TableName;
+    if FQuery.ServerFiltered then
+      ASQL:=FQuery.AddFilter(ASQL);
+    end;
+end;
+
+procedure TQuerySQLStatement.OnChangeSQL(Sender: TObject);
+begin
+  UnPrepare;
+  inherited OnChangeSQL(Sender);
+  If CheckParams and Assigned(FMasterLink) then
+    FMasterLink.RefreshParamNames;
+  FQuery.ServerIndexDefs.Updated:=false;
+end;
+
+destructor TQuerySQLStatement.Destroy;
+begin
+  FreeAndNil(FMasterLink);
+  inherited Destroy;
+end;
+
 constructor TCustomSQLQuery.Create(AOwner : TComponent);
 constructor TCustomSQLQuery.Create(AOwner : TComponent);
+
+Var
+  F : TQuerySQLStatement;
+
 begin
 begin
   inherited Create(AOwner);
   inherited Create(AOwner);
   FParams := TParams.create(self);
   FParams := TParams.create(self);
-  FSQL := TStringList.Create;
-  FSQL.OnChange := @OnChangeSQL;
+  F:=TQuerySQLStatement.Create(Self);
+  F.FQuery:=Self;
+  FStatement:=F;
+
+  //FSQL := TStringList.Create;
+  // FSQL.OnChange := @OnChangeSQL;
 
 
   FUpdateSQL := TStringList.Create;
   FUpdateSQL := TStringList.Create;
   FUpdateSQL.OnChange := @OnChangeModifySQL;
   FUpdateSQL.OnChange := @OnChangeModifySQL;
@@ -1870,8 +2016,6 @@ begin
 
 
   FServerIndexDefs := TServerIndexDefs.Create(Self);
   FServerIndexDefs := TServerIndexDefs.Create(Self);
 
 
-  FParseSQL := True;
-  CheckParams:=True;
   FServerFiltered := False;
   FServerFiltered := False;
   FServerFilterText := '';
   FServerFilterText := '';
 
 
@@ -1889,10 +2033,9 @@ destructor TCustomSQLQuery.Destroy;
 begin
 begin
   if Active then Close;
   if Active then Close;
   UnPrepare;
   UnPrepare;
-  if assigned(FCursor) then TSQLConnection(Database).DeAllocateCursorHandle(FCursor);
-  FreeAndNil(FMasterLink);
+  FreeAndNil(Fstatement);
   FreeAndNil(FParams);
   FreeAndNil(FParams);
-  FreeAndNil(FSQL);
+//  FreeAndNil(FSQL);
   FreeAndNil(FInsertSQL);
   FreeAndNil(FInsertSQL);
   FreeAndNil(FDeleteSQL);
   FreeAndNil(FDeleteSQL);
   FreeAndNil(FUpdateSQL);
   FreeAndNil(FUpdateSQL);
@@ -1911,18 +2054,14 @@ procedure TCustomSQLQuery.SetParseSQL(AValue : Boolean);
 
 
 begin
 begin
   CheckInactive;
   CheckInactive;
+  FStatement.ParseSQL:=AValue;
   if not AValue then
   if not AValue then
-    begin
     FServerFiltered := False;
     FServerFiltered := False;
-    FParseSQL := False;
-    end
-  else
-    FParseSQL := True;
 end;
 end;
 
 
 procedure TCustomSQLQuery.SetSQL(const AValue: TStringlist);
 procedure TCustomSQLQuery.SetSQL(const AValue: TStringlist);
 begin
 begin
-  FSQL.Assign(AValue);
+  FStatement.SQL.Assign(AValue);
 end;
 end;
 
 
 procedure TCustomSQLQuery.SetUpdateSQL(const AValue: TStringlist);
 procedure TCustomSQLQuery.SetUpdateSQL(const AValue: TStringlist);
@@ -2092,8 +2231,8 @@ end;
 function TCustomSQLQuery.GetCanModify: Boolean;
 function TCustomSQLQuery.GetCanModify: Boolean;
 
 
 begin
 begin
-  // the test for assigned(FCursor) is needed for the case that the dataset isn't opened
-  if assigned(FCursor) and (FCursor.FStatementType = stSelect) then
+  // the test for assigned(Cursor) is needed for the case that the dataset isn't opened
+  if assigned(Cursor) and (Cursor.FStatementType = stSelect) then
     Result:= FUpdateable and (not ReadOnly) and (not IsUniDirectional)
     Result:= FUpdateable and (not ReadOnly) and (not IsUniDirectional)
   else
   else
     Result := False;
     Result := False;
@@ -2116,7 +2255,7 @@ end;
 procedure TCustomSQLQuery.LoadBlobIntoBuffer(FieldDef: TFieldDef;
 procedure TCustomSQLQuery.LoadBlobIntoBuffer(FieldDef: TFieldDef;
   ABlobBuf: PBufBlobField);
   ABlobBuf: PBufBlobField);
 begin
 begin
-  TSQLConnection(DataBase).LoadBlobIntoBuffer(FieldDef, ABlobBuf, FCursor,(Transaction as TSQLTransaction));
+  TSQLConnection(DataBase).LoadBlobIntoBuffer(FieldDef, ABlobBuf, Cursor,(Transaction as TSQLTransaction));
 end;
 end;
 
 
 procedure TCustomSQLQuery.BeforeRefreshOpenCursor;
 procedure TCustomSQLQuery.BeforeRefreshOpenCursor;
@@ -2126,7 +2265,7 @@ begin
   // problems because in SetActive(false) queries are always
   // problems because in SetActive(false) queries are always
   // unprepared. (which is also wrong, but has to be fixed later)
   // unprepared. (which is also wrong, but has to be fixed later)
   if IsPrepared then with TSQLConnection(DataBase) do
   if IsPrepared then with TSQLConnection(DataBase) do
-    UnPrepareStatement(FCursor);
+    UnPrepareStatement(Cursor);
 end;
 end;
 
 
 function TCustomSQLQuery.LogEvent(EventType: TDBEventType): Boolean;
 function TCustomSQLQuery.LogEvent(EventType: TDBEventType): Boolean;
@@ -2152,10 +2291,15 @@ end;
 function TCustomSQLQuery.GetStatementType : TStatementType;
 function TCustomSQLQuery.GetStatementType : TStatementType;
 
 
 begin
 begin
-  if assigned(FCursor) then
-    Result := FCursor.FStatementType
+  if Assigned(Cursor) then
+    Result:=Cursor.FStatementType
   else
   else
-    Result := stUnknown;
+    Result:=stUnknown;
+end;
+
+procedure TCustomSQLQuery.SetCheckParams(AValue: Boolean);
+begin
+  FStatement.CheckParams:=Avalue;
 end;
 end;
 
 
 procedure TCustomSQLQuery.SetDeleteSQL(const AValue: TStringlist);
 procedure TCustomSQLQuery.SetDeleteSQL(const AValue: TStringlist);
@@ -2168,6 +2312,11 @@ begin
   FInsertSQL.Assign(AValue);
   FInsertSQL.Assign(AValue);
 end;
 end;
 
 
+procedure TCustomSQLQuery.SetParams(AValue: TParams);
+begin
+  FStatement.Params.Assign(AValue);
+end;
+
 procedure TCustomSQLQuery.SetDataSource(AValue: TDatasource);
 procedure TCustomSQLQuery.SetDataSource(AValue: TDatasource);
 
 
 Var
 Var
@@ -2181,23 +2330,15 @@ begin
       DatabaseError(SErrCircularDataSourceReferenceNotAllowed,Self);
       DatabaseError(SErrCircularDataSourceReferenceNotAllowed,Self);
     If Assigned(DS) then
     If Assigned(DS) then
       DS.RemoveFreeNotification(Self);
       DS.RemoveFreeNotification(Self);
-    If Assigned(AValue) then
-      begin
-      AValue.FreeNotification(Self);
-      If (FMasterLink=Nil) then
-        FMasterLink:=TMasterParamsDataLink.Create(Self);
-      FMasterLink.Datasource:=AValue;
-      end
-    else
-      FreeAndNil(FMasterLink);
+    FStatement.Datasource:=AValue;
     end;
     end;
 end;
 end;
 
 
 function TCustomSQLQuery.GetDataSource: TDatasource;
 function TCustomSQLQuery.GetDataSource: TDatasource;
 
 
 begin
 begin
-  If Assigned(FMasterLink) then
-    Result:=FMasterLink.DataSource
+  If Assigned(FStatement) then
+    Result:=FStatement.Datasource
   else
   else
     Result:=Nil;
     Result:=Nil;
 end;
 end;

+ 1 - 0
packages/fcl-db/tests/dbtestframework.pas

@@ -24,6 +24,7 @@ uses
   TestDatasources,
   TestDatasources,
   TestDBBasics,
   TestDBBasics,
   TestBufDatasetStreams,
   TestBufDatasetStreams,
+  TestSQLDB,
   TestSpecificTBufDataset,
   TestSpecificTBufDataset,
   TestSpecificTDBF,
   TestSpecificTDBF,
   TestDBExport,
   TestDBExport,

+ 2 - 1
packages/fcl-db/tests/dbtestframework_gui.lpi

@@ -59,6 +59,7 @@
     <RunParams>
     <RunParams>
       <local>
       <local>
         <FormatVersion Value="1"/>
         <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
       </local>
       </local>
     </RunParams>
     </RunParams>
     <RequiredPackages Count="4">
     <RequiredPackages Count="4">
@@ -87,7 +88,7 @@
     <Version Value="11"/>
     <Version Value="11"/>
     <SearchPaths>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
       <IncludeFiles Value="$(ProjOutDir)"/>
-      <OtherUnitFiles Value="../src/base;../src/sqldb/odbc;../src/sqldb/mssql;../src/sqldb/sqlite;../src/sqldb/postgres;../src/sqldb/oracle;../src/memds;../src/sqldb;../src/sqldb/interbase;../src/sqldb/mysql;../src/dbase;../src/sdf"/>
+      <OtherUnitFiles Value="../src/base;../src/sqldb/odbc;../src/sqldb/mssql;../src/sqldb/sqlite;../src/sqldb/postgres;../src/sqldb/oracle;../src/memds;../src/sqldb;../src/sqldb/interbase;../src/sqldb/mysql;../src/dbase;../src/sdf;../src/export"/>
     </SearchPaths>
     </SearchPaths>
     <Linking>
     <Linking>
       <Debugging>
       <Debugging>

+ 1 - 0
packages/fcl-db/tests/dbtestframework_gui.lpr

@@ -30,6 +30,7 @@ uses
   TestDBBasics,
   TestDBBasics,
   TestDatasources,
   TestDatasources,
   TestBufDatasetStreams,
   TestBufDatasetStreams,
+  TestSQLDB,
   TestSpecificTBufDataset,
   TestSpecificTBufDataset,
   TestSpecificTDBF,
   TestSpecificTDBF,
   TestDBExport;
   TestDBExport;

+ 19 - 0
packages/fcl-db/tests/reruntest.sh

@@ -0,0 +1,19 @@
+#!/bin/bash
+cd ..
+make clean all OPT=-gl
+if [ $? != 0 ]; then
+  exit
+fi
+cd tests
+fpc dbtestframework.pas -glh -Fu../units/x86_64-linux/
+if [ $? != 0 ]; then
+  exit
+fi
+if [ "$1" != "" ]; then
+  ./dbtestframework --suite=$1
+else
+  ./dbtestframework
+fi  
+#
+#
+  

+ 57 - 49
packages/fcl-db/tests/sqldbtoolsunit.pas

@@ -28,54 +28,13 @@ type
   TSQLConnType = (mysql40,mysql41,mysql50,mysql51,mysql55,postgresql,interbase,odbc,oracle,sqlite3,mssql,sybase);
   TSQLConnType = (mysql40,mysql41,mysql50,mysql51,mysql55,postgresql,interbase,odbc,oracle,sqlite3,mssql,sybase);
   TSQLServerType = (ssFirebird, ssInterbase, ssMSSQL, ssMySQL, ssOracle, ssPostgreSQL, ssSQLite, ssSybase, ssUnknown);
   TSQLServerType = (ssFirebird, ssInterbase, ssMSSQL, ssMySQL, ssOracle, ssPostgreSQL, ssSQLite, ssSybase, ssUnknown);
 
 
-const MySQLConnTypes = [mysql40,mysql41,mysql50,mysql51,mysql55];
-      SQLConnTypesNames : Array [TSQLConnType] of String[19] =
+const
+  MySQLConnTypes = [mysql40,mysql41,mysql50,mysql51,mysql55];
+  SQLConnTypesNames : Array [TSQLConnType] of String[19] =
         ('MYSQL40','MYSQL41','MYSQL50','MYSQL51','MYSQL55','POSTGRESQL','INTERBASE','ODBC','ORACLE','SQLITE3','MSSQL','SYBASE');
         ('MYSQL40','MYSQL41','MYSQL50','MYSQL51','MYSQL55','POSTGRESQL','INTERBASE','ODBC','ORACLE','SQLITE3','MSSQL','SYBASE');
              
              
-      FieldtypeDefinitionsConst : Array [TFieldType] of String[20] =
-        (
-          '',
-          'VARCHAR(10)',
-          'SMALLINT',
-          'INTEGER',
-          '',             // ftWord
-          'BOOLEAN',
-          'DOUBLE PRECISION', // ftFloat
-          '',             // ftCurrency
-          'DECIMAL(18,4)',// ftBCD
-          'DATE',
-          'TIME',
-          'TIMESTAMP',    // ftDateTime
-          '',             // ftBytes
-          '',             // ftVarBytes
-          '',             // ftAutoInc
-          'BLOB',         // ftBlob
-          'BLOB',         // ftMemo
-          'BLOB',         // ftGraphic
-          '',
-          '',
-          '',
-          '',
-          '',
-          'CHAR(10)',     // ftFixedChar
-          '',             // ftWideString
-          'BIGINT',       // ftLargeInt
-          '',
-          '',
-          '',
-          '',
-          '',
-          '',
-          '',
-          '',
-          '',
-          '',             // ftGuid
-          'TIMESTAMP',    // ftTimestamp
-          'NUMERIC(18,6)',// ftFmtBCD
-          '',             // ftFixedWideChar
-          ''              // ftWideMemo
-        );
-             
+  STestNotApplicable = 'This test does not apply to this sqldb-connection type';
+
 
 
 type
 type
 { TSQLDBConnector }
 { TSQLDBConnector }
@@ -101,6 +60,7 @@ type
   public
   public
     destructor Destroy; override;
     destructor Destroy; override;
     constructor Create; override;
     constructor Create; override;
+    procedure ExecuteDirect(const SQL: string);
     procedure CommitDDL;
     procedure CommitDDL;
     property Connection : TSQLConnection read FConnection;
     property Connection : TSQLConnection read FConnection;
     property Transaction : TSQLTransaction read FTransaction;
     property Transaction : TSQLTransaction read FTransaction;
@@ -122,6 +82,50 @@ type
   end;
   end;
 
 
 const
 const
+  FieldtypeDefinitionsConst : Array [TFieldType] of String[20] =
+    (
+      '',
+      'VARCHAR(10)',
+      'SMALLINT',
+      'INTEGER',
+      '',             // ftWord
+      'BOOLEAN',
+      'DOUBLE PRECISION', // ftFloat
+      '',             // ftCurrency
+      'DECIMAL(18,4)',// ftBCD
+      'DATE',
+      'TIME',
+      'TIMESTAMP',    // ftDateTime
+      '',             // ftBytes
+      '',             // ftVarBytes
+      '',             // ftAutoInc
+      'BLOB',         // ftBlob
+      'BLOB',         // ftMemo
+      'BLOB',         // ftGraphic
+      '',
+      '',
+      '',
+      '',
+      '',
+      'CHAR(10)',     // ftFixedChar
+      '',             // ftWideString
+      'BIGINT',       // ftLargeInt
+      '',
+      '',
+      '',
+      '',
+      '',
+      '',
+      '',
+      '',
+      '',
+      '',             // ftGuid
+      'TIMESTAMP',    // ftTimestamp
+      'NUMERIC(18,6)',// ftFmtBCD
+      '',             // ftFixedWideChar
+      ''              // ftWideMemo
+    );
+
   // names as returned by ODBC SQLGetInfo(..., SQL_DBMS_NAME, ...) and GetConnectionInfo(citServerType)
   // names as returned by ODBC SQLGetInfo(..., SQL_DBMS_NAME, ...) and GetConnectionInfo(citServerType)
   SQLServerTypesMap : array [0..7] of TSQLServerTypesMapItem = (
   SQLServerTypesMap : array [0..7] of TSQLServerTypesMapItem = (
     (s: 'Firebird'; t: ssFirebird),
     (s: 'Firebird'; t: ssFirebird),
@@ -244,7 +248,7 @@ begin
       end;
       end;
     ssPostgreSQL:
     ssPostgreSQL:
       begin
       begin
-      FieldtypeDefinitions[ftCurrency] := 'MONEY';
+      FieldtypeDefinitions[ftCurrency] := 'MONEY'; // ODBC?!
       FieldtypeDefinitions[ftBlob] := 'BYTEA';
       FieldtypeDefinitions[ftBlob] := 'BYTEA';
       FieldtypeDefinitions[ftMemo] := 'TEXT';
       FieldtypeDefinitions[ftMemo] := 'TEXT';
       FieldtypeDefinitions[ftGraphic] := '';
       FieldtypeDefinitions[ftGraphic] := '';
@@ -325,7 +329,7 @@ begin
     database := Fconnection;
     database := Fconnection;
 end;
 end;
 
 
-Function TSQLDBConnector.CreateQuery : TSQLQuery;
+function TSQLDBConnector.CreateQuery: TSQLQuery;
 
 
 begin
 begin
   Result := TSQLQuery.create(nil);
   Result := TSQLQuery.create(nil);
@@ -517,6 +521,11 @@ begin
   end;
   end;
 end;
 end;
 
 
+procedure TSQLDBConnector.ExecuteDirect(const SQL: string);
+begin
+  Connection.ExecuteDirect(SQL);
+end;
+
 procedure TSQLDBConnector.CommitDDL;
 procedure TSQLDBConnector.CommitDDL;
 begin
 begin
   // Commits schema definition and manipulation statements;
   // Commits schema definition and manipulation statements;
@@ -539,7 +548,6 @@ begin
     end; // try
     end; // try
     end;
     end;
   inherited Destroy;
   inherited Destroy;
-
   FreeAndNil(FQuery);
   FreeAndNil(FQuery);
   FreeAndNil(FTransaction);
   FreeAndNil(FTransaction);
   FreeAndNil(FConnection);
   FreeAndNil(FConnection);

+ 261 - 0
packages/fcl-db/tests/test-list.txt

@@ -0,0 +1,261 @@
+TTestBasics.TestParseSQL
+TTestBasics.TestInitFielddefsFromFields
+TTestBasics.TestDoubleFieldDef
+TTestBasics.TestFieldDefWithoutDS
+TTestBasics.TestGetParamList
+TTestBasics.TestGetFieldList
+TTestBasics.TestExtractFieldName
+TTestFieldTypes.TestEmptyUpdateQuery
+TTestFieldTypes.TestParseJoins
+TTestFieldTypes.TestDoubleFieldNames
+TTestFieldTypes.TestParseUnion
+TTestFieldTypes.TestInsertLargeStrFields
+TTestFieldTypes.TestNumericNames
+TTestFieldTypes.TestApplyUpdFieldnames
+TTestFieldTypes.TestServerFilter
+TTestFieldTypes.Test11Params
+TTestFieldTypes.TestRowsAffected
+TTestFieldTypes.TestLocateNull
+TTestFieldTypes.TestLocateOnMoreRecords
+TTestFieldTypes.TestStringsReplace
+TTestFieldTypes.TestCircularParams
+TTestFieldTypes.TestBug9744
+TTestFieldTypes.TestCrossStringDateParam
+TTestFieldTypes.TestGetFieldNames
+TTestFieldTypes.TestUpdateIndexDefs
+TTestFieldTypes.TestMultipleFieldPKIndexDefs
+TTestFieldTypes.TestGetIndexDefs
+TTestFieldTypes.TestSetBlobAsMemoParam
+TTestFieldTypes.TestSetBlobAsBlobParam
+TTestFieldTypes.TestSetBlobAsStringParam
+TTestFieldTypes.TestNonNullableParams
+TTestFieldTypes.TestDblQuoteEscComments
+TTestFieldTypes.TestpfInUpdateFlag
+TTestFieldTypes.TestScript
+TTestFieldTypes.TestInsertReturningQuery
+TTestFieldTypes.TestOpenStoredProc
+TTestFieldTypes.TestOpenSpecialStatements
+TTestFieldTypes.TestTemporaryTable
+TTestFieldTypes.TestRefresh
+TTestFieldTypes.TestParametersAndDates
+TTestFieldTypes.TestExceptOnsecClose
+TTestFieldTypes.TestErrorOnEmptyStatement
+TTestFieldTypes.TestBlob
+TTestFieldTypes.TestChangeBlob
+TTestFieldTypes.TestBlobGetText
+TTestFieldTypes.TestBlobSize
+TTestFieldTypes.TestLargeRecordSize
+TTestFieldTypes.TestInt
+TTestFieldTypes.TestNumeric
+TTestFieldTypes.TestFloat
+TTestFieldTypes.TestDate
+TTestFieldTypes.TestDateTime
+TTestFieldTypes.TestString
+TTestFieldTypes.TestUnlVarChar
+TTestFieldTypes.TestNullValues
+TTestFieldTypes.TestParamQuery
+TTestFieldTypes.TestStringParamQuery
+TTestFieldTypes.TestFixedStringParamQuery
+TTestFieldTypes.TestDateParamQuery
+TTestFieldTypes.TestSmallIntParamQuery
+TTestFieldTypes.TestIntParamQuery
+TTestFieldTypes.TestLargeIntParamQuery
+TTestFieldTypes.TestTimeParamQuery
+TTestFieldTypes.TestDateTimeParamQuery
+TTestFieldTypes.TestFmtBCDParamQuery
+TTestFieldTypes.TestFloatParamQuery
+TTestFieldTypes.TestBCDParamQuery
+TTestFieldTypes.TestBytesParamQuery
+TTestFieldTypes.TestVarBytesParamQuery
+TTestFieldTypes.TestBooleanParamQuery
+TTestFieldTypes.TestAggregates
+TTestFieldTypes.TestStringLargerThen8192
+TTestFieldTypes.TestQueryAfterReconnect
+TTestFieldTypes.TestTableNames
+TTestFieldTypes.TestFieldNames
+TTestFieldTypes.TestClearUpdateableStatus
+TTestFieldTypes.TestReadOnlyParseSQL
+TTestFieldTypes.TestGetTables
+TTestFieldTypes.TestSQLClob
+TTestFieldTypes.TestSQLLargeint
+TTestFieldTypes.TestSQLInterval
+TTestFieldTypes.TestSQLIdentity
+TTestFieldTypes.TestSQLReal
+TTestDBBasics.TestSetFieldValues
+TTestDBBasics.TestGetFieldValues
+TTestDBBasics.TestSupportIntegerFields
+TTestDBBasics.TestSupportSmallIntFields
+TTestDBBasics.TestSupportWordFields
+TTestDBBasics.TestSupportStringFields
+TTestDBBasics.TestSupportBooleanFields
+TTestDBBasics.TestSupportFloatFields
+TTestDBBasics.TestSupportLargeIntFields
+TTestDBBasics.TestSupportDateFields
+TTestDBBasics.TestSupportTimeFields
+TTestDBBasics.TestSupportCurrencyFields
+TTestDBBasics.TestSupportBCDFields
+TTestDBBasics.TestSupportfmtBCDFields
+TTestDBBasics.TestSupportFixedStringFields
+TTestDBBasics.TestSupportBlobFields
+TTestDBBasics.TestSupportMemoFields
+TTestDBBasics.TestDoubleClose
+TTestDBBasics.TestCalculatedField
+TTestDBBasics.TestAssignFieldftString
+TTestDBBasics.TestAssignFieldftFixedChar
+TTestDBBasics.TestSelectQueryBasics
+TTestDBBasics.TestPostOnlyInEditState
+TTestDBBasics.TestMove
+TTestDBBasics.TestActiveBufferWhenClosed
+TTestDBBasics.TestEOFBOFClosedDataset
+TTestDBBasics.TestLayoutChangedEvents
+TTestDBBasics.TestDataEventsResync
+TTestDBBasics.TestRecordcountAfterReopen
+TTestDBBasics.TestdeFieldListChange
+TTestDBBasics.TestExceptionLocateClosed
+TTestDBBasics.TestCanModifySpecialFields
+TTestDBBasics.TestDetectionNonMatchingDataset
+TTestCursorDBBasics.TestCancelUpdDelete1
+TTestCursorDBBasics.TestCancelUpdDelete2
+TTestCursorDBBasics.TestAppendInsertRecord
+TTestCursorDBBasics.TestBookmarks
+TTestCursorDBBasics.TestBookmarkValid
+TTestCursorDBBasics.TestDelete1
+TTestCursorDBBasics.TestDelete2
+TTestCursorDBBasics.TestLocate
+TTestCursorDBBasics.TestLocateCaseIns
+TTestCursorDBBasics.TestLocateCaseInsInts
+TTestCursorDBBasics.TestFirst
+TTestCursorDBBasics.TestIntFilter
+TTestCursorDBBasics.TestOnFilter
+TTestCursorDBBasics.TestStringFilter
+TTestCursorDBBasics.TestNullAtOpen
+TTestCursorDBBasics.TestAppendOnEmptyDataset
+TTestCursorDBBasics.TestInsertOnEmptyDataset
+TTestCursorDBBasics.TestEofAfterFirst
+TTestCursorDBBasics.TestLastAppendCancel
+TTestCursorDBBasics.TestRecNo
+TTestCursorDBBasics.TestSetRecNo
+TTestCursorDBBasics.TestBug7007
+TTestCursorDBBasics.TestBug6893
+TTestCursorDBBasics.TestRequired
+TTestCursorDBBasics.TestOldValueObsolete
+TTestCursorDBBasics.TestOldValue
+TTestCursorDBBasics.TestModified
+TTestBufDatasetDBBasics.TestClosedIndexFieldNames
+TTestBufDatasetDBBasics.TestFileNameProperty
+TTestBufDatasetDBBasics.TestClientDatasetAsMemDataset
+TTestBufDatasetDBBasics.TestSaveAsXML
+TTestBufDatasetDBBasics.TestIsEmpty
+TTestBufDatasetDBBasics.TestBufDatasetCancelUpd
+TTestBufDatasetDBBasics.TestBufDatasetCancelUpd1
+TTestBufDatasetDBBasics.TestMultipleDeleteUpdateBuffer
+TTestBufDatasetDBBasics.TestDoubleDelete
+TTestBufDatasetDBBasics.TestReadOnly
+TTestBufDatasetDBBasics.TestMergeChangeLog
+TTestBufDatasetDBBasics.TestAddIndexInteger
+TTestBufDatasetDBBasics.TestAddIndexSmallInt
+TTestBufDatasetDBBasics.TestAddIndexBoolean
+TTestBufDatasetDBBasics.TestAddIndexFloat
+TTestBufDatasetDBBasics.TestAddIndexLargeInt
+TTestBufDatasetDBBasics.TestAddIndexDateTime
+TTestBufDatasetDBBasics.TestAddIndexCurrency
+TTestBufDatasetDBBasics.TestAddIndexBCD
+TTestBufDatasetDBBasics.TestAddIndex
+TTestBufDatasetDBBasics.TestAddDescIndex
+TTestBufDatasetDBBasics.TestAddCaseInsIndex
+TTestBufDatasetDBBasics.TestInactSwitchIndex
+TTestBufDatasetDBBasics.TestAddIndexActiveDS
+TTestBufDatasetDBBasics.TestAddIndexEditDS
+TTestBufDatasetDBBasics.TestIndexFieldNames
+TTestBufDatasetDBBasics.TestIndexFieldNamesAct
+TTestBufDatasetDBBasics.TestIndexCurRecord
+TTestBufDatasetDBBasics.TestAddDblIndex
+TTestBufDatasetDBBasics.TestIndexEditRecord
+TTestBufDatasetDBBasics.TestIndexAppendRecord
+TTestUniDirectionalDBBasics.TestSetFieldValues
+TTestUniDirectionalDBBasics.TestGetFieldValues
+TTestUniDirectionalDBBasics.TestSupportIntegerFields
+TTestUniDirectionalDBBasics.TestSupportSmallIntFields
+TTestUniDirectionalDBBasics.TestSupportWordFields
+TTestUniDirectionalDBBasics.TestSupportStringFields
+TTestUniDirectionalDBBasics.TestSupportBooleanFields
+TTestUniDirectionalDBBasics.TestSupportFloatFields
+TTestUniDirectionalDBBasics.TestSupportLargeIntFields
+TTestUniDirectionalDBBasics.TestSupportDateFields
+TTestUniDirectionalDBBasics.TestSupportTimeFields
+TTestUniDirectionalDBBasics.TestSupportCurrencyFields
+TTestUniDirectionalDBBasics.TestSupportBCDFields
+TTestUniDirectionalDBBasics.TestSupportfmtBCDFields
+TTestUniDirectionalDBBasics.TestSupportFixedStringFields
+TTestUniDirectionalDBBasics.TestSupportBlobFields
+TTestUniDirectionalDBBasics.TestSupportMemoFields
+TTestUniDirectionalDBBasics.TestDoubleClose
+TTestUniDirectionalDBBasics.TestCalculatedField
+TTestUniDirectionalDBBasics.TestAssignFieldftString
+TTestUniDirectionalDBBasics.TestAssignFieldftFixedChar
+TTestUniDirectionalDBBasics.TestSelectQueryBasics
+TTestUniDirectionalDBBasics.TestPostOnlyInEditState
+TTestUniDirectionalDBBasics.TestMove
+TTestUniDirectionalDBBasics.TestActiveBufferWhenClosed
+TTestUniDirectionalDBBasics.TestEOFBOFClosedDataset
+TTestUniDirectionalDBBasics.TestLayoutChangedEvents
+TTestUniDirectionalDBBasics.TestDataEventsResync
+TTestUniDirectionalDBBasics.TestRecordcountAfterReopen
+TTestUniDirectionalDBBasics.TestdeFieldListChange
+TTestUniDirectionalDBBasics.TestExceptionLocateClosed
+TTestUniDirectionalDBBasics.TestCanModifySpecialFields
+TTestUniDirectionalDBBasics.TestDetectionNonMatchingDataset
+TTestBufDatasetStreams.TestSimpleEditCancelUpd
+TTestBufDatasetStreams.TestSimpleDeleteCancelUpd
+TTestBufDatasetStreams.TestMoreDeletesCancelUpd
+TTestBufDatasetStreams.TestSimpleInsertCancelUpd
+TTestBufDatasetStreams.MoreInsertsCancelUpd
+TTestBufDatasetStreams.SeveralEditsCancelUpd
+TTestBufDatasetStreams.DeleteAllCancelUpd
+TTestBufDatasetStreams.DeleteAllInsertCancelUpd
+TTestBufDatasetStreams.AppendDeleteCancelUpd
+TTestBufDatasetStreams.TestSimpleEditApplUpd
+TTestBufDatasetStreams.TestSimpleDeleteApplUpd
+TTestBufDatasetStreams.TestMoreDeletesApplUpd
+TTestBufDatasetStreams.TestSimpleInsertApplUpd
+TTestBufDatasetStreams.MoreInsertsApplUpd
+TTestBufDatasetStreams.SeveralEditsApplUpd
+TTestBufDatasetStreams.DeleteAllApplUpd
+TTestBufDatasetStreams.DeleteAllInsertApplUpd
+TTestBufDatasetStreams.NullInsertUpdateApplUpd
+TTestBufDatasetStreams.TestBasicsXML
+TTestBufDatasetStreams.TestSimpleEditXML
+TTestBufDatasetStreams.TestSimpleDeleteXML
+TTestBufDatasetStreams.TestMoreDeletesXML
+TTestBufDatasetStreams.TestSimpleInsertXML
+TTestBufDatasetStreams.TestMoreInsertsXML
+TTestBufDatasetStreams.TestSeveralEditsXML
+TTestBufDatasetStreams.TestDeleteAllXML
+TTestBufDatasetStreams.TestDeleteAllInsertXML
+TTestBufDatasetStreams.TestStreamingBlobFieldsXML
+TTestBufDatasetStreams.TestStreamingBigBlobFieldsXML
+TTestBufDatasetStreams.TestStreamingCalculatedFieldsXML
+TTestBufDatasetStreams.TestAppendDeleteBIN
+TTestBufDatasetStreams.TestFileNameProperty
+TTestBufDatasetStreams.TestXmlFileRecognition
+TTestBufDatasetStreams.TestCloseDatasetNoConnection
+TTestDBExport.TestDBFExport_DBaseIV
+TTestDBExport.TestDBFExport_DBaseVII
+TTestDBExport.TestDBFExport_FoxPro
+TTestDBExport.TestCSVExport
+TTestDBExport.TestCSVExport_RFC4180WithHeader
+TTestDBExport.TestCSVExport_TweakSettingsSemicolon
+TTestDBExport.TestFixedTextExport
+TTestDBExport.TestJSONExport
+TTestDBExport.TestRTFExport
+TTestDBExport.TestSQLExport
+TTestDBExport.TestTeXExport
+TTestDBExport.TestXMLExport
+TTestDBExport.TestXSDExport_Access_NoXSD_DecimalOverride
+TTestDBExport.TestXSDExport_Access_NoXSD_NoDecimalOverride
+TTestDBExport.TestXSDExport_Access_XSD_DecimalOverride
+TTestDBExport.TestXSDExport_Access_XSD_NoDecimalOverride
+TTestDBExport.TestXSDExport_ADONET_NoXSD
+TTestDBExport.TestXSDExport_ADONET_XSD
+TTestDBExport.TestXSDExport_DelphiClientDataset
+TTestDBExport.TestXSDExport_Excel

+ 20 - 8
packages/fcl-db/tests/testbasics.pas

@@ -136,6 +136,7 @@ var ds       : TDataset;
     
     
 begin
 begin
   ds := TDataset.Create(nil);
   ds := TDataset.Create(nil);
+  try
 
 
   F1:=TStringField.Create(ds);
   F1:=TStringField.Create(ds);
   F1.Size := 10;
   F1.Size := 10;
@@ -164,6 +165,10 @@ begin
   CompareFieldAndFieldDef(F1,ds.FieldDefs[0]);
   CompareFieldAndFieldDef(F1,ds.FieldDefs[0]);
   CompareFieldAndFieldDef(F2,ds.FieldDefs[1]);
   CompareFieldAndFieldDef(F2,ds.FieldDefs[1]);
   CompareFieldAndFieldDef(F3,ds.FieldDefs[2]);
   CompareFieldAndFieldDef(F3,ds.FieldDefs[2]);
+  finally
+    ds.Free;
+  end;
+
 end;
 end;
 
 
 procedure TTestBasics.TestDoubleFieldDef;
 procedure TTestBasics.TestDoubleFieldDef;
@@ -173,22 +178,29 @@ begin
   // If a second field with the same name is added to a TFieldDefs, an exception
   // If a second field with the same name is added to a TFieldDefs, an exception
   // should occur
   // should occur
   ds := TDataset.create(nil);
   ds := TDataset.create(nil);
-  ds.FieldDefs.Add('Field1',ftInteger);
-  PassException:=False;
   try
   try
-    ds.FieldDefs.Add('Field1',ftString,10,false)
-  except
-    on E: EDatabaseError do PassException := True;
+    ds.FieldDefs.Add('Field1',ftInteger);
+    PassException:=False;
+    try
+      ds.FieldDefs.Add('Field1',ftString,10,false)
+    except
+      on E: EDatabaseError do PassException := True;
+    end;
+    AssertTrue(PassException);
+  finally
+    ds.Free;
   end;
   end;
-  AssertTrue(PassException);
 end;
 end;
 
 
 procedure TTestBasics.TestFieldDefWithoutDS;
 procedure TTestBasics.TestFieldDefWithoutDS;
 var FieldDefs : TFieldDefs;
 var FieldDefs : TFieldDefs;
 begin
 begin
   FieldDefs := TFieldDefs.Create(nil);
   FieldDefs := TFieldDefs.Create(nil);
-  FieldDefs.Add('test',ftString);
-  FieldDefs.Free;
+  try
+    FieldDefs.Add('test',ftString);
+  finally
+    FieldDefs.Free;
+  end;
 end;
 end;
 
 
 procedure TTestBasics.TestGetFieldList;
 procedure TTestBasics.TestGetFieldList;

+ 134 - 117
packages/fcl-db/tests/testdbbasics.pas

@@ -18,14 +18,11 @@ type
 
 
   { TTestDBBasics }
   { TTestDBBasics }
 
 
-  TTestDBBasics = class(TTestCase)
+  TTestDBBasics = class(TDBBasicsTestCase)
   private
   private
     procedure TestfieldDefinition(AFieldType : TFieldType;ADatasize : integer;var ADS : TDataset; var AFld: TField);
     procedure TestfieldDefinition(AFieldType : TFieldType;ADatasize : integer;var ADS : TDataset; var AFld: TField);
     procedure TestcalculatedField_OnCalcfields(DataSet: TDataSet);
     procedure TestcalculatedField_OnCalcfields(DataSet: TDataSet);
 
 
-  protected
-    procedure SetUp; override;
-    procedure TearDown; override;
   published
   published
     procedure TestSetFieldValues;
     procedure TestSetFieldValues;
     procedure TestGetFieldValues;
     procedure TestGetFieldValues;
@@ -66,13 +63,10 @@ type
 
 
   { TTestBufDatasetDBBasics }
   { TTestBufDatasetDBBasics }
 {$ifdef fpc}
 {$ifdef fpc}
-  TTestBufDatasetDBBasics = class(TTestCase)
+  TTestBufDatasetDBBasics = class(TDBBasicsTestCase)
   private
   private
     procedure FTestXMLDatasetDefinition(ADataset : TDataset);
     procedure FTestXMLDatasetDefinition(ADataset : TDataset);
     procedure TestAddIndexFieldType(AFieldType : TFieldType; ActiveDS : boolean);
     procedure TestAddIndexFieldType(AFieldType : TFieldType; ActiveDS : boolean);
-  protected
-    procedure SetUp; override;
-    procedure TearDown; override;
   published
   published
     procedure TestClosedIndexFieldNames; // bug 16695
     procedure TestClosedIndexFieldNames; // bug 16695
     procedure TestFileNameProperty;
     procedure TestFileNameProperty;
@@ -120,14 +114,11 @@ type
 
 
   { TTestCursorDBBasics }
   { TTestCursorDBBasics }
 
 
-  TTestCursorDBBasics = class(TTestCase)
+  TTestCursorDBBasics = class(TDBBasicsTestCase)
   private
   private
     procedure TestOnFilterProc(DataSet: TDataSet; var Accept: Boolean);
     procedure TestOnFilterProc(DataSet: TDataSet; var Accept: Boolean);
     procedure FTestDelete1(TestCancelUpdate : boolean);
     procedure FTestDelete1(TestCancelUpdate : boolean);
     procedure FTestDelete2(TestCancelUpdate : boolean);
     procedure FTestDelete2(TestCancelUpdate : boolean);
-  protected
-    procedure SetUp; override;
-    procedure TearDown; override;
   published
   published
     procedure TestCancelUpdDelete1;
     procedure TestCancelUpdDelete1;
     procedure TestCancelUpdDelete2;
     procedure TestCancelUpdDelete2;
@@ -175,6 +166,7 @@ type
     procedure OneTimeTearDown; override;
     procedure OneTimeTearDown; override;
   end;
   end;
 {$endif fpc}
 {$endif fpc}
+
 implementation
 implementation
 
 
 uses
 uses
@@ -186,20 +178,10 @@ uses
   strutils,
   strutils,
   FmtBCD;
   FmtBCD;
 
 
-type THackDataLink=class(TdataLink);
+type THackDataLink=class(TDataLink);
 
 
 { TTestCursorDBBasics }
 { TTestCursorDBBasics }
 
 
-procedure TTestCursorDBBasics.SetUp;
-begin
-  DBConnector.StartTest;
-end;
-
-procedure TTestCursorDBBasics.TearDown;
-begin
-  DBConnector.StopTest;
-end;
-
 procedure TTestCursorDBBasics.TestAppendOnEmptyDataset;
 procedure TTestCursorDBBasics.TestAppendOnEmptyDataset;
 begin
 begin
   with DBConnector.GetNDataset(0) do
   with DBConnector.GetNDataset(0) do
@@ -616,16 +598,6 @@ begin
 end;
 end;
 
 
 
 
-procedure TTestDBBasics.SetUp;
-begin
-  DBConnector.StartTest;
-end;
-
-procedure TTestDBBasics.TearDown;
-begin
-  DBConnector.StopTest;
-end;
-
 procedure TTestCursorDBBasics.TestOldValueObsolete;
 procedure TTestCursorDBBasics.TestOldValueObsolete;
 var v : variant;
 var v : variant;
     bufds: TDataset;
     bufds: TDataset;
@@ -1383,8 +1355,12 @@ begin
   ds.close;
   ds.close;
 
 
   LoadDs := TCustomBufDataset.Create(nil);
   LoadDs := TCustomBufDataset.Create(nil);
-  LoadDs.LoadFromFile('test.xml');
-  FTestXMLDatasetDefinition(LoadDS);
+  try
+    LoadDs.LoadFromFile('test.xml');
+    FTestXMLDatasetDefinition(LoadDS);
+  finally
+    LoadDS.free;
+  end;
 end;
 end;
 
 
 procedure TTestBufDatasetDBBasics.TestFileNameProperty;
 procedure TTestBufDatasetDBBasics.TestFileNameProperty;
@@ -1414,26 +1390,31 @@ var ds : TCustomBufDataset;
     i  : integer;
     i  : integer;
 begin
 begin
   ds := TCustomBufDataset.Create(nil);
   ds := TCustomBufDataset.Create(nil);
-  DS.FieldDefs.Add('ID',ftInteger);
-  DS.FieldDefs.Add('NAME',ftString,50);
-  DS.CreateDataset;
-  DS.Open;
-  for i := 1 to 10 do
-    begin
-    ds.Append;
-    ds.FieldByName('ID').AsInteger := i;
-    ds.FieldByName('NAME').AsString := 'TestName' + inttostr(i);
-    DS.Post;
-    end;
-  ds.first;
-  for i := 1 to 10 do
-    begin
-    CheckEquals(i,ds.fieldbyname('ID').asinteger);
-    CheckEquals('TestName' + inttostr(i),ds.fieldbyname('NAME').AsString);
-    ds.next;
-    end;
-  CheckTrue(ds.EOF);
-  DS.Close;
+    try
+    DS.FieldDefs.Add('ID',ftInteger);
+    DS.FieldDefs.Add('NAME',ftString,50);
+    DS.CreateDataset;
+    DS.Open;
+    for i := 1 to 10 do
+      begin
+      ds.Append;
+      ds.FieldByName('ID').AsInteger := i;
+      ds.FieldByName('NAME').AsString := 'TestName' + inttostr(i);
+      DS.Post;
+      end;
+    ds.first;
+    for i := 1 to 10 do
+      begin
+      CheckEquals(i,ds.fieldbyname('ID').asinteger);
+      CheckEquals('TestName' + inttostr(i),ds.fieldbyname('NAME').AsString);
+      ds.next;
+      end;
+    CheckTrue(ds.EOF);
+    DS.Close;
+
+  finally
+    ds.Free;
+  end;
 end;
 end;
 
 
 procedure TTestBufDatasetDBBasics.TestBufDatasetCancelUpd;
 procedure TTestBufDatasetDBBasics.TestBufDatasetCancelUpd;
@@ -1565,7 +1546,7 @@ procedure TTestBufDatasetDBBasics.TestMergeChangeLog;
 var
 var
   ds: TCustomBufDataset;
   ds: TCustomBufDataset;
   i: integer;
   i: integer;
-  s: string;
+  s, FN: string;
 begin
 begin
   ds := DBConnector.GetNDataset(5) as TCustomBufDataset;
   ds := DBConnector.GetNDataset(5) as TCustomBufDataset;
   with ds do
   with ds do
@@ -1580,10 +1561,41 @@ begin
     checkequals(fields[0].OldValue,i);
     checkequals(fields[0].OldValue,i);
     checkequals(fields[1].OldValue,s);
     checkequals(fields[1].OldValue,s);
     CheckEquals(ChangeCount,1);
     CheckEquals(ChangeCount,1);
+    Next;
+    Edit;
+    i := fields[0].AsInteger;
+    s := fields[1].AsString;
+    fields[0].AsInteger:=23;
+    fields[1].AsString:='hanged';
+    Post;
+    checkequals(fields[0].OldValue,i);
+    checkequals(fields[1].OldValue,s);
+    CheckEquals(ChangeCount,2);
     MergeChangeLog;
     MergeChangeLog;
     CheckEquals(ChangeCount,0);
     CheckEquals(ChangeCount,0);
-    checkequals(fields[0].OldValue,64);
-    checkequals(fields[1].OldValue,'Changed');
+    checkequals(fields[0].OldValue,23);
+    checkequals(fields[1].OldValue,'hanged');
+    end;
+
+  // Test handling of [Update]BlobBuffers in TBufDataset
+  ds := DBConnector.GetFieldDataset as TCustomBufDataset;
+  with ds do
+    begin
+    // Testing scenario: read some records, so blob data are added into FBlobBuffers,
+    // then update blob field, so element is added to FUpdateBlobBuffers, then read again some records
+    // so next elements are added to FBlobBuffers, then again update blob field
+    // DefaultBufferCount is 10
+    PacketRecords:=1;
+    Open;
+    FN := 'F'+FieldTypeNames[ftBlob];
+    First;     Edit; FieldByName(FN).AsString:='b01'; Post;
+    RecNo:=11; Edit; FieldByName(FN).AsString:='b11'; Post;
+    Next     ; Edit; FieldByName(FN).AsString:='b12'; Post;
+    Last;
+    MergeChangeLog;
+    First;     CheckEquals('b01', FieldByName(FN).AsString);
+    RecNo:=11; CheckEquals('b11', FieldByName(FN).AsString);
+    Next;      CheckEquals('b12', FieldByName(FN).AsString);
     end;
     end;
 end;
 end;
 
 
@@ -1716,6 +1728,7 @@ begin
     AFieldType:=ftString;
     AFieldType:=ftString;
     AddIndex('testindex','F'+FieldTypeNames[AfieldType],[]);
     AddIndex('testindex','F'+FieldTypeNames[AfieldType],[]);
     FList := TStringList.Create;
     FList := TStringList.Create;
+    try
     FList.Sorted:=true;
     FList.Sorted:=true;
     FList.CaseSensitive:=True;
     FList.CaseSensitive:=True;
     FList.Duplicates:=dupAccept;
     FList.Duplicates:=dupAccept;
@@ -1744,6 +1757,9 @@ begin
       CheckEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
       CheckEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
       Prior;
       Prior;
       end;
       end;
+    finally
+      flist.free;
+    end;  
     end;
     end;
 end;
 end;
 
 
@@ -1760,34 +1776,38 @@ begin
     AFieldType:=ftString;
     AFieldType:=ftString;
     AddIndex('testindex','F'+FieldTypeNames[AfieldType],[],'F'+FieldTypeNames[AfieldType]);
     AddIndex('testindex','F'+FieldTypeNames[AfieldType],[],'F'+FieldTypeNames[AfieldType]);
     FList := TStringList.Create;
     FList := TStringList.Create;
-    FList.Sorted:=true;
-    FList.CaseSensitive:=True;
-    FList.Duplicates:=dupAccept;
-    open;
+    try
+      FList.Sorted:=true;
+      FList.CaseSensitive:=True;
+      FList.Duplicates:=dupAccept;
+      open;
 
 
-    while not eof do
-      begin
-      flist.Add(FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
-      Next;
-      end;
+      while not eof do
+        begin
+        flist.Add(FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
+        Next;
+        end;
 
 
-    IndexName:='testindex';
-    first;
-    i:=FList.Count-1;
+      IndexName:='testindex';
+      first;
+      i:=FList.Count-1;
 
 
-    while not eof do
-      begin
-      CheckEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
-      dec(i);
-      Next;
-      end;
+      while not eof do
+        begin
+        CheckEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
+        dec(i);
+        Next;
+        end;
 
 
-    while not bof do
-      begin
-      inc(i);
-      CheckEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
-      Prior;
-      end;
+      while not bof do
+        begin
+        inc(i);
+        CheckEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
+        Prior;
+        end;
+    finally
+      flist.free;
+    end;  
     end;
     end;
 end;
 end;
 
 
@@ -1804,33 +1824,37 @@ begin
     AFieldType:=ftString;
     AFieldType:=ftString;
     AddIndex('testindex','F'+FieldTypeNames[AfieldType],[],'','F'+FieldTypeNames[AfieldType]);
     AddIndex('testindex','F'+FieldTypeNames[AfieldType],[],'','F'+FieldTypeNames[AfieldType]);
     FList := TStringList.Create;
     FList := TStringList.Create;
-    FList.Sorted:=true;
-    FList.Duplicates:=dupAccept;
-    open;
+    try
+      FList.Sorted:=true;
+      FList.Duplicates:=dupAccept;
+      open;
 
 
-    while not eof do
-      begin
-      flist.Add(FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
-      Next;
-      end;
+      while not eof do
+        begin
+        flist.Add(FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
+        Next;
+        end;
 
 
-    IndexName:='testindex';
-    first;
-    i:=0;
+      IndexName:='testindex';
+      first;
+      i:=0;
 
 
-    while not eof do
-      begin
-      CheckEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
-      inc(i);
-      Next;
-      end;
+      while not eof do
+        begin
+        CheckEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
+        inc(i);
+        Next;
+        end;
 
 
-    while not bof do
-      begin
-      dec(i);
-      CheckEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
-      Prior;
-      end;
+      while not bof do
+        begin
+        dec(i);
+        CheckEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
+        Prior;
+        end;
+    finally
+      FList.Free;
+    end;  
     end;
     end;
 end;
 end;
 
 
@@ -1915,6 +1939,7 @@ begin
     begin
     begin
     AFieldType:=ftString;
     AFieldType:=ftString;
     FList := TStringList.Create;
     FList := TStringList.Create;
+    try
     FList.Sorted:=true;
     FList.Sorted:=true;
     FList.CaseSensitive:=True;
     FList.CaseSensitive:=True;
     FList.Duplicates:=dupAccept;
     FList.Duplicates:=dupAccept;
@@ -1971,6 +1996,9 @@ begin
       end;
       end;
 
 
     CheckEquals('',IndexFieldNames);
     CheckEquals('',IndexFieldNames);
+    finally
+      flist.free;
+    end;  
 
 
     end;
     end;
 end;
 end;
@@ -2726,20 +2754,9 @@ begin
   DBConnector.TestUniDirectional:=false;
   DBConnector.TestUniDirectional:=false;
   inherited OneTimeTearDown;
   inherited OneTimeTearDown;
 end;
 end;
-
-{ TTestBufDatasetDBBasics }
-
-procedure TTestBufDatasetDBBasics.SetUp;
-begin
-  DBConnector.StartTest;
-end;
-
-procedure TTestBufDatasetDBBasics.TearDown;
-begin
-  DBConnector.StopTest;
-end;
 {$endif fpc}
 {$endif fpc}
 
 
+
 initialization
 initialization
 {$ifdef fpc}
 {$ifdef fpc}
   RegisterTestDecorator(TDBBasicsTestSetup, TTestDBBasics);
   RegisterTestDecorator(TDBBasicsTestSetup, TTestDBBasics);

+ 12 - 5
packages/fcl-db/tests/testdbexport.pas

@@ -13,9 +13,16 @@ interface
 uses
 uses
   fpcunit, testregistry,
   fpcunit, testregistry,
   Classes, SysUtils, db, ToolsUnit, bufdataset,
   Classes, SysUtils, db, ToolsUnit, bufdataset,
-  fpDBExport, fpXMLXSDExport, fpdbfexport, fpcsvexport, fpfixedexport,
-  fpSimpleXMLExport, fpsimplejsonexport, fpSQLExport,
-  fptexexport, fprtfexport;
+  fpDBExport,
+  fpXMLXSDExport,
+  fpdbfexport,
+  fpcsvexport,
+  fpfixedexport,
+  fpSimpleXMLExport,
+  fpsimplejsonexport,
+  fpSQLExport,
+  fptexexport,
+  fprtfexport;
 
 
 
 
 type
 type
@@ -146,7 +153,7 @@ procedure TTestDBExport.SetUp;
 begin
 begin
   inherited SetUp;
   inherited SetUp;
   InitialiseDBConnector;
   InitialiseDBConnector;
-  //DBConnector.StartTest; //is this needed?
+  DBConnector.StartTest; //is this needed?
   FExportTempDir:=IncludeTrailingPathDelimiter(ExpandFileName(''))+'exporttests'+PathDelim; //Store output in subdirectory
   FExportTempDir:=IncludeTrailingPathDelimiter(ExpandFileName(''))+'exporttests'+PathDelim; //Store output in subdirectory
   ForceDirectories(FExportTempDir);
   ForceDirectories(FExportTempDir);
   FKeepFilesAfterTest:=true; //keep test files; consistent with other units right now
   FKeepFilesAfterTest:=true; //keep test files; consistent with other units right now
@@ -155,7 +162,7 @@ end;
 procedure TTestDBExport.TearDown;
 procedure TTestDBExport.TearDown;
 begin
 begin
   inherited TearDown;
   inherited TearDown;
-  //DBConnector.StopTest; //is this needed?
+  DBConnector.StopTest; //is this needed?
   FreeDBConnector;
   FreeDBConnector;
 end;
 end;
 
 

+ 5 - 2
packages/fcl-db/tests/testfieldtypes.pas

@@ -164,8 +164,6 @@ const
     '', #0, #0#1#2#3#4#5#6#7#8#9
     '', #0, #0#1#2#3#4#5#6#7#8#9
   );
   );
 
 
-  STestNotApplicable = 'This test does not apply to this sqldb-connection type';
-
 
 
 procedure TTestFieldTypes.TestpfInUpdateFlag;
 procedure TTestFieldTypes.TestpfInUpdateFlag;
 var ds   : TCustomBufDataset;
 var ds   : TCustomBufDataset;
@@ -224,6 +222,7 @@ begin
       TSQLDBConnector(DBConnector).CommitDDL;
       TSQLDBConnector(DBConnector).CommitDDL;
       end;
       end;
   finally
   finally
+    AScript.Free;
     TSQLDBConnector(DBConnector).Connection.ExecuteDirect('drop table a');
     TSQLDBConnector(DBConnector).Connection.ExecuteDirect('drop table a');
     TSQLDBConnector(DBConnector).Connection.ExecuteDirect('drop table b');
     TSQLDBConnector(DBConnector).Connection.ExecuteDirect('drop table b');
     // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
     // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
@@ -2242,8 +2241,10 @@ begin
       open;
       open;
     except
     except
       on E: Exception do
       on E: Exception do
+      begin
         passed := (E.ClassType.InheritsFrom(EDatabaseError))
         passed := (E.ClassType.InheritsFrom(EDatabaseError))
       end;
       end;
+      end;
     AssertTrue(passed);
     AssertTrue(passed);
 
 
     Close;
     Close;
@@ -2272,10 +2273,12 @@ end;
 procedure TTestFieldTypes.SetUp;
 procedure TTestFieldTypes.SetUp;
 begin
 begin
   InitialiseDBConnector;
   InitialiseDBConnector;
+  DBConnector.StartTest;
 end;
 end;
 
 
 procedure TTestFieldTypes.TearDown;
 procedure TTestFieldTypes.TearDown;
 begin
 begin
+  DBConnector.StopTest;
   if assigned(DBConnector) then
   if assigned(DBConnector) then
     TSQLDBConnector(DBConnector).Transaction.Rollback;
     TSQLDBConnector(DBConnector).Transaction.Rollback;
   FreeDBConnector;
   FreeDBConnector;

+ 30 - 0
packages/fcl-db/tests/testleaks.sh

@@ -0,0 +1,30 @@
+#!/bin/bash
+echo "Compiling test framework";
+fpc -glh dbtestframework.pas
+if [ $? != 0 ]; then
+  echo "Compilation failed";
+  exit
+fi
+for f in `cat test-list.txt`
+do
+  echo -n "Doing test $f"
+  ./dbtestframework --suite=$f > $f-mem.txt 2>&1
+  grep '^0 unfreed memory blocks' $f-mem.txt >/dev/null 2>&1
+  EC=$?
+  if [ $EC = 1 ]; then
+    echo "Error:"
+    echo "Memory leak in $f"
+  else 
+    if [ $EC = 0 ]; then
+      echo "OK, removing log file."
+      rm $f-mem.txt
+    fi   
+  fi
+done 
+NOTESTS=`cat test-list.txt | wc -l`
+grep -L '^0 unfreed memory blocks' *-mem.txt > leaklist.txt
+NOLEAKS=`cat leaklist.txt | wc -l`
+echo "Failures:"
+cat leaklist.txt
+echo "$NOTESTS tests performed, $NOLEAKS tests have memleak"
+# done

+ 145 - 0
packages/fcl-db/tests/testsqldb.pas

@@ -0,0 +1,145 @@
+unit TestSQLDB;
+
+{
+  Unit tests which are specific to the sqlDB components like TSQLQuery, TSQLConnection.
+}
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry,
+  db;
+
+type
+
+  { TSQLDBTestCase }
+
+  TSQLDBTestCase = class(TTestCase)
+    protected
+      procedure SetUp; override;
+      procedure TearDown; override;
+  end;
+
+  { TTestTSQLQuery }
+
+  TTestTSQLQuery = class(TSQLDBTestCase)
+  private
+  published
+    procedure TestUpdateServerIndexDefs;
+  end;
+
+  { TTestTSQLConnection }
+
+  TTestTSQLConnection = class(TSQLDBTestCase)
+  private
+  published
+    procedure ReplaceMe;
+  end;
+
+
+implementation
+
+uses sqldbtoolsunit, toolsunit, sqldb;
+
+{ TTestTSQLQuery }
+
+procedure TTestTSQLQuery.TestUpdateServerIndexDefs;
+var Q: TSQLQuery;
+    name1, name2, name3: string;
+begin
+  // Test retrieval of information about indexes on unquoted and quoted table names
+  //  (tests also case-sensitivity for DB's that support case-sensitivity of quoted identifiers)
+  // For ODBC Firebird/Interbase we must define primary key as named constraint and
+  //  in ODBC driver must be set: "quoted identifiers" and "sensitive identifier"
+  // See also: TTestFieldTypes.TestUpdateIndexDefs
+  with TSQLDBConnector(DBConnector) do
+  begin
+    // SQLite ignores case-sensitivity of quoted table names
+    // MS SQL Server case-sensitivity of identifiers depends on the case-sensitivity of default collation of the database
+    // MySQL case-sensitivity depends on case-sensitivity of server's file system
+    if SQLServerType in [ssMSSQL,ssSQLite{$IFDEF WINDOWS},ssMySQL{$ENDIF}] then
+      name1 := Connection.FieldNameQuoteChars[0]+'fpdev 2'+Connection.FieldNameQuoteChars[1]
+    else
+      name1 := 'FPDEV2';
+    ExecuteDirect('create table '+name1+' (id integer not null, constraint PK_FPDEV21 primary key(id))');
+    // same but quoted table name
+    name2 := Connection.FieldNameQuoteChars[0]+'FPdev2'+Connection.FieldNameQuoteChars[1];
+    ExecuteDirect('create table '+name2+' (ID2 integer not null, constraint PK_FPDEV22 primary key(ID2))');
+    // embedded quote in table name
+    if SQLServerType in [ssMySQL] then
+      name3 := '`FPdev``2`'
+    else
+      name3 := Connection.FieldNameQuoteChars[0]+'FPdev""2'+Connection.FieldNameQuoteChars[1];
+    ExecuteDirect('create table '+name3+' (Id3 integer not null, constraint PK_FPDEV23 primary key(Id3))');
+    CommitDDL;
+  end;
+
+  try
+    Q := TSQLDBConnector(DBConnector).Query;
+    Q.SQL.Text:='select * from '+name1;
+    Q.Prepare;
+    Q.ServerIndexDefs.Update;
+    CheckEquals(1, Q.ServerIndexDefs.Count);
+
+    Q.SQL.Text:='select * from '+name2;
+    Q.Prepare;
+    Q.ServerIndexDefs.Update;
+    CheckEquals(1, Q.ServerIndexDefs.Count, '2.1');
+    CheckTrue(CompareText('ID2', Q.ServerIndexDefs[0].Fields)=0, '2.2'+Q.ServerIndexDefs[0].Fields);
+    CheckTrue(Q.ServerIndexDefs[0].Options=[ixPrimary,ixUnique], '2.3');
+
+    Q.SQL.Text:='select * from '+name3;
+    Q.Prepare;
+    Q.ServerIndexDefs.Update;
+    CheckEquals(1, Q.ServerIndexDefs.Count, '3.1');
+    CheckTrue(CompareText('ID3', Q.ServerIndexDefs[0].Fields)=0, '3.2');
+    CheckTrue(Q.ServerIndexDefs[0].Options=[ixPrimary,ixUnique], '3.3');
+  finally
+    Q.UnPrepare;
+    with TSQLDBConnector(DBConnector) do
+    begin
+      ExecuteDirect('DROP TABLE '+name1);
+      ExecuteDirect('DROP TABLE '+name2);
+      ExecuteDirect('DROP TABLE '+name3);
+      CommitDDL;
+    end;
+  end;
+end;
+
+{ TTestTSQLConnection }
+
+procedure TTestTSQLConnection.ReplaceMe;
+begin
+  // replace this procedure with any test for TSQLConnection
+end;
+
+
+{ TSQLDBTestCase }
+
+procedure TSQLDBTestCase.SetUp;
+begin
+  inherited SetUp;
+  InitialiseDBConnector;
+  DBConnector.StartTest;
+end;
+
+procedure TSQLDBTestCase.TearDown;
+begin
+  DBConnector.StopTest;
+  if assigned(DBConnector) then
+    with TSQLDBConnector(DBConnector) do
+      Transaction.Rollback;
+  FreeDBConnector;
+  inherited TearDown;
+end;
+
+
+initialization
+  if uppercase(dbconnectorname)='SQL' then
+  begin
+    RegisterTest(TTestTSQLQuery);
+    RegisterTest(TTestTSQLConnection);
+  end;
+end.

+ 134 - 108
packages/fcl-db/tests/toolsunit.pas

@@ -7,7 +7,7 @@ unit ToolsUnit;
 interface
 interface
 
 
 uses
 uses
-  Classes, SysUtils, DB, testdecorator;
+  Classes, SysUtils, DB, testdecorator, fpcunit;
 
 
 Const
 Const
   // Number of "N" test datasets (as opposed to FieldDatasets) that will be created
   // Number of "N" test datasets (as opposed to FieldDatasets) that will be created
@@ -19,6 +19,7 @@ Const
 type
 type
 
 
   { TDBConnector }
   { TDBConnector }
+
   TDBConnectorClass = class of TDBConnector;
   TDBConnectorClass = class of TDBConnector;
   TDBConnector = class(TPersistent)
   TDBConnector = class(TPersistent)
      private
      private
@@ -53,8 +54,8 @@ type
        procedure DropNDatasets; virtual; abstract;
        procedure DropNDatasets; virtual; abstract;
        procedure DropFieldDataset; virtual; abstract;
        procedure DropFieldDataset; virtual; abstract;
      public
      public
-       constructor create; virtual;
-       destructor destroy; override;
+       constructor Create; virtual;
+       destructor Destroy; override;
 
 
        procedure DataEvent(dataset :TDataset);
        procedure DataEvent(dataset :TDataset);
 
 
@@ -72,15 +73,7 @@ type
        property FormatSettings: TFormatSettings read FFormatSettings;
        property FormatSettings: TFormatSettings read FFormatSettings;
      end;
      end;
 
 
-  { TDBBasicsTestSetup }
-
-  TDBBasicsTestSetup = class(TTestSetup)
-    protected
-      procedure OneTimeSetup; override;
-      procedure OneTimeTearDown; override;
-    end;
-
-{ TTestDataLink }
+  { TTestDataLink }
 
 
   TTestDataLink = class(TDataLink)
   TTestDataLink = class(TDataLink)
      protected
      protected
@@ -93,6 +86,22 @@ type
 {$ENDIF}
 {$ENDIF}
      end;
      end;
 
 
+  { TDBBasicsTestSetup }
+
+  TDBBasicsTestSetup = class(TTestSetup)
+    protected
+      procedure OneTimeSetup; override;
+      procedure OneTimeTearDown; override;
+    end;
+
+  { TDBBasicsTestCase }
+  TDBBasicsTestCase = class(TTestCase)
+    protected
+      procedure SetUp; override;
+      procedure TearDown; override;
+  end;
+
+
 const
 const
   DataEventnames : Array [TDataEvent] of String[21] =
   DataEventnames : Array [TDataEvent] of String[21] =
     ('deFieldChange', 'deRecordChange', 'deDataSetChange', 'deDataSetScroll',
     ('deFieldChange', 'deRecordChange', 'deDataSetChange', 'deDataSetScroll',
@@ -224,7 +233,9 @@ uses
 
 
 var DBConnectorRefCount: integer;
 var DBConnectorRefCount: integer;
 
 
-constructor TDBConnector.create;
+{ TDBConnector }
+
+constructor TDBConnector.Create;
 begin
 begin
   FFormatSettings.DecimalSeparator:='.';
   FFormatSettings.DecimalSeparator:='.';
   FFormatSettings.ThousandSeparator:=#0;
   FFormatSettings.ThousandSeparator:=#0;
@@ -237,11 +248,12 @@ begin
   CreateNDatasets;
   CreateNDatasets;
 end;
 end;
 
 
-destructor TDBConnector.destroy;
+destructor TDBConnector.Destroy;
 begin
 begin
   if assigned(FUsedDatasets) then FUsedDatasets.Destroy;
   if assigned(FUsedDatasets) then FUsedDatasets.Destroy;
   DropNDatasets;
   DropNDatasets;
   DropFieldDataset;
   DropFieldDataset;
+  Inherited;
 end;
 end;
 
 
 function TDBConnector.GetTestUniDirectional: boolean;
 function TDBConnector.GetTestUniDirectional: boolean;
@@ -254,6 +266,11 @@ begin
   raise exception.create('Connector does not support tests for unidirectional datasets');
   raise exception.create('Connector does not support tests for unidirectional datasets');
 end;
 end;
 
 
+procedure TDBConnector.DataEvent(dataset : tdataset);
+begin
+  DataEvents := DataEvents + 'DataEvent' + ';';
+end;
+
 procedure TDBConnector.ResetNDatasets;
 procedure TDBConnector.ResetNDatasets;
 begin
 begin
   DropNDatasets;
   DropNDatasets;
@@ -266,17 +283,116 @@ begin
   CreateFieldDataset;
   CreateFieldDataset;
 end;
 end;
 
 
-procedure TDBConnector.DataEvent(dataset : tdataset);
+function TDBConnector.GetNDataset(n: integer): TDataset;
+begin
+  Result := GetNDataset(False,n);
+end;
 
 
+function TDBConnector.GetNDataset(AChange : Boolean; n: integer): TDataset;
 begin
 begin
-  DataEvents := DataEvents + 'DataEvent' + ';';
+  if AChange then FChangedDatasets[n] := True;
+  Result := InternalGetNDataset(n);
+  FUsedDatasets.Add(Result);
 end;
 end;
 
 
-function TDBConnector.GetNDataset(n: integer): TDataset;
+function TDBConnector.GetFieldDataset: TDataSet;
 begin
 begin
-  Result := GetNDataset(False,n);
+  Result := GetFieldDataset(False);
+end;
+
+function TDBConnector.GetFieldDataset(AChange: Boolean): TDataSet;
+begin
+  if AChange then FChangedFieldDataset := True;
+  Result := InternalGetFieldDataset;
+  FUsedDatasets.Add(Result);
+end;
+
+function TDBConnector.GetTraceDataset(AChange: Boolean): TDataset;
+begin
+  result := GetNDataset(AChange,NForTraceDataset);
 end;
 end;
 
 
+procedure TDBConnector.StartTest;
+begin
+  // Do nothing?
+end;
+
+procedure TDBConnector.StopTest;
+var i : integer;
+    ds : TDataset;
+begin
+  for i := 0 to FUsedDatasets.Count -1 do
+    begin
+    ds := tdataset(FUsedDatasets[i]);
+    if ds.active then ds.Close;
+    ds.Free;
+    end;
+  FUsedDatasets.Clear;
+  if FChangedFieldDataset then ResetFieldDataset;
+  for i := 0 to MaxDataSet do if FChangedDatasets[i] then
+    begin
+    ResetNDatasets;
+    fillchar(FChangedDatasets,sizeof(FChangedDatasets),ord(False));
+    break;
+    end;
+end;
+
+
+{ TTestDataLink }
+
+procedure TTestDataLink.DataSetScrolled(Distance: Integer);
+begin
+  DataEvents := DataEvents + 'DataSetScrolled' + ':' + inttostr(Distance) + ';';
+  inherited DataSetScrolled(Distance);
+end;
+
+procedure TTestDataLink.DataSetChanged;
+begin
+  DataEvents := DataEvents + 'DataSetChanged;';
+  inherited DataSetChanged;
+end;
+
+{$IFDEF FPC}
+procedure TTestDataLink.DataEvent(Event: TDataEvent; Info: Ptrint);
+{$ELSE}
+procedure TTestDataLink.DataEvent(Event: TDataEvent; Info: Longint);
+{$ENDIF}
+begin
+  if Event <> deFieldChange then
+    DataEvents := DataEvents + DataEventnames[Event] + ':' + inttostr(info) + ';'
+  else
+    DataEvents := DataEvents + DataEventnames[Event] + ':' + TField(info).FieldName + ';';
+  inherited DataEvent(Event, Info);
+end;
+
+
+{ TDBBasicsTestSetup }
+
+procedure TDBBasicsTestSetup.OneTimeSetup;
+begin
+  InitialiseDBConnector;
+end;
+
+procedure TDBBasicsTestSetup.OneTimeTearDown;
+begin
+  FreeDBConnector;
+end;
+
+{ TDBBasicsTestCase }
+
+procedure TDBBasicsTestCase.SetUp;
+begin
+  inherited SetUp;
+  DBConnector.StartTest;
+end;
+
+procedure TDBBasicsTestCase.TearDown;
+begin
+  DBConnector.StopTest;
+  inherited TearDown;
+end;
+
+
 procedure ReadIniFile;
 procedure ReadIniFile;
 
 
 var IniFile : TIniFile;
 var IniFile : TIniFile;
@@ -401,96 +517,6 @@ begin
 end;
 end;
 
 
 
 
-{ TTestDataLink }
-
-procedure TTestDataLink.DataSetScrolled(Distance: Integer);
-begin
-  DataEvents := DataEvents + 'DataSetScrolled' + ':' + inttostr(Distance) + ';';
-  inherited DataSetScrolled(Distance);
-end;
-
-procedure TTestDataLink.DataSetChanged;
-begin
-  DataEvents := DataEvents + 'DataSetChanged;';
-  inherited DataSetChanged;
-end;
-
-{$IFDEF FPC}
-procedure TTestDataLink.DataEvent(Event: TDataEvent; Info: Ptrint);
-{$ELSE}
-procedure TTestDataLink.DataEvent(Event: TDataEvent; Info: Longint);
-{$ENDIF}
-begin
-  if Event <> deFieldChange then
-    DataEvents := DataEvents + DataEventnames[Event] + ':' + inttostr(info) + ';'
-  else
-    DataEvents := DataEvents + DataEventnames[Event] + ':' + TField(info).FieldName + ';';
-  inherited DataEvent(Event, Info);
-end;
-
-{ TDBConnector }
-
-function TDBConnector.GetNDataset(AChange : Boolean; n: integer): TDataset;
-begin
-  if AChange then FChangedDatasets[n] := True;
-  Result := InternalGetNDataset(n);
-  FUsedDatasets.Add(Result);
-end;
-
-function TDBConnector.GetFieldDataset: TDataSet;
-begin
-  Result := GetFieldDataset(False);
-end;
-
-function TDBConnector.GetFieldDataset(AChange: Boolean): TDataSet;
-begin
-  if AChange then FChangedFieldDataset := True;
-  Result := InternalGetFieldDataset;
-  FUsedDatasets.Add(Result);
-end;
-
-function TDBConnector.GetTraceDataset(AChange: Boolean): TDataset;
-begin
-  result := GetNDataset(AChange,NForTraceDataset);
-end;
-
-procedure TDBConnector.StartTest;
-begin
-// Do nothing?
-end;
-
-procedure TDBConnector.StopTest;
-var i : integer;
-    ds : TDataset;
-begin
-  for i := 0 to FUsedDatasets.Count -1 do
-    begin
-    ds := tdataset(FUsedDatasets[i]);
-    if ds.active then ds.Close;
-    ds.Free;
-    end;
-  FUsedDatasets.Clear;
-  if FChangedFieldDataset then ResetFieldDataset;
-  for i := 0 to MaxDataSet do if FChangedDatasets[i] then
-    begin
-    ResetNDatasets;
-    fillchar(FChangedDatasets,sizeof(FChangedDatasets),ord(False));
-    break;
-    end;
-end;
-
-{ TDBBasicsTestSetup }
-
-procedure TDBBasicsTestSetup.OneTimeSetup;
-begin
-  InitialiseDBConnector;
-end;
-
-procedure TDBBasicsTestSetup.OneTimeTearDown;
-begin
-  FreeDBConnector;
-end;
-
 initialization
 initialization
   ReadIniFile;
   ReadIniFile;
   DBConnectorRefCount:=0;
   DBConnectorRefCount:=0;

+ 2 - 0
packages/sqlite/src/sqlite3db.pas

@@ -314,6 +314,7 @@ begin
    end;
    end;
    if length(InterS) > 0 then Field.add(InterS);
    if length(InterS) > 0 then Field.add(InterS);
    List_Field.add(Field);
    List_Field.add(Field);
+   Field.Free;
 end;
 end;
 {*************************************************************}
 {*************************************************************}
 constructor TSQLite.Create(DBFileName: String);
 constructor TSQLite.Create(DBFileName: String);
@@ -348,6 +349,7 @@ begin
       fError := SQLITE_OK;
       fError := SQLITE_OK;
    end;
    end;
    fMsg := sqlite3_errmsg(fSQLite);
    fMsg := sqlite3_errmsg(fSQLite);
+   strdispose(name);
 end;
 end;
 {*************************************************************}
 {*************************************************************}
 destructor TSQLite.Destroy;
 destructor TSQLite.Destroy;