Improved working with stand-alone TBufDataset:

 * Added tests
 * Raise exception when trying to refresh data when there are updates
 * CreateDataset now also creates a dataset based on the fields when there
   are no fielddefs available.

git-svn-id: trunk@20940 -

.gitattributes

@@ -2038,6 +2038,7 @@ packages/fcl-db/tests/testdbbasics.pas 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/testjsondataset.pp svneol=native#text/plain
+packages/fcl-db/tests/testspecifictbufdataset.pas 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/testsqlscanner.lpi svneol=native#text/plain

packages/fcl-db/src/base/bufdataset.pas

@@ -495,6 +495,7 @@ type
     procedure DataEvent(Event: TDataEvent; Info: Ptrint); override;
     procedure BeforeRefreshOpenCursor; virtual;
     procedure DoFilterRecord(out Acceptable: Boolean); virtual;
+    procedure CreateFieldDefs; virtual;
   {abstracts, must be overidden by descendents}
     function Fetch : boolean; virtual;
     function LoadField(FieldDef : TFieldDef;buffer : pointer; out CreateBlob : boolean) : boolean; virtual;
@@ -2683,7 +2684,24 @@ end;
 procedure TCustomBufDataset.CreateDataset;
 begin
   CheckInactive;
-  CreateFields;
+  if not ((FieldCount=0) or (FieldDefs.Count=0)) then
+    begin
+    Open;
+    Exit;
+    end;
+  if (FieldDefs.Count>0) then
+    begin
+    CreateFields;
+    Open;
+    end
+  else if (fields.Count>0) then
+    begin
+    CreateFieldDefs;
+    BindFields(True);
+    Open;
+    end
+  else
+    raise Exception.Create(SErrNoFieldsDefined);
 end;
 
 function TCustomBufDataset.BookmarkValid(ABookmark: TBookmark): Boolean;
@@ -2866,6 +2884,17 @@ begin
     Acceptable := Boolean((FParser.ExtractFromBuffer(GetCurrentBuffer))^);
 end;
 
+procedure TCustomBufDataset.CreateFieldDefs;
+
+Var
+  I : longint;
+  FieldDef: TFieldDef;
+begin
+  For I:=0 to FieldCount-1 do
+    with Fields.Fields[I] do if FieldKind=fkData then
+      FieldDefs.Add(FieldName,DataType,Size,Required);
+end;
+
 procedure TCustomBufDataset.SetFilterText(const Value: String);
 begin
   if Value = Filter then
@@ -2897,6 +2926,8 @@ end;
 procedure TCustomBufDataset.InternalRefresh;
 var StoreDefaultFields: boolean;
 begin
+  if length(FUpdateBuffer)>0 then
+    DatabaseError(SErrApplyUpdBeforeRefresh);
   StoreDefaultFields:=DefaultFields;
   SetDefaultFields(False);
   FreeFieldBuffers;

packages/fcl-db/src/base/dbconst.pas

@@ -109,6 +109,8 @@ Resourcestring
   SRollingBack             = 'Rolling back transaction';
   SCommitRetaining         = 'Commit and retaining transaction';
   SRollBackRetaining       = 'Rollback and retaining transaction';
+  SErrNoFieldsDefined      = 'Can not create a dataset when there are no fielddefinitions or fields defined';
+  SErrApplyUpdBeforeRefresh= 'Must apply updates before refreshing data';
 
 Implementation
 

packages/fcl-db/tests/testspecifictbufdataset.pas

@@ -0,0 +1,120 @@
+unit TestSpecificTBufDataset;
+
+{
+  Unit tests which are specific to stand-alone TBufDataset-datasets. (So not
+  for derrived datasets like TQuery )
+}
+
+{$IFDEF FPC}
+  {$mode Delphi}{$H+}
+{$ENDIF}
+
+interface
+
+uses
+{$IFDEF FPC}
+  fpcunit, testutils, testregistry, testdecorator, BufDataset,
+{$ELSE FPC}
+  TestFramework,
+{$ENDIF FPC}
+  Classes, SysUtils, db, ToolsUnit;
+
+type
+
+  { TTestSpecificTBufDataset }
+
+  TTestSpecificTBufDataset = class(TTestCase)
+  private
+    procedure TestDataset(ABufDataset: TBufDataset);
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+  published
+    procedure CreateDatasetFromFielddefs;
+    procedure CreateDatasetFromFields;
+  end;
+
+implementation
+
+uses
+{$ifdef fpc}
+//
+{$endif fpc}
+  variants,
+  strutils,
+  FmtBCD;
+
+{ TTestSpecificTBufDataset }
+
+procedure TTestSpecificTBufDataset.TestDataset(ABufDataset: TBufDataset);
+var
+  i  : integer;
+begin
+  for i := 1 to 10 do
+    begin
+    ABufDataset.Append;
+    ABufDataset.FieldByName('ID').AsInteger := i;
+    ABufDataset.FieldByName('NAME').AsString := 'TestName' + inttostr(i);
+    ABufDataset.Post;
+    end;
+  ABufDataset.first;
+  for i := 1 to 10 do
+    begin
+    CheckEquals(i,ABufDataset.fieldbyname('ID').asinteger);
+    CheckEquals('TestName' + inttostr(i),ABufDataset.fieldbyname('NAME').AsString);
+    ABufDataset.next;
+    end;
+  CheckTrue(ABufDataset.EOF);
+end;
+
+procedure TTestSpecificTBufDataset.SetUp;
+begin
+  DBConnector.StartTest;
+end;
+
+procedure TTestSpecificTBufDataset.TearDown;
+begin
+  DBConnector.StopTest;
+end;
+
+procedure TTestSpecificTBufDataset.CreateDatasetFromFielddefs;
+var ds : TBufDataset;
+begin
+  ds := TBufDataset.Create(nil);
+  DS.FieldDefs.Add('ID',ftInteger);
+  DS.FieldDefs.Add('NAME',ftString,50);
+  DS.CreateDataset;
+  TestDataset(ds);
+  DS.Close;
+  DS.CreateDataset;
+  TestDataset(ds);
+end;
+
+procedure TTestSpecificTBufDataset.CreateDatasetFromFields;
+var ds : TBufDataset;
+    f: TField;
+begin
+  ds := TBufDataset.Create(nil);
+  F := TIntegerField.Create(ds);
+  F.FieldName:='ID';
+  F.DataSet:=ds;
+  F := TStringField.Create(ds);
+  F.FieldName:='NAME';
+  F.DataSet:=ds;
+  F.Size:=50;
+  DS.CreateDataset;
+  TestDataset(ds);
+  DS.Close;
+  DS.CreateDataset;
+  TestDataset(ds);
+end;
+
+initialization
+{$ifdef fpc}
+
+  if uppercase(dbconnectorname)='BUFDATASET' then
+    begin
+    RegisterTestDecorator(TDBBasicsTestSetup, TTestSpecificTBufDataset);
+    end;
+{$endif fpc}
+end.