paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-11 10:29:21 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Merging revisions 42886 from trunk:

Browse Source 
------------------------------------------------------------------------
    r42886 | michael | 2019-09-01 13:32:14 +0200 (Sun, 01 Sep 2019) | 1 line
    
    * Fix bug ID #35769
    ------------------------------------------------------------------------

git-svn-id: branches/fixes_3_2@43233 -
This commit is contained in:
michael 2019-10-19 14:35:27 +00:00
parent 89448abde1
commit 53309395e1
2 changed files with 78 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
packages/fcl-db/src/base/bufdataset.pas
View File

@ -614,6 +614,7 @@ type
function Fetch : boolean; virtual;
function LoadField(FieldDef : TFieldDef;buffer : pointer; out CreateBlob : boolean) : boolean; virtual;
procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField); virtual; abstract;
function DoLocate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions; DoEvents : Boolean) : boolean;
Property Refreshing : Boolean Read FRefreshing;
public
constructor Create(AOwner: TComponent); override;
@ -3756,8 +3757,14 @@ begin
end;
end;
function TCustomBufDataset.Locate(const KeyFields: string;
const KeyValues: Variant; Options: TLocateOptions): boolean;
function TCustomBufDataset.Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): boolean;
begin
Result:=DoLocate(keyfields,KeyValues,Options,True);
end;
function TCustomBufDataset.DoLocate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions; DoEvents : Boolean) : boolean;
var SearchFields : TList;
DBCompareStruct : TDBCompareStruct;
@ -3768,7 +3775,7 @@ var SearchFields : TList;
begin
// Call inherited to make sure the dataset is bi-directional
Result := inherited;
Result := inherited Locate(KeyFields,KeyValues,Options);
CheckActive;
if IsEmpty then exit;
@ -3825,7 +3832,13 @@ begin
if Result then
begin
ABookmark.BookmarkFlag := bfCurrent;
GotoBookmark(@ABookmark);
if DoEvents then
GotoBookmark(@ABookmark)
else
begin
InternalGotoBookMark(@ABookmark);
Resync([rmExact,rmCenter]);
end;
end;
end;
@ -3838,12 +3851,13 @@ begin
bm:=GetBookmark;
DisableControls;
try
if Locate(KeyFields,KeyValues,[]) then
if DoLocate(KeyFields,KeyValues,[],False) then
begin
// CalculateFields(ActiveBuffer); // not needed, done by Locate more than once
result:=FieldValues[ResultFields];
end;
GotoBookmark(bm);
InternalGotoBookMark(pointer(bm));
Resync([rmExact,rmCenter]);
FreeBookmark(bm);
finally
EnableControls;

58
packages/fcl-db/tests/testspecifictbufdataset.pas
View File

@ -33,6 +33,10 @@ type
TTestSpecificTBufDataset = class(TDBBasicsTestCase)
private
FAfterScrollCount:integer;
FBeforeScrollCount:integer;
procedure DoAfterScrollCount(DataSet: TDataSet);
procedure DoBeforeScrollCount(DataSet: TDataSet);
procedure TestDataset(ABufDataset: TBufDataset; AutoInc: boolean = false);
function GetAutoIncDataset: TBufDataset;
procedure IntTestAutoIncFieldStreaming(XML: boolean);
@ -47,6 +51,8 @@ type
procedure TestAutoIncField;
procedure TestAutoIncFieldStreaming;
procedure TestAutoIncFieldStreamingXML;
Procedure TestLocateScrollEventCount;
Procedure TestLookupScrollEventCount;
Procedure TestRecordCount;
Procedure TestClear;
procedure TestCopyFromDataset; //is copied dataset identical to original?
@ -94,6 +100,16 @@ begin
CheckTrue(ABufDataset.EOF);
end;
procedure TTestSpecificTBufDataset.DoAfterScrollCount(DataSet: TDataSet);
begin
Inc(FAfterScrollCount);
end;
procedure TTestSpecificTBufDataset.DoBeforeScrollCount(DataSet: TDataSet);
begin
Inc(FBeforeScrollCount);
end;
function TTestSpecificTBufDataset.GetAutoIncDataset: TBufDataset;
var
ds : TBufDataset;
@ -142,6 +158,8 @@ end;
procedure TTestSpecificTBufDataset.SetUp;
begin
FAfterScrollCount:=0;
FBeforeScrollCount:=0;
DBConnector.StartTest(TestName);
end;
@ -270,6 +288,46 @@ begin
IntTestAutoIncFieldStreaming(true);
end;
procedure TTestSpecificTBufDataset.TestLocateScrollEventCount;
begin
with DBConnector.GetNDataset(10) as TBufDataset do
begin
Open;
AfterScroll:=DoAfterScrollCount;
BeforeScroll:=DoBeforeScrollCount;
Locate('ID',5,[]);
AssertEquals('Current record OK',5,FieldByName('ID').AsInteger);
AssertEquals('After scroll count',1,FAfterScrollCount);
AssertEquals('After scroll count',1,FBeforeScrollCount);
end;
end;
procedure TTestSpecificTBufDataset.TestLookupScrollEventCount;
Var
V : Variant;
S : String;
ID : Integer;
begin
with DBConnector.GetNDataset(10) as TBufDataset do
begin
Open;
ID:=FieldByName('ID').AsInteger;
AfterScroll:=DoAfterScrollCount;
BeforeScroll:=DoBeforeScrollCount;
V:=Lookup('ID',5,'NAME');
AssertTrue('Not null',Null<>V);
S:=V;
AssertEquals('Result','TestName5',S);
AssertEquals('After scroll count',0,FAfterScrollCount);
AssertEquals('After scroll count',0,FBeforeScrollCount);
AssertEquals('Current record unchanged',ID,FieldByName('ID').AsInteger);
end;
end;
procedure TTestSpecificTBufDataset.TestRecordCount;
var
BDS:TBufDataSet;