Browse Source

--- Merging r20943 into '.':
U packages/fcl-db/src/base/bufdataset.pas
U packages/fcl-db/src/base/fields.inc
--- Merging r21009 into '.':
U packages/fcl-db/tests/testfieldtypes.pas
--- Merging r21010 into '.':
U packages/fcl-db/src/sqldb/sqldb.pp
--- Merging r21023 into '.':
U packages/fcl-db/tests/testdbbasics.pas
G packages/fcl-db/src/base/bufdataset.pas
--- Merging r21148 into '.':
U packages/fcl-db/tests/README.txt
--- Merging r21158 into '.':
U packages/fcl-db/src/base/datasource.inc
--- Merging r21159 into '.':
U packages/fcl-db/src/base/db.pas
--- Merging r21197 into '.':
U packages/fcl-db/tests/testbufdatasetstreams.pas
G packages/fcl-db/src/base/bufdataset.pas
--- Merging r21198 into '.':
G packages/fcl-db/src/base/bufdataset.pas
--- Merging r21199 into '.':
U packages/fcl-db/tests/toolsunit.pas
--- Merging r21200 into '.':
U packages/fcl-db/tests/bufdatasettoolsunit.pas
--- Merging r21224 into '.':
U packages/fcl-db/src/base/dataset.inc

# revisions: 20943,21009,21010,21023,21148,21158,21159,21197,21198,21199,21200,21224
r20943 | marco | 2012-04-20 17:01:34 +0200 (Fri, 20 Apr 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/base/bufdataset.pas
M /trunk/packages/fcl-db/src/base/fields.inc

* Allow setting autoinc fields in dsFilter,dsSetKey,dsInsert. Mantis #17624, patch by Lacak2.
r21009 | marco | 2012-04-24 10:35:29 +0200 (Tue, 24 Apr 2012) | 6 lines
Changed paths:
M /trunk/packages/fcl-db/tests/testfieldtypes.pas

* fcl-db test for opening non-select statements, which return data by Lacak2, Mantis #21850
* Test for already fixed bugs #0016842 "show tables from <dbname>" and #0014519 "check table <tablename>"
* Test for common table expressions used with select statement
* plus reformating of test values (which I forgot did in rev.20585)
r21010 | marco | 2012-04-24 10:45:16 +0200 (Tue, 24 Apr 2012) | 3 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/sqldb.pp

* sqlDB update SQLParser to parse DML statements WITH common table expressions
Patch by Lacak2, Mantis #21851
r21023 | marco | 2012-04-24 19:47:18 +0200 (Tue, 24 Apr 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/base/bufdataset.pas
M /trunk/packages/fcl-db/tests/testdbbasics.pas

* Cleanup of adding records to bufdatasets with indexes. Mantis #20514, patch by Lacak2.
r21148 | marco | 2012-04-30 16:58:39 +0200 (Mon, 30 Apr 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/tests/README.txt

* additions by Reinier, mantis #21895
r21158 | michael | 2012-05-01 13:21:03 +0200 (Tue, 01 May 2012) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/base/datasource.inc

* Applied patch from Luiz Americo not to send events when setting datasource to same value again (bug #21906)
r21159 | michael | 2012-05-01 13:23:57 +0200 (Tue, 01 May 2012) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/base/db.pas

* Remove empty destructors (patch from Luiz Americo, bug #21907)
r21197 | marco | 2012-05-02 22:09:10 +0200 (Wed, 02 May 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/base/bufdataset.pas
M /trunk/packages/fcl-db/tests/testbufdatasetstreams.pas

* Patch from Lacak2 for mantis #19593, exception while saving bufdataset to file.
r21198 | marco | 2012-05-02 22:15:09 +0200 (Wed, 02 May 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/base/bufdataset.pas

* fix for mantis #21919, rebuild indexes after loadrecordsfromfile, Mantis #21919 patch by Lacak2.
r21199 | marco | 2012-05-02 22:42:39 +0200 (Wed, 02 May 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/tests/toolsunit.pas

* Improved comments in toolsunit. Mantis #21910, patch by Reinier Olislagers
r21200 | marco | 2012-05-02 22:46:26 +0200 (Wed, 02 May 2012) | 3 lines
Changed paths:
M /trunk/packages/fcl-db/tests/bufdatasettoolsunit.pas

* Mantis #21922, improve testsuite for bufdatasets.
Joint patch of Lacak2, Ludo Brands & Reinier Olislagers
r21224 | marc | 2012-05-04 15:28:25 +0200 (Fri, 04 May 2012) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/base/dataset.inc

open lookup dataset before checking lookup fields (delphi compat)

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

marco 13 years ago
parent
commit
f7dffc86a7

+ 69 - 67
packages/fcl-db/src/base/bufdataset.pas

@@ -951,11 +951,14 @@ begin
       PCurRecLinkItem[DblLinkIndex.IndNr].next := PCurRecLinkItem[0].next;
       PCurRecLinkItem[DblLinkIndex.IndNr].prior := PCurRecLinkItem[0].prior;
       end;
-    end;
+    end
+  else
+    // Empty dataset
+    Exit;
 
 // Set FirstRecBuf and FCurrentRecBuf
   DblLinkIndex.FFirstRecBuf:=Index0.FFirstRecBuf;
-  (FCurrentIndex as TDoubleLinkedBufIndex).FCurrentRecBuf:=DblLinkIndex.FFirstRecBuf;
+  DblLinkIndex.FCurrentRecBuf:=DblLinkIndex.FFirstRecBuf;
 // Link in the FLastRecBuf that belongs to this index
   PCurRecLinkItem[DblLinkIndex.IndNr].next:=DblLinkIndex.FLastRecBuf;
   DblLinkIndex.FLastRecBuf[DblLinkIndex.IndNr].prior:=PCurRecLinkItem;
@@ -975,7 +978,7 @@ begin
 // of as we finish dealing with them.
 
   p := DblLinkIndex.FFirstRecBuf;
-  DblLinkIndex.ffirstRecBuf := nil;
+  DblLinkIndex.FFirstRecBuf := nil;
   q := p;
   MergeAmount := 0;
 
@@ -1079,7 +1082,7 @@ begin
   Result:= True;
 end;
 
-function TCustomBufDataset.intAllocRecordBuffer: TRecordBuffer;
+function TCustomBufDataset.IntAllocRecordBuffer: TRecordBuffer;
 begin
   // Note: Only the internal buffers of TDataset provide bookmark information
   result := AllocMem(FRecordsize+sizeof(TBufRecLinkItem)*FMaxIndexesCount);
@@ -1203,7 +1206,7 @@ procedure TCustomBufDataset.InternalLast;
 begin
   FetchAll;
   with FCurrentIndex do
-  SetToLastRecord;
+    SetToLastRecord;
 end;
 
 function TDoubleLinkedBufIndex.GetCurrentRecord: TRecordBuffer;
@@ -1362,6 +1365,7 @@ procedure TDoubleLinkedBufIndex.InitialiseSpareRecord(const ASpareRecord : TReco
 begin
   FFirstRecBuf := pointer(ASpareRecord);
   FLastRecBuf := FFirstRecBuf;
+  FLastRecBuf[IndNr].prior:=nil;
   FLastRecBuf[IndNr].next:=FLastRecBuf;
   FCurrentRecBuf := FLastRecBuf;
 end;
@@ -1728,7 +1732,7 @@ var x        : integer;
 
 begin
   if AFindNext then
-    StartBuf:=FCurrentUpdateBuffer+1
+    StartBuf := FCurrentUpdateBuffer + 1
   else
     StartBuf := 0;
   Result := False;
@@ -1767,14 +1771,11 @@ begin
     Result := grEOF;
     FAllPacketsFetched := True;
     // This code has to be placed elsewhere. At least it should also run when
-    // the datapacket is loaded from file
+    // the datapacket is loaded from file ... see IntLoadRecordsFromFile
     if FIndexesCount>0 then for x := 1 to FIndexesCount-1 do
       begin
       if not ((x=1) and (FIndexes[1].FieldsName='')) then
-        begin
         BuildIndex(FIndexes[x]);
-        (FCurrentIndex as TDoubleLinkedBufIndex).FCurrentRecBuf:=(FCurrentIndex as TDoubleLinkedBufIndex).FFirstRecBuf;
-        end;
       end;
     Exit;
     end;
@@ -1902,21 +1903,17 @@ begin
 end;
 
 procedure TCustomBufDataset.InternalDelete;
-var i         : Integer;
-    StartInd  : Integer;
-    RemRec    : pointer;
+var i : Integer;
+    RemRec, FreeRec : pointer;
     RemRecBookmrk : TBufBookmark;
-    free_rec: Boolean;
 begin
-  free_rec := False;
   InternalSetToRecord(ActiveBuffer);
   // Remove the record from all active indexes
   FCurrentIndex.StoreCurrentRecIntoBookmark(@RemRecBookmrk);
   RemRec := FCurrentIndex.CurrentBuffer;
-  FIndexes[0].RemoveRecordFromIndex(RemRecBookmrk);
-  if FCurrentIndex=FIndexes[1] then StartInd := 1 else StartInd := 2;
-  for i := StartInd to FIndexesCount-1 do
-    findexes[i].RemoveRecordFromIndex(RemRecBookmrk);
+  for i := 0 to FIndexesCount-1 do
+    if (i<>1) or (FIndexes[i]=FCurrentIndex) then
+      FIndexes[i].RemoveRecordFromIndex(RemRecBookmrk);
 
   if not GetActiveRecordUpdateBuffer then
     begin
@@ -1929,14 +1926,17 @@ begin
   else //with FIndexes[0] do
     begin
     if FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind <> ukModify then
+      begin
       FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer := nil;  //this 'disables' the updatebuffer
-    free_rec := FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind = ukInsert; // mantis #18004
+      FreeRec := RemRecBookmrk.BookmarkData;  // mantis #18004
+      FreeRecordBuffer(TRecordBuffer(FreeRec));
+      // RemRecBookmrk.BookmarkData still points to just freed record buffer
+      // There could be record in update-buffer, linked to this record
+      end;
     end;
   FCurrentIndex.StoreCurrentRecIntoBookmark(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData);
   FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData := RemRecBookmrk;
   FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind := ukDelete;
-  if free_rec then
-    FreeRecordBuffer(TRecordBuffer(RemRecBookmrk.BookmarkData));
   dec(FBRecordCount);
 end;
 
@@ -1954,7 +1954,6 @@ var StoreRecBM     : TBufBookmark;
     TmpBuf         : TRecordBuffer;
     StoreUpdBuf    : integer;
     Bm             : TBufBookmark;
-    x              : Integer;
   begin
     with AUpdBuffer do if assigned(BookmarkData.BookmarkData) then // this is used to exclude buffers which are already handled
       begin
@@ -2019,12 +2018,8 @@ begin
   if Length(FUpdateBuffer) > 0 then
     begin
     FCurrentIndex.StoreCurrentRecIntoBookmark(@StoreRecBM);
-    r := Length(FUpdateBuffer) -1;
-    while r > -1 do
-      begin
+    for r := Length(FUpdateBuffer) - 1 downto 0 do
       CancelUpdBuffer(FUpdateBuffer[r]);
-      dec(r)
-      end;
 
     SetLength(FUpdateBuffer,0);
     
@@ -2153,10 +2148,11 @@ end;
 
 procedure TCustomBufDataset.InternalPost;
 
-Var CurrBuff     :  TRecordBuffer;
+Var ABuff        : TRecordBuffer;
     i            : integer;
     blobbuf      : tbufblobfield;
     NullMask     : pbyte;
+    ABookmark    : PBufBookmark;
 
 begin
   inherited InternalPost;
@@ -2164,43 +2160,48 @@ begin
    if assigned(FUpdateBlobBuffers[i]) and (FUpdateBlobBuffers[i]^.FieldNo>0) then
     begin
     blobbuf.BlobBuffer := FUpdateBlobBuffers[i];
-    CurrBuff := ActiveBuffer;
-    NullMask := pbyte(CurrBuff);
+    ABuff := ActiveBuffer;
+    NullMask := PByte(ABuff);
 
-    inc(CurrBuff,FFieldBufPositions[FUpdateBlobBuffers[i]^.FieldNo-1]);
-    Move(blobbuf, CurrBuff^, GetFieldSize(FieldDefs[FUpdateBlobBuffers[i]^.FieldNo-1]));
+    inc(ABuff,FFieldBufPositions[FUpdateBlobBuffers[i]^.FieldNo-1]);
+    Move(blobbuf, ABuff^, GetFieldSize(FieldDefs[FUpdateBlobBuffers[i]^.FieldNo-1]));
     unSetFieldIsNull(NullMask,FUpdateBlobBuffers[i]^.FieldNo-1);
     
     FUpdateBlobBuffers[i]^.FieldNo := -1;
     end;
 
-  if state = dsInsert then
+  if State = dsInsert then
     begin
-    if GetBookmarkFlag(ActiveBuffer) = bfEOF then
-      FIndexes[0].ScrollLast
-    else
-      // The active buffer is the newly created TDataset record,
-      // from which the bookmark is set to the record where the new record should be
-      // inserted
-      InternalSetToRecord(ActiveBuffer);
-
-    with FIndexes[0] do
+    // The active buffer is the newly created TDataset record,
+    // from which the bookmark is set to the record where the new record should be
+    // inserted
+    ABookmark := PBufBookmark(ActiveBuffer + FRecordSize);
+    // Create the new record buffer
+    ABuff := IntAllocRecordBuffer;
+
+    // Add new record to all active indexes
+    for i := 0 to FIndexesCount-1 do
+      if (i<>1) or (FIndexes[i]=FCurrentIndex) then
       begin
-      // Create the new record buffer
-      FCurrentIndex.InsertRecordBeforeCurrentRecord(IntAllocRecordBuffer);
-      ScrollBackward;
-      // Add the record to the other indexes
-      for i := 1 to FIndexesCount-1 do if ((i>1) or (FIndexes[i]=FCurrentIndex)) then
-        FIndexes[i].InsertRecordBeforeCurrentRecord(CurrentRecord);
+        if ABookmark^.BookmarkFlag = bfEOF then
+          // append (at end)
+          FIndexes[i].ScrollLast
+        else
+          // insert (before current record)
+          FIndexes[i].GotoBookmark(ABookmark);
+
+        FIndexes[i].InsertRecordBeforeCurrentRecord(ABuff);
+        // new inserted record becomes current record
+        FIndexes[i].ScrollBackward;
       end;
 
     // Link the newly created record buffer to the newly created TDataset record
-    with PBufBookmark(ActiveBuffer + FRecordSize)^ do
+    with ABookmark^ do
       begin
       FCurrentIndex.StoreCurrentRecIntoBookmark(@BookmarkData);
       BookmarkFlag := bfInserted;
       end;
-      
+
     inc(FBRecordCount);
     end
   else
@@ -2541,23 +2542,23 @@ procedure TCustomBufDataset.GetDatasetPacket(AWriter: TDataPacketReader);
     else if AUpdBuffer.UpdateKind = ukDelete then
       begin
       AStoreUpdBuf:=FCurrentUpdateBuffer;
-      if GetRecordUpdateBuffer(AUpdBuffer.BookmarkData,True) then
+      if GetRecordUpdateBuffer(AUpdBuffer.BookmarkData,True,False) then
         begin
         repeat
-        if FCurrentIndex.CompareBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData, @AUpdBuffer.BookmarkData) then
-          StoreUpdateBuffer(FUpdateBuffer[FCurrentUpdateBuffer], ARowState);
+          if FCurrentIndex.CompareBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData, @AUpdBuffer.BookmarkData) then
+            StoreUpdateBuffer(FUpdateBuffer[FCurrentUpdateBuffer], ARowState);
         until not GetRecordUpdateBuffer(AUpdBuffer.BookmarkData,True,True)
         end;
       FCurrentUpdateBuffer:=AStoreUpdBuf;
       AThisRowState := [rsvDeleted];
       end
-    else // ie: updatekind = ukInsert
-      begin
+    else // ie: UpdateKind = ukInsert
       ARowState := [rsvInserted];
-      Exit;
-      end;
+
     FFilterBuffer:=AUpdBuffer.OldValuesBuffer;
-    FDatasetReader.StoreRecord(Self,AThisRowState,FCurrentUpdateBuffer);
+    // If the record is inserted or inserted and afterwards deleted then OldValuesBuffer is nil
+    if assigned(FFilterBuffer) then
+      FDatasetReader.StoreRecord(Self,AThisRowState,FCurrentUpdateBuffer);
   end;
 
   procedure HandleUpdateBuffersFromRecord(AFirstCall : boolean;ARecBookmark : TBufBookmark; var ARowState: TRowState);
@@ -2596,8 +2597,7 @@ begin
     ABookMark:=@ATBookmark;
     FDatasetReader.StoreFieldDefs(FieldDefs);
 
-    StoreDSState:=State;
-    SetTempState(dsFilter);
+    StoreDSState:=SetTempState(dsFilter);
     ScrollResult:=FCurrentIndex.ScrollFirst;
     while ScrollResult=grOK do
       begin
@@ -2795,7 +2795,7 @@ begin
           SetLength(FUpdateBuffer,AUpdOrder+1);
         FCurrentUpdateBuffer:=AUpdOrder;
         FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind:= ukInsert;
-        FCurrentIndex.StoreSpareRecIntoBookmark(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData);
+        FIndexes[0].StoreSpareRecIntoBookmark(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData);
         end;
 
       FIndexes[0].AddRecord;
@@ -2813,6 +2813,11 @@ begin
     FreeAndNil(FFileStream);
     FreeAndNil(FDatasetReader);
     end;
+
+  // rebuild indexes
+  for x:=1 to FIndexesCount-1 do
+    if (x<>1) or (FIndexes[x]=FCurrentIndex) then
+      BuildIndex(FIndexes[x]);
 end;
 
 procedure TCustomBufDataset.InternalAddIndex(const AName, AFields : string; AOptions : TIndexOptions; const ADescFields: string;
@@ -2845,9 +2850,7 @@ begin
 
   if Active then
     begin
-    (FIndexes[FIndexesCount-1] as TDoubleLinkedBufIndex).FFirstRecBuf := pointer(IntAllocRecordBuffer);
-    (FIndexes[FIndexesCount-1] as TDoubleLinkedBufIndex).FLastRecBuf := (FIndexes[FIndexesCount-1] as TDoubleLinkedBufIndex).FFirstRecBuf;
-    (FCurrentIndex as TDoubleLinkedBufIndex).FCurrentRecBuf := (FIndexes[FIndexesCount-1] as TDoubleLinkedBufIndex).FLastRecBuf;
+    FIndexes[FIndexesCount-1].InitialiseSpareRecord(IntAllocRecordBuffer);
     BuildIndex(FIndexes[FIndexesCount-1]);
     end
   else if FIndexesCount>FMaxIndexesCount then
@@ -3026,9 +3029,8 @@ begin
   end;
 
   // Set The filter-buffer
-  StoreDSState:=State;
+  StoreDSState:=SetTempState(dsFilter);
   FFilterBuffer:=FCurrentIndex.SpareBuffer;
-  SetTempState(dsFilter);
   SetFieldValues(keyfields,KeyValues);
   CurrLinkItem := (FCurrentIndex as TDoubleLinkedBufIndex).FFirstRecBuf;
   FilterBuffer:=IntAllocRecordBuffer;

+ 1 - 0
packages/fcl-db/src/base/dataset.inc

@@ -107,6 +107,7 @@ begin
                (FLookupResultField = '') or (FKeyFields = '')) then
               DatabaseErrorFmt(SLookupInfoError, [DisplayName]);
             FFields.CheckFieldNames(FKeyFields);
+            FLookupDataSet.Open;
             FLookupDataSet.Fields.CheckFieldNames(FLookupKeyFields);
             FLookupDataSet.FieldByName(FLookupResultField);
             if FLookupCache then RefreshLookupList;

+ 2 - 0
packages/fcl-db/src/base/datasource.inc

@@ -245,6 +245,8 @@ end;
 Procedure TDataLink.SetDataSource(Value : TDatasource);
 
 begin
+  if FDataSource = Value then
+    Exit;
   if not FDataSourceFixed then
     begin
     if Assigned(DataSource) then

+ 0 - 15
packages/fcl-db/src/base/db.pas

@@ -991,7 +991,6 @@ type
   public
     constructor Create(Owner: TIndexDefs; const AName, TheFields: string;
       TheOptions: TIndexOptions); overload;
-    destructor Destroy; override;
     property Expression: string read GetExpression write SetExpression;
     property Fields: string read FFields write FFields;
     property CaseInsFields: string read FCaseinsFields write SetCaseInsFields;
@@ -1008,7 +1007,6 @@ type
     Procedure SetItem(Index: Integer; Value: TIndexDef);
   public
     constructor Create(ADataSet: TDataSet); virtual; overload;
-    destructor Destroy; override;
     procedure Add(const Name, Fields: string; Options: TIndexOptions);
     Function AddIndexDef: TIndexDef;
     function Find(const IndexName: string): TIndexDef;
@@ -2305,13 +2303,6 @@ begin
 end;
 
 
-destructor TIndexDef.Destroy;
-
-begin
-  inherited Destroy;
-end;
-
-
 { TIndexDefs }
 
 Function TIndexDefs.GetItem (Index : integer) : TIndexDef;
@@ -2332,12 +2323,6 @@ begin
 end;
 
 
-destructor TIndexDefs.Destroy;
-
-begin
-  inherited Destroy;
-end;
-
 Function TIndexDefs.AddIndexDef: TIndexDef;
 
 begin

+ 6 - 1
packages/fcl-db/src/base/fields.inc

@@ -1752,7 +1752,12 @@ end;
 Procedure TAutoIncField.SetAsLongint(AValue : Longint);
 
 begin
-  DataBaseError(SCantSetAutoIncfields);
+  // Some databases allows insertion of explicit values into identity columns
+  // (some of them also allows (some not) updating identity columns)
+  // So allow it at client side and leave check for server side
+  if not(FDataSet.State in [dsFilter,dsSetKey,dsInsert]) then
+    DataBaseError(SCantSetAutoIncFields);
+  inherited;
 end;
 
 { TFloatField }

+ 33 - 15
packages/fcl-db/src/sqldb/sqldb.pp

@@ -36,7 +36,7 @@ type
   TSQLScript = class;
 
 
-  TStatementType = (stNone, stSelect, stInsert, stUpdate, stDelete,
+  TStatementType = (stUnknown, stSelect, stInsert, stUpdate, stDelete,
     stDDL, stGetSegment, stPutSegment, stExecProcedure,
     stStartTrans, stCommit, stRollback, stSelectForUpd);
 
@@ -63,7 +63,7 @@ const
   SingleQuotes : TQuoteChars = ('''','''');
   DoubleQuotes : TQuoteChars = ('"','"');
   LogAllEvents = [detCustom, detPrepare, detExecute, detFetch, detCommit, detRollBack];
-  StatementTokens : Array[TStatementType] of string = ('(none)', 'select',
+  StatementTokens : Array[TStatementType] of string = ('(unknown)', 'select',
                   'insert', 'update', 'delete',
                   'create', 'get', 'put', 'execute',
                   'start','commit','rollback', '?'
@@ -542,9 +542,10 @@ var T : TStatementType;
 
 begin
   S:=Lowercase(s);
-  For t:=stselect to strollback do
-    if (S=StatementTokens[t]) then
-      Exit(t);
+  for T:=stSelect to stRollback do
+    if (S=StatementTokens[T]) then
+      Exit(T);
+  Result:=stUnknown;
 end;
 
 procedure TSQLConnection.SetTransaction(Value : TSQLTransaction);
@@ -621,7 +622,7 @@ begin
       DatabaseError(SErrNoStatement);
 
     Cursor := AllocateCursorHandle;
-    Cursor.FStatementType := stNone;
+    Cursor.FStatementType := stUnknown;
     PrepareStatement(cursor,ATransaction,SQL,Nil);
     execute(cursor,ATransaction, Nil);
     UnPrepareStatement(Cursor);
@@ -1218,7 +1219,7 @@ end;
 
 function TCustomSQLQuery.SQLParser(const ASQL : string) : TStatementType;
 
-type TParsePart = (ppStart,ppSelect,ppWhere,ppFrom,ppOrder,ppComment,ppGroup,ppBogus);
+type TParsePart = (ppStart,ppWith,ppSelect,ppFrom,ppWhere,ppGroup,ppOrder,ppComment,ppBogus);
 
 Var
   PSQL,CurrentP,
@@ -1248,13 +1249,13 @@ begin
     begin
     inc(CurrentP);
 
-    EndOfComment := SkipComments(CurrentP,sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions);
-    if EndOfcomment then dec(currentp);
+    EndOfComment := SkipComments(CurrentP, sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions);
+    if EndOfcomment then dec(CurrentP);
     if EndOfComment and (ParsePart = ppStart) then PhraseP := CurrentP;
 
     // skip everything between bracket, since it could be a sub-select, and
     // further nothing between brackets could be interesting for the parser.
-    if currentp^='(' then
+    if CurrentP^='(' then
       begin
       inc(currentp);
       BracketCount := 0;
@@ -1279,10 +1280,25 @@ begin
         case ParsePart of
           ppStart  : begin
                      Result := TSQLConnection(Database).StrToStatementType(s);
-                     if s = 'SELECT' then ParsePart := ppSelect else break;
+                     case s of
+                       'WITH'  : ParsePart := ppWith;
+                       'SELECT': ParsePart := ppSelect;
+                       else      break;
+                     end;
                      if not FParseSQL then break;
                      PStatementPart := CurrentP;
                      end;
+          ppWith   : begin
+                     // WITH [RECURSIVE] CTE_name [ ( column_names ) ] AS ( CTE_query_definition ) [, ...]
+                     //  { SELECT | INSERT | UPDATE | DELETE } ...
+                     case s of
+                       'SELECT': Result := stSelect;
+                       'INSERT': Result := stInsert;
+                       'UPDATE': Result := stUpdate;
+                       'DELETE': Result := stDelete;
+                     end;
+                     if Result <> stUnknown then break;
+                     end;
           ppSelect : begin
                      if s = 'FROM' then
                        begin
@@ -1323,7 +1339,7 @@ begin
                          begin
                          Setlength(FFromPart,StrLength);
                          Move(PStatementPart^,FFromPart[1],(StrLength));
-                         FFrompart := trim(FFrompart);
+                         FFromPart := trim(FFromPart);
 
                          // Meta-data requests and are never updateable select-statements
                          // from more then one table are not updateable
@@ -1749,8 +1765,10 @@ end;
 function TCustomSQLQuery.GetStatementType : TStatementType;
 
 begin
-  if assigned(FCursor) then Result := FCursor.FStatementType
-    else Result := stNone;
+  if assigned(FCursor) then
+    Result := FCursor.FStatementType
+  else
+    Result := stUnknown;
 end;
 
 procedure TCustomSQLQuery.SetDeleteSQL(const AValue: TStringlist);
@@ -1996,7 +2014,7 @@ begin
   inherited DoInternalConnect;
   CreateProxy;
   FProxy.CharSet:=Self.CharSet;
-  FProxy.Role:=self.Role;
+  FProxy.Role:=Self.Role;
   FProxy.DatabaseName:=Self.DatabaseName;
   FProxy.HostName:=Self.HostName;
   FProxy.UserName:=Self.UserName;

+ 21 - 9
packages/fcl-db/tests/README.txt

@@ -1,12 +1,13 @@
 This directory contains a framework to test several TDataset descendents.
+A lot of these tests are only applicable for SQL databases, but there are several tests that also apply to other objects, such as TBufDataset.
 
-The framework is based on the fpcunit unit-test system. The tests can be
+The framework is based on the fpcunit unit test system. The tests can be
 executed using any fpcunit-testrunner. For example the console and graphical
-fpcunit-test runners from Lazarus.
+fpcunit test runners from Lazarus.
 Simply add the test* units in this directory to the uses statement of the
-test-runner and all tests will get registered and executed.
+test runner and all tests will get registered and executed.
 
-An simple test-runner (dbtestframework.pas) which generates XML-output is
+A simple test runner (dbtestframework.pas) which generates XML output is
 included in this directory.
 
 To test a TDataset descendent, a 'connector' is needed to test the database.
@@ -14,14 +15,25 @@ To add a new connector, create a new *toolsunit.pas file, then add it to
 the uses section in 'dbtestframework.pas'. Several connectors are available 
 in the '*toolsunit.pas' files.
 
-Which connector is currently used is dependent on the 'database.ini'
-configuration file. Also some settings which are connector-dependent can be set
-in that file. See 'database.ini.txt' for an example.
+The connector must inherit from TDBConnector in toolsunit.pas.
+The connector implements two different kinds of datasets: 
+- a dataset with as many different kinds of fields as possible (see the *FieldDataSets subroutines).
+- a dataset with only a few fields (ID and NAME), but a lot (well, MaxDataset) of different records (see the *NDataSets subroutines)
 
-I hope this is enough information to get you started,
+CreateNDatasets and CreateFieldDataset should be implemented to set up data stores (e.g. database tables) and fill these stores with test data for the respective datasets.
+The corresponding Drop*Dataset procedures must drop the tables/delete the data.
 
-Joost van der Sluis (30-12-2006)
+GetNDataset and GetFieldsDataset should return the relevant dataset in closed state so the tests can open them and work with them.
+They call InternalGetNDataset and InternalGetFieldDataset which should be implemented in all descendents and returns the relevant dataset, closed, with all data.
 
+Toolsunit.pas defines some variables for use, e.g. testValuesCount is the number of records/test values in the FieldDataset dataset; MaxDataset is the same for NDataset.
+See e.g. the SQLDBToolsUnit for the implementation for SQL Databases.
 
+Which connector is currently used is dependent on the 'database.ini'
+configuration file. Also some settings which are connector-dependent can be set
+in that file. See 'database.ini.txt' for an example.
 
+I hope this is enough information to get you started,
 
+Joost van der Sluis (30-12-2006), 
+amended by Reinier Olislagers (April 2012)

+ 74 - 20
packages/fcl-db/tests/bufdatasettoolsunit.pas

@@ -1,5 +1,12 @@
 unit BufDatasetToolsUnit;
 
+{ Sets up bufdataset for testing.
+Tests expect Get*Dataset tho return a dataset with structure and test data, but closed.
+A closed BufDataset normally has no data, so these tests won't work.
+
+To circumvent this, this unit saves the dataset contents to file and reloads them on opening using BufDataset persistence mechanism.
+
+}
 {$mode objfpc}{$H+}
 
 interface
@@ -11,46 +18,73 @@ uses
 
 type
 { TbufdatasetConnector }
+
+  { TbufdatasetDBConnector }
+
   TbufdatasetDBConnector = class(TDBConnector)
-  protected
+  private
+    FUniDirectional: boolean;
+   protected
     procedure CreateNDatasets; override;
     procedure CreateFieldDataset; override;
     procedure DropNDatasets; override;
     procedure DropFieldDataset; override;
     Function InternalGetNDataset(n : integer) : TDataset; override;
     Function InternalGetFieldDataset : TDataSet; override;
+    procedure SetTestUniDirectional(const AValue: boolean); override;
+    function GetTestUniDirectional: boolean; override;
   end;
 
 implementation
 
+type
+
+  { TPersistentBufDataSet }
+
+  TPersistentBufDataSet=class(TBufDataset)
+    private
+      TempFileName:string;
+    public
+      destructor Destroy; override;
+  end;
+
+{ TPersistentBufDataSet }
+
+destructor TPersistentBufDataSet.Destroy;
+begin
+  Close; // no locks on TempFileName
+  DeleteFile(TempFileName);
+  inherited Destroy;
+end;
+
 { TbufdatasetDBConnector }
 
 procedure TbufdatasetDBConnector.CreateNDatasets;
 begin
-// All datasets only exist in memory, so nothing has to be done
+// All datasets are created in InternalGet*Dataset
 end;
 
 procedure TbufdatasetDBConnector.CreateFieldDataset;
 begin
-// All datasets only exist in memory, so nothing has to be done
+  // All datasets are created in InternalGet*Dataset
 end;
 
 procedure TbufdatasetDBConnector.DropNDatasets;
 begin
-// All datasets only exist in memory, so nothing has to be done
+  // All datasets are created in InternalGet*Dataset and cleaned up when destroyed
 end;
 
 procedure TbufdatasetDBConnector.DropFieldDataset;
 begin
-// All datasets only exist in memory, so nothing has to be done
+  // All datasets are created in InternalGet*Dataset and cleaned up when destroyed
 end;
 
 function TbufdatasetDBConnector.InternalGetNDataset(n: integer): TDataset;
-var BufDataset  : TBufDataset;
+var BufDataset  : TPersistentBufDataSet;
     i      : integer;
 
 begin
-  BufDataset := TBufDataset.Create(nil);
+  BufDataset := TPersistentBufDataSet.Create(nil);
   BufDataset.FieldDefs.Add('ID',ftInteger);
   BufDataset.FieldDefs.Add('NAME',ftString,50);
   BufDataset.CreateDataset;
@@ -62,31 +96,37 @@ begin
     BufDataset.FieldByName('NAME').AsString := 'TestName' + inttostr(i);
     BufDataset.Post;
     end;
-  BufDataset.Close;
+  BufDataset.TempFileName:=GetTempFileName;
+  BufDataset.FileName:=BufDataset.TempFileName;
+  BufDataset.Close; // Save data into file
   Result := BufDataset;
 end;
 
 function TbufdatasetDBConnector.InternalGetFieldDataset : TDataSet;
 
 
-var BufDataset  : TBufDataset;
+var BufDataset  : TPersistentBufDataSet;
     i      : integer;
 
 begin
-  BufDataset := TBufDataset.Create(nil);
+  // Values >= 24:00:00.000 can't be handled by bufdataset
+  testTimeValues[2] := '23:59:59.000';
+  testTimeValues[3] := '23:59:59.003';
+
+  BufDataset := TPersistentBufDataSet.Create(nil);
   with BufDataset do
     begin
-    //todo: this is based on memds.
-    //check and add bufdataset supported fields
+    UniDirectional := FUniDirectional;
     FieldDefs.Add('ID',ftInteger);
     FieldDefs.Add('FSTRING',ftString,10);
     FieldDefs.Add('FSMALLINT',ftSmallint);
     FieldDefs.Add('FINTEGER',ftInteger);
-//    FieldDefs.Add('FWORD',ftWord);
+    // Not supported by BufDataset:
+    // FieldDefs.Add('FWORD',ftWord);
     FieldDefs.Add('FBOOLEAN',ftBoolean);
     FieldDefs.Add('FFLOAT',ftFloat);
-//    FieldDefs.Add('FCURRENCY',ftCurrency);
-//    FieldDefs.Add('FBCD',ftBCD);
+    FieldDefs.Add('FCURRENCY',ftCurrency);
+    FieldDefs.Add('FBCD',ftBCD);
     FieldDefs.Add('FDATE',ftDate);
     FieldDefs.Add('FTIME',ftTime);
     FieldDefs.Add('FDATETIME',ftDateTime);
@@ -94,7 +134,7 @@ begin
     CreateDataset;
     Open;
     for i := 0 to testValuesCount-1 do
-      begin
+    begin
       Append;
       FieldByName('ID').AsInteger := i;
       FieldByName('FSTRING').AsString := testStringValues[i];
@@ -102,16 +142,30 @@ begin
       FieldByName('FINTEGER').AsInteger := testIntValues[i];
       FieldByName('FBOOLEAN').AsBoolean := testBooleanValues[i];
       FieldByName('FFLOAT').AsFloat := testFloatValues[i];
-      ShortDateFormat := 'yyyy-mm-dd';
-      FieldByName('FDATE').AsDateTime := StrToDate(testDateValues[i]);
+      FieldByName('FCURRENCY').AsCurrency := testCurrencyValues[i];
+      FieldByName('FBCD').AsCurrency := testCurrencyValues[i];
+      FieldByName('FDATE').AsDateTime := StrToDateTime(testDateValues[i], Self.FormatSettings);
+      FieldByName('FTIME').AsDateTime := StrToTime(testTimeValues[i], Self.FormatSettings);
       FieldByName('FLARGEINT').AsLargeInt := testLargeIntValues[i];
       Post;
-      end;
-    Close;
+    end;
+    BufDataset.TempFileName:=GetTempFileName;
+    BufDataset.FileName:=BufDataset.TempFileName;
+    Close; // Save data into file
     end;
   Result := BufDataset;
 end;
 
+procedure TbufdatasetDBConnector.SetTestUniDirectional(const AValue: boolean);
+begin
+  FUniDirectional := AValue;
+end;
+
+function TbufdatasetDBConnector.GetTestUniDirectional: boolean;
+begin
+  Result := FUniDirectional;
+end;
+
 initialization
   RegisterClass(TbufdatasetDBConnector);
 end.

+ 42 - 5
packages/fcl-db/tests/testbufdatasetstreams.pas

@@ -22,6 +22,7 @@ type
 
     procedure TestChangesApplyUpdates(AUpdDatasetProc : TUpdDatasetProc; Inserts: Boolean=False);
     procedure TestChangesCancelUpdates(AUpdDatasetProc : TUpdDatasetProc);
+    procedure TestChanges(AUpdDatasetProc : TUpdDatasetProc; AFormat : TDataPacketFormat=dfBinary);
     procedure TestChangesXML(AUpdDatasetProc : TUpdDatasetProc);
 
     procedure SimpleEditChange(ADataset: TCustomBufDataset);
@@ -34,6 +35,7 @@ type
     procedure DeleteAllInsertChange(ADataset: TCustomBufDataset);
     procedure NullInsertChange(ADataset: TCustomBufDataset);
     procedure NullEditChange(ADataset: TCustomBufDataset);
+    procedure AppendDeleteChange(ADataset: TCustomBufDataset);
   protected
     procedure SetUp; override;
     procedure TearDown; override;
@@ -67,6 +69,8 @@ type
     procedure TestDeleteAllXML;
     procedure TestDeleteAllInsertXML;
 
+    procedure TestAppendDeleteBIN;
+
     procedure TestFileNameProperty;
     procedure TestCloseDatasetNoConnection; // bug 17623
   end;
@@ -129,27 +133,42 @@ begin
   CompareDatasets(OrgDs,ChangedDs);
 end;
 
-procedure TTestBufDatasetStreams.TestChangesXML(AUpdDatasetProc: TUpdDatasetProc);
-var SaveDs,
+procedure TTestBufDatasetStreams.TestChanges(AUpdDatasetProc: TUpdDatasetProc;
+  AFormat: TDataPacketFormat);
+var FileName: string;
+    SaveDs,
     LoadDs : TCustomBufDataset;
 begin
+  case AFormat of
+    dfBinary:  FileName := 'Basics.dat';
+    else       FileName := 'Basics.xml';
+  end;
+
   SaveDs := DBConnector.GetNDataset(true,15) as TCustomBufDataset;
   SaveDs.Open;
   AUpdDatasetProc(SaveDs);
-  SaveDs.SaveToFile('Basics.xml',dfXML);
+  SaveDs.SaveToFile(FileName, AFormat);
 
   LoadDs := TCustomBufDataset.Create(nil);
-  LoadDs.LoadFromFile('Basics.xml');
-
+  LoadDs.LoadFromFile(FileName);
   CompareDatasets(SaveDs,LoadDs);
   SaveDs.Close;
 
   SaveDs.Open;
   LoadDs.CancelUpdates;
   CompareDatasets(SaveDs,LoadDs);
+  SaveDs.Close;
+
   LoadDs.Free;
+  DeleteFile(FileName);
+end;
+
+procedure TTestBufDatasetStreams.TestChangesXML(AUpdDatasetProc: TUpdDatasetProc);
+begin
+  TestChanges(AUpdDatasetProc, dfXML);
 end;
 
+
 procedure TTestBufDatasetStreams.SimpleEditChange(ADataset: TCustomBufDataset);
 begin
   ADataset.next;
@@ -317,6 +336,19 @@ begin
     end;
 end;
 
+procedure TTestBufDatasetStreams.AppendDeleteChange(ADataset: TCustomBufDataset);
+begin
+  with ADataset do
+  begin
+    AppendRecord([16,'TestName16']);
+    AppendRecord([17,'TestName17']);
+    Prior;
+    Prior;
+    Delete;  // 15 update-buffer of deleted record is linked to 16
+    Delete;  // 16 inserted-deleted and linked by 15
+  end;
+end;
+
 procedure TTestBufDatasetStreams.TestSimpleEditCancelUpd;
 begin
   TestChangesCancelUpdates(@SimpleEditChange);
@@ -411,6 +443,11 @@ begin
   TestChangesXML(@DeleteAllInsertChange);
 end;
 
+procedure TTestBufDatasetStreams.TestAppendDeleteBIN;
+begin
+  TestChanges(@AppendDeleteChange);
+end;
+
 procedure TTestBufDatasetStreams.TestFileNameProperty;
 var ds    : TDataset;
     LoadDs: TDataset;

+ 70 - 4
packages/fcl-db/tests/testdbbasics.pas

@@ -104,6 +104,7 @@ type
 
     procedure TestAddDblIndex;
     procedure TestIndexEditRecord;
+    procedure TestIndexAppendRecord;
   end;
 
 {$endif fpc}
@@ -1652,10 +1653,11 @@ begin
     first;
     ds.IndexName:='test';
     first;
-    LastValue:=FieldByName('name').AsString;
+    LastValue:='';
     while not eof do
       begin
       CheckTrue(AnsiCompareStr(LastValue,FieldByName('name').AsString)<=0);
+      LastValue:=FieldByName('name').AsString;
       Next;
       end;
     end;
@@ -1851,14 +1853,77 @@ begin
     FieldByName('F'+FieldTypeNames[AfieldType]).AsString := 'ZZZ';
     post;
     prior;
-    CheckTrue(AnsiCompareStr('ZZZ',FieldByName('F'+FieldTypeNames[AfieldType]).AsString)>=0);
+    CheckTrue(AnsiCompareStr('ZZZ',FieldByName('F'+FieldTypeNames[AfieldType]).AsString)>=0, 'Prior>');
     next;
     next;
-    CheckTrue(AnsiCompareStr('ZZZ',FieldByName('F'+FieldTypeNames[AfieldType]).AsString)<=0);
+    CheckTrue(AnsiCompareStr('ZZZ',FieldByName('F'+FieldTypeNames[AfieldType]).AsString)<=0, 'Next<');
     close;
     end;
 end;
 
+procedure TTestBufDatasetDBBasics.TestIndexAppendRecord;
+var i: integer;
+    LastValue: string;
+begin
+  with DBConnector.GetNDataset(true,0) as TCustomBufDataset do
+  begin
+    MaxIndexesCount:=4;
+    // add index to closed dataset with no data
+    AddIndex('testindex','NAME',[]);
+    IndexName:='testindex';
+    Open;
+    // empty dataset and other than default index (default_order) active
+    CheckTrue(BOF, 'No BOF when opening empty dataset');
+    CheckTrue(EOF, 'No EOF when opening empty dataset');
+
+    // append data at end
+    for i:=20 downto 0 do
+      AppendRecord([i, inttostr(i)]);
+    First;
+    // insert data at begining
+    for i:=21 to 22 do
+      InsertRecord([i, inttostr(i)]);
+
+    // ATM new records are not ordered as they are added ?
+    LastValue := '';
+    First;
+    for i:=22 downto 0 do
+    begin
+      CheckEquals(23-i, RecNo, 'testindex.RecNo:');
+      CheckEquals(inttostr(i), Fields[1].AsString, 'testindex.Fields[1].Value:');
+      //CheckTrue(AnsiCompareStr(LastValue,Fields[1].AsString) < 0, 'testindex.LastValue>CurrValue');
+      LastValue := Fields[1].AsString;
+      Next;
+    end;
+    CheckTrue(EOF, 'testindex.No EOF after last record');
+
+    // switch back to default index (unordered)
+    IndexName:='';
+    First;
+    for i:=22 downto 0 do
+    begin
+      CheckEquals(23-i, RecNo, 'index[0].RecNo:');
+      CheckEquals(i, Fields[0].AsInteger, 'index[0].Fields[0].Value:');
+      Next;
+    end;
+    CheckTrue(EOF, 'index[0].No EOF after last record');
+
+    // add index to opened dataset with data
+    AddIndex('testindex2','ID',[]);
+    IndexName:='testindex2';
+    First;
+    for i:=0 to 22 do
+    begin
+      CheckEquals(1+i, RecNo, 'index2.RecNo:');
+      CheckEquals(i, Fields[0].AsInteger, 'index2.Fields[0].Value:');
+      Next;
+    end;
+    CheckTrue(EOF, 'index2.No EOF after last record');
+
+    Close;
+  end;
+end;
+
 procedure TTestBufDatasetDBBasics.TestIndexFieldNames;
 var ds : TCustomBufDataset;
     AFieldType : TFieldType;
@@ -2361,7 +2426,8 @@ initialization
   RegisterTestDecorator(TDBBasicsTestSetup, TTestDBBasics);
   RegisterTestDecorator(TDBBasicsTestSetup, TTestCursorDBBasics);
 
-  if uppercase(dbconnectorname)='SQL' then
+  // The SQL connectors are descendents of bufdataset and therefore benefit from testing:
+  if (uppercase(dbconnectorname)='SQL') or (uppercase(dbconnectorname)='BUFDATASET') then
     begin
     RegisterTestDecorator(TDBBasicsTestSetup, TTestBufDatasetDBBasics);
     RegisterTestDecorator(TDBBasicsUniDirectionalTestSetup, TTestUniDirectionalDBBasics);

+ 53 - 11
packages/fcl-db/tests/testfieldtypes.pas

@@ -61,6 +61,7 @@ type
     procedure TestScript;
     procedure TestInsertReturningQuery;
     procedure TestOpenStoredProc;
+    procedure TestOpenSpecialStatements;
 
     procedure TestTemporaryTable;
     procedure TestRefresh;
@@ -608,25 +609,25 @@ const
     '2000-01-01 10:00:00',
     '2000-01-01 23:59:59',
     '1994-03-06 11:54:30',
-    '1754-06-04',                   // MySQL 4.0 doesn't support datetimes before 1970 or after 2038
-    '1899-12-29',
-    '1899-12-30',
-    '1899-12-31',
+    '2040-10-16',                   // MySQL 4.0 doesn't support datetimes before 1970 or after 2038
+    '2100-01-01 01:01:01',
+    '1903-04-02 01:04:02',
     '1900-01-01',
+    '1899-12-31',
+    '1899-12-30',
+    '1899-12-29',
     '1899-12-30 18:00:51',
     '1899-12-30 04:00:51',
     '1899-12-29 04:00:51',
     '1899-12-29 18:00:51',
-    '1903-04-02 01:04:02',
     '1815-09-24 03:47:22',
-    '2040-10-16',
-    '2100-01-01 01:01:01',
-    '1400-02-03 12:21:53',          // MS SQL 2005 doesn't support datetimes before 1753
-    '0354-11-20 21:25:15',
-    '1333-02-03 21:44:21',
     '1800-03-30',
-    '1650-05-10',
+    '1754-06-04',
+    '1650-05-10',                   // MS SQL 2005 doesn't support datetimes before 1753
+    '1400-02-03 12:21:53',
+    '1333-02-03 21:44:21',
     '0904-04-12',
+    '0354-11-20 21:25:15',
     '0199-07-09',
     '0001-01-01'
   );
@@ -1270,6 +1271,47 @@ begin
   end;
 end;
 
+procedure TTestFieldTypes.TestOpenSpecialStatements;
+const CTE_SELECT = 'WITH a AS (SELECT * FROM FPDEV) SELECT * FROM a';
+type TTestStatements = array of string;
+var statements: TTestStatements;
+    s: string;
+begin
+  // tests non-select statements (other than "SELECT ..."), which return result-set
+  // at least one row must be returned
+  with TSQLDBConnector(DBConnector) do
+  begin
+    case SQLDbType of
+      sqlite3:
+        statements := TTestStatements.Create('pragma table_info(FPDEV)');
+      interbase:
+        statements := TTestStatements.Create(CTE_SELECT (*FB 2.1*));
+      postgresql:
+        statements := TTestStatements.Create(CTE_SELECT);
+      mssql:
+        statements := TTestStatements.Create(CTE_SELECT  (*MS SQL 2005*));
+      else
+        if SQLdbType in MySQLdbTypes then
+          statements := TTestStatements.Create(
+            'check table FPDEV',  // bug 14519
+            'show tables from '+Connection.DatabaseName  // bug 16842
+          )
+        else
+          Ignore(STestNotApplicable);
+    end;
+
+    for s in statements do
+    begin
+      Query.SQL.Text := s;
+      Query.Open;
+      AssertTrue(Query.FieldCount>0);
+      AssertFalse('Eof after open', Query.Eof);
+      Query.Next;
+      Query.Close;
+    end;
+  end;
+end;
+
 procedure TTestFieldTypes.TestClearUpdateableStatus;
 // Test if CanModify is correctly disabled in case of a select query without
 // a from-statement.

+ 12 - 8
packages/fcl-db/tests/toolsunit.pas

@@ -8,7 +8,9 @@ interface
 
 uses
   Classes, SysUtils, DB, testdecorator;
-  
+
+// Number of "N" test datasets (as opposed to FieldDatasets) that will be created
+// The connectors should have these records prepared in their Create*Dataset procedures.
 Const MaxDataSet = 35;
   
 type
@@ -24,14 +26,16 @@ type
      protected
        procedure SetTestUniDirectional(const AValue: boolean); virtual;
        function GetTestUniDirectional: boolean; virtual;
-       // These methods should be implemented by any descendents
-       // They are called eacht time a test need a TDataset descendent
+       // These methods should be implemented by all descendents
+       // They are called each time a test needs a TDataset descendent
+       // n: the dataset index to return (also number of records in set)
+       // Presupposes that Create*Dataset(s) has been called already.
        Function InternalGetNDataset(n : integer) : TDataset;  virtual; abstract;
        Function InternalGetFieldDataset : TDataSet; virtual; abstract;
 
-       // These methods should be implemented by any descendents
-       // They are called only once in the constructor. They can be used
-       // to create the tables on disk, or on a DB-Server
+       // These methods should be implemented by all descendents
+       // They are called e.g. in the constructor. They can be used
+       // to create the tables on disk, or on a DB server
        procedure CreateNDatasets; virtual; abstract;
        procedure CreateFieldDataset; virtual; abstract;
 
@@ -41,8 +45,8 @@ type
        procedure ResetNDatasets; virtual;
        procedure ResetFieldDataset; virtual;
        
-       // These methods are called only once in the destructor.
-       // They should clean up all mess, like tables on disk or on a DB-server
+       // These methods are called e.g. in the destructor.
+       // They should clean up all mess, like tables on disk or on a DB server
        procedure DropNDatasets; virtual; abstract;
        procedure DropFieldDataset; virtual; abstract;
      public