paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-06-06 10:18:25 +02:00
Code Issues Packages Projects Releases Wiki Activity
3fdbf1f1af
fpc/packages/fcl-db/tests/testdbbasics.pas
Michaël Van Canneyt c46b45bf72 * Patch from Laco to add TSingleField
2022-02-14 09:15:43 +01:00

3309 lines
85 KiB
ObjectPascal
Raw Blame History

unit TestDBBasics;
{$IFDEF FPC}
{$mode Delphi}{$H+}
{$ENDIF}
interface
uses
{$IFDEF FPC}
testregistry,
{$ELSE FPC}
TestFramework,
{$ENDIF FPC}
Classes, SysUtils, db, ToolsUnit;
type
{ TTestDBBasics }
TTestDBBasics = class(TDBBasicsTestCase)
private
procedure TestFieldDefinition(AFieldType: TFieldType; ADataSize: integer); overload;
procedure TestFieldDefinition(AFieldType : TFieldType; ADataSize : integer; out ADS : TDataset; out AFld : TField); overload;
procedure TestFieldDefinition(AFld: TField; AFieldType : TFieldType; ADataSize : integer); overload;
procedure TestCalculatedField_OnCalcfields(DataSet: TDataSet);
published
// fields
procedure TestSetFieldValues;
procedure TestGetFieldValues;
procedure TestClearFields;
procedure TestSupportIntegerFields;
procedure TestSupportSmallIntFields;
procedure TestSupportWordFields;
procedure TestSupportStringFields;
procedure TestSupportBooleanFields;
procedure TestSupportBooleanFieldDisplayValue;
procedure TestSupportFloatFields;
procedure TestSupportLargeIntFields;
procedure TestSupportDateFields;
procedure TestSupportTimeFields;
procedure TestSupportDateTimeFields;
procedure TestSupportCurrencyFields;
procedure TestSupportBCDFields;
procedure TestSupportFmtBCDFields;
procedure TestSupportFixedStringFields;
procedure TestSupportBlobFields;
procedure TestSupportMemoFields;
procedure TestSupportByteFields;
procedure TestSupportShortIntFields;
procedure TestSupportExtendedFields;
procedure TestSupportSingleFields;
procedure TestBlobBlobType; //bug 26064
procedure TestCalculatedField;
procedure TestCanModifySpecialFields;
// dataset
procedure TestDoubleClose;
procedure TestFieldDefsUpdate;
procedure TestAssignFieldftString;
procedure TestAssignFieldftFixedChar;
procedure TestSelectQueryBasics;
procedure TestPostOnlyInEditState;
procedure TestMove; // bug 5048
procedure TestActiveBufferWhenClosed;
procedure TestEOFBOFClosedDataset;
procedure TestRecordcountAfterReopen; // partly bug 8228
procedure TestExceptionLocateClosed; // bug 13938
procedure TestDetectionNonMatchingDataset;
// events
procedure TestLayoutChangedEvents;
procedure TestDataEventsResync;
procedure TestdeFieldListChange;
end;
{ TTestBufDatasetDBBasics }
{$ifdef fpc}
TTestBufDatasetDBBasics = class(TDBBasicsTestCase)
private
procedure FTestXMLDatasetDefinition(ADataset : TDataset);
procedure TestAddIndexFieldType(AFieldType : TFieldType; ActiveDS : boolean);
published
procedure TestFileNameProperty;
procedure TestClientDatasetAsMemDataset;
procedure TestSaveAsXML;
procedure TestIsEmpty;
procedure TestReadOnly;
// cached updates
procedure TestBufDatasetCancelUpd; //bug 6938
procedure TestBufDatasetCancelUpd1;
procedure TestMultipleDeleteUpdateBuffer;
procedure TestDoubleDelete;
procedure TestMergeChangeLog;
procedure TestRevertRecord;
// index tests
procedure TestAddIndexInteger;
procedure TestAddIndexSmallInt;
procedure TestAddIndexBoolean;
procedure TestAddIndexFloat;
procedure TestAddIndexLargeInt;
procedure TestAddIndexDateTime;
procedure TestAddIndexCurrency;
procedure TestAddIndexBCD;
procedure TestAddIndexFmtBCD;
procedure TestAddIndex;
procedure TestAddDescIndex;
procedure TestAddCaseInsIndex;
procedure TestInactSwitchIndex;
procedure TestAddIndexActiveDS;
procedure TestAddIndexEditDS;
procedure TestIndexFieldNames;
procedure TestIndexFieldNamesActive;
procedure TestIndexFieldNamesClosed; // bug 16695
procedure TestIndexCurRecord;
procedure TestAddDblIndex;
procedure TestIndexEditRecord;
procedure TestIndexAppendRecord;
end;
{$endif fpc}
TTestUniDirectionalDBBasics = class(TTestDBBasics)
end;
{ TTestCursorDBBasics }
TTestCursorDBBasics = class(TDBBasicsTestCase)
private
procedure TestOnFilterProc(DataSet: TDataSet; var Accept: Boolean); // Filters out all records with even ID
procedure FTestDelete1(TestCancelUpdate : boolean);
procedure FTestDelete2(TestCancelUpdate : boolean);
published
procedure TestCancel;
procedure TestCancelUpdDelete1;
procedure TestCancelUpdDelete2;
procedure TestAppendInsertRecord;
procedure TestBookmarks;
procedure TestBookmarkValid;
procedure TestCompareBookmarks;
procedure TestDelete1;
procedure TestDelete2;
procedure TestLocate;
procedure TestLocateCaseIns;
procedure TestLocateCaseInsInts;
procedure TestLookup;
procedure TestOnFilter;
procedure TestIntFilter; //Integer range filter
procedure TestNegativeIntFilter; //Negative integer filter; bug 25168
procedure TestStringFilter; //String filter expressions
procedure TestNullAtOpen;
procedure TestAppendOnEmptyDataset;
procedure TestInsertOnEmptyDataset;
procedure TestFirst;
procedure TestEofAfterFirst; // bug 7211
procedure TestLastAppendCancel; // bug 5058
procedure TestRecNo; // bug 5061
procedure TestSetRecNo; // bug 6919
procedure TestBug7007;
procedure TestBug6893;
procedure TestRequired;
procedure TestModified;
procedure TestUpdateCursorPos; // bug 31532
// fields
procedure TestFieldOldValueObsolete;
procedure TestFieldOldValue;
procedure TestChangeBlobFieldBeforePost; //bug 15376
end;
{ TDBBasicsUniDirectionalTestSetup }
{$ifdef fpc}
TDBBasicsUniDirectionalTestSetup = class(TDBBasicsTestSetup)
protected
procedure OneTimeSetup; override;
procedure OneTimeTearDown; override;
end;
{$endif fpc}
implementation
uses
{$ifdef fpc}
bufdataset,
sqldb,
{$endif fpc}
variants,
strutils,
FmtBCD;
type
THackDataLink=class(TDataLink);
{ TMyCustomBufDataset }
TMyCustomBufDataset = Class(TCustomBufDataset)
protected
procedure LoadBlobIntoBuffer(FieldDef: TFieldDef; ABlobBuf: PBufBlobField); override;
end;
{ TMyCustomBufDataset }
procedure TMyCustomBufDataset.LoadBlobIntoBuffer(FieldDef: TFieldDef; ABlobBuf: PBufBlobField);
begin
Raise ENotImplemented.Create('LoadBlobIntoBuffer not implemented');
end;
{ TTestCursorDBBasics }
procedure TTestCursorDBBasics.TestAppendOnEmptyDataset;
begin
with DBConnector.GetNDataset(True,0) do
begin
open;
CheckTrue(CanModify);
CheckTrue(eof);
CheckTrue(bof);
append;
FieldByName('id').AsInteger:=0;
CheckFalse(Bof);
CheckTrue(Eof);
post;
CheckFalse(eof);
CheckFalse(bof);
end;
end;
procedure TTestCursorDBBasics.TestInsertOnEmptyDataset;
begin
with DBConnector.GetNDataset(True,0) do
begin
open;
CheckTrue(CanModify);
CheckTrue(eof);
CheckTrue(bof);
CheckTrue(IsEmpty);
insert;
FieldByName('id').AsInteger:=0;
CheckTrue(Bof);
CheckTrue(Eof);
CheckFalse(IsEmpty);
post;
CheckFalse(IsEmpty);
CheckFalse(eof);
CheckFalse(bof);
end;
end;
procedure TTestDBBasics.TestSelectQueryBasics;
begin
with DBConnector.GetNDataset(1) do
begin
Open;
if IsUniDirectional then
CheckEquals(-1,RecNo)
else
CheckEquals(1,RecNo);
CheckEquals(1,RecordCount);
CheckEquals(2,FieldCount);
CheckTrue(CompareText('ID',fields[0].FieldName)=0);
CheckTrue(CompareText('ID',fields[0].DisplayName)=0);
CheckTrue(ftInteger=fields[0].DataType, 'The datatype of the field ''ID'' is incorrect, it should be ftInteger');
CheckTrue(CompareText('NAME',fields[1].FieldName)=0);
CheckTrue(CompareText('NAME',fields[1].DisplayName)=0);
CheckTrue(ftString=fields[1].DataType);
CheckEquals(1,fields[0].Value);
CheckEquals('TestName1',fields[1].Value);
Close;
end;
end;
procedure TTestDBBasics.TestPostOnlyInEditState;
begin
with DBConnector.GetNDataset(1) do
begin
open;
CheckException(Post,EDatabaseError,'Post was called in a non-edit state');
end;
end;
procedure TTestDBBasics.TestMove;
var i,count : integer;
aDatasource : TDataSource;
aDatalink : TDataLink;
ABufferCount : Integer;
begin
aDatasource := TDataSource.Create(nil);
aDatalink := TTestDataLink.Create;
try
aDatalink.DataSource := aDatasource;
ABufferCount := 11;
aDatalink.BufferCount := ABufferCount;
DataEvents := '';
for count := 0 to 32 do
begin
aDatasource.DataSet := DBConnector.GetNDataset(count);
with aDatasource.Dataset do
begin
i := 1;
Open;
CheckEquals('deUpdateState:0;',DataEvents);
DataEvents := '';
while not EOF do
begin
CheckEquals(i,fields[0].AsInteger);
CheckEquals('TestName'+inttostr(i),fields[1].AsString);
inc(i);
Next;
if (i > ABufferCount) and not EOF then
CheckEquals('deCheckBrowseMode:0;deDataSetScroll:-1;DataSetScrolled:1;DataSetChanged;',DataEvents)
else
CheckEquals('deCheckBrowseMode:0;deDataSetScroll:0;DataSetScrolled:0;DataSetChanged;',DataEvents);
DataEvents := '';
end;
CheckEquals(count,i-1);
close;
CheckEquals('deUpdateState:0;',DataEvents);
DataEvents := '';
end;
end;
finally
aDatalink.Free;
aDatasource.Free;
end;
end;
procedure TTestDBBasics.TestActiveBufferWhenClosed;
begin
with DBConnector.GetNDataset(0) do
begin
{$ifdef fpc}
AssertNull(ActiveBuffer);
{$endif fpc}
open;
CheckFalse(ActiveBuffer = nil,'Activebuffer of an empty dataset shouldn''t be nil');
end;
end;
procedure TTestDBBasics.TestEOFBOFClosedDataset;
begin
with DBConnector.GetNDataset(1) do
begin
CheckTrue(EOF);
CheckTrue(BOF);
open;
CheckTrue(BOF, 'No BOF when opened non-empty dataset');
CheckFalse(EOF, 'EOF after opened non-empty dataset');
close;
CheckTrue(EOF);
CheckTrue(BOF);
end;
end;
procedure TTestDBBasics.TestLayoutChangedEvents;
var aDatasource : TDataSource;
aDatalink : TDataLink;
ds : tdataset;
begin
aDatasource := TDataSource.Create(nil);
aDatalink := TTestDataLink.Create;
try
aDatalink.DataSource := aDatasource;
ds := DBConnector.GetNDataset(6);
aDatasource.DataSet:=ds;
with ds do
begin
open;
DataEvents := '';
DisableControls;
Active:=False;
Active:=True;
EnableControls;
CheckEquals('deLayoutChange:0;DataSetChanged;',DataEvents);
close;
end;
finally
aDatasource.Free;
aDatalink.Free;
end;
end;
procedure TTestDBBasics.TestDataEventsResync;
var
aDatasource : TDataSource;
aDatalink : TDataLink;
ds : tdataset;
begin
aDatasource := TDataSource.Create(nil);
aDatalink := TTestDataLink.Create;
try
aDatalink.DataSource := aDatasource;
ds := DBConnector.GetNDataset(6);
ds.BeforeScroll := DBConnector.DataEvent;
with ds do
begin
aDatasource.DataSet := ds;
Open;
DataEvents := '';
Resync([rmExact]);
if IsUniDirectional then
CheckEquals('',DataEvents)
else
CheckEquals('deDataSetChange:0;DataSetChanged;',DataEvents);
DataEvents := '';
Next;
if IsUniDirectional then
CheckEquals('deCheckBrowseMode:0;DataEvent;deDataSetScroll:-1;DataSetScrolled:1;DataSetChanged;',DataEvents)
else
CheckEquals('deCheckBrowseMode:0;DataEvent;deDataSetScroll:0;DataSetScrolled:1;DataSetChanged;',DataEvents);
DataEvents := '';
Close;
end;
finally
aDatasource.Free;
aDatalink.Free;
end;
end;
procedure TTestDBBasics.TestdeFieldListChange;
var
aDatasource : TDataSource;
aDatalink : TDataLink;
ds : TDataset;
begin
aDatasource := TDataSource.Create(nil);
aDatalink := TTestDataLink.Create;
aDatalink.DataSource := aDatasource;
ds := DBConnector.GetNDataset(1);
with ds do
begin
aDatasource.DataSet := ds;
DataEvents := '';
Open;
Fields.Add(TField.Create(ds));
CheckEquals('deUpdateState:0;deFieldListChange:0;',DataEvents);
DataEvents := '';
Fields.Clear;
CheckEquals('deFieldListChange:0;',DataEvents)
end;
aDatasource.Free;
aDatalink.Free;
end;
procedure TTestDBBasics.TestRecordcountAfterReopen;
var
datalink1: tdatalink;
datasource1: tdatasource;
query1: TDataSet;
begin
query1:= DBConnector.GetNDataset(11);
datalink1:= TDataLink.create;
datasource1:= TDataSource.create(nil);
try
datalink1.DataSource:= datasource1;
datasource1.DataSet:= query1;
query1.active := True;
query1.active := False;
CheckEquals(0, THackDataLink(datalink1).RecordCount);
query1.active := True;
CheckTrue(THackDataLink(datalink1).RecordCount>0);
query1.active := False;
finally
datalink1.free;
datasource1.free;
end;
end;
procedure TTestCursorDBBasics.TestLastAppendCancel;
var count : integer;
begin
for count := 0 to 32 do with DBConnector.GetNDataset(count) do
begin
open;
Last;
Append;
Cancel;
CheckEquals(count,fields[0].asinteger);
CheckEquals(count,RecordCount);
Close;
end;
end;
procedure TTestCursorDBBasics.TestRecNo;
var passed : boolean;
begin
with DBConnector.GetNDataset(0) do
begin
// Accessing RecNo on a closed dataset should raise an EDatabaseError or should
// return 0
passed := false;
try
passed := RecNo = 0;
except on E: Exception do
passed := E.classname = EDatabaseError.className
end;
if not passed then
CheckEquals(0,RecNo,'Failed to get the RecNo from a closed dataset');
// Accessing RecordCount on a closed dataset should raise an EDatabaseError or should
// return 0
passed := false;
try
passed := RecordCount = 0;
except on E: Exception do
passed := E.classname = EDatabaseError.className
end;
if not passed then
CheckEquals(0,RecordCount,'Failed to get the RecordCount from a closed dataset');
Open;
CheckEquals(0,RecordCount,'1. record count after open');
CheckEquals(0,RecNo,'1. recno after open');
CheckEquals(True,EOF and BOF, '1. Empty');
first;
CheckEquals(0,RecordCount,'2. recordcount after first (empty)');
CheckEquals(0,RecNo,'2. recno after first (empty)');
CheckEquals(True,EOF and BOF, '1. Empty');
last;
CheckEquals(0,RecordCount,'3. recordcount after last (empty)');
CheckEquals(0,RecNo,'3. recordcount after last (empty)');
CheckEquals(True,EOF and BOF, '3. Empty');
append;
CheckEquals(0,RecNo,'4. recno after append (empty)');
CheckEquals(0,RecordCount,'4. recordcount after append (empty)');
CheckEquals(False, EOF and BOF, '4. Empty');
first;
CheckEquals(0,RecNo,'5. recno after first append (empty,append )');
CheckEquals(0,RecordCount,'5. recordcount after first (empty, append)');
CheckEquals(True,EOF and BOF, '5. Empty');
append;
FieldByName('id').AsInteger := 1;
CheckEquals(0,RecNo,'6. recno after second append (empty,append)');
CheckEquals(0,RecordCount,'6. recordcount after second append (empty,append)');
CheckEquals(False ,EOF and BOF, '6. Empty');
first;
CheckEquals(1,RecNo,'7. recno after second append, first (1,append)');
CheckEquals(1,RecordCount,'7. recordcount after second append,first (1,append)');
CheckEquals(False ,EOF and BOF, '7. Empty');
last;
CheckEquals(1,RecNo,'8. recno after second append, last (1,append)');
CheckEquals(1,RecordCount,'8. recordcount after second append, last (1,append)');
append;
FieldByName('id').AsInteger := 2;
CheckEquals(0,RecNo,'9. RecNo after 3rd Append');
CheckEquals(1,RecordCount,'9. Recordcount after 3rd Append');
post;
edit;
CheckEquals(2,RecNo,'RecNo after Edit');
CheckEquals(2,RecordCount);
Close;
// Tests if RecordCount resets to 0 after dataset is closed
passed := false;
try
passed := RecordCount = 0;
except on E: Exception do
passed := E.classname = EDatabaseError.className
end;
if not passed then
CheckEquals(0,RecordCount,'RecordCount after Close');
end;
end;
procedure TTestCursorDBBasics.TestSetRecNo;
begin
with DBConnector.GetNDataset(15) do
begin
Open;
RecNo := 1;
CheckEquals(1,fields[0].AsInteger);
CheckEquals(1,RecNo);
RecNo := 2;
CheckEquals(2,fields[0].AsInteger);
CheckEquals(2,RecNo);
RecNo := 8;
CheckEquals(8,fields[0].AsInteger);
CheckEquals(8,RecNo);
RecNo := 15;
CheckEquals(15,fields[0].AsInteger);
CheckEquals(15,RecNo);
RecNo := 3;
CheckEquals(3,fields[0].AsInteger);
CheckEquals(3,RecNo);
RecNo := 14;
CheckEquals(14,fields[0].AsInteger);
CheckEquals(14,RecNo);
RecNo := 15;
CheckEquals(15,fields[0].AsInteger);
CheckEquals(15,RecNo);
// test for exceptions...
{ RecNo := 16;
CheckEquals(15,fields[0].AsInteger);
CheckEquals(15,RecNo);}
Close;
end;
end;
procedure TTestCursorDBBasics.TestRequired;
begin
with DBConnector.GetNDataset(2) do
begin
Open;
FieldByName('ID').Required := True;
Append;
CheckException(Post, EDatabaseError);
FieldByName('ID').AsInteger := 1000;
Post;
Close;
end;
end;
procedure TTestDBBasics.TestExceptionLocateClosed;
var passed: boolean;
begin
with DBConnector.GetNDataset(15) do
begin
passed := false;
try
locate('name','TestName1',[]);
except on E: Exception do
begin
passed := E.classname = EDatabaseError.className
end;
end;
CheckTrue(passed);
end;
end;
procedure TTestCursorDBBasics.TestModified;
begin
// Tests TDataSet.Modified property
with DBConnector.GetNDataset(true,1) as TDataset do
begin
Open;
CheckFalse(Modified);
Edit;
CheckFalse(Modified, 'After Edit');
Fields[1].AsString := Fields[1].AsString;
CheckTrue(Modified, 'After change');
Post;
CheckFalse(Modified, 'After Post');
Append;
CheckFalse(Modified, 'After Append');
Fields[0].AsInteger := 100;
CheckTrue(Modified, 'After change');
Cancel;
CheckFalse(Modified, 'After Cancel');
Close;
end;
end;
procedure TTestCursorDBBasics.TestUpdateCursorPos;
var
datasource1: TDataSource;
datalink1: TDataLink;
dataset1: TDataSet;
i,r: integer;
begin
// TBufDataset should notify TDataset (TDataset.CurrentRecord) when changes internaly current record
// TBufDataset.GetRecNo was synchronizing its internal position with TDataset.ActiveRecord, but TDataset.CurrentRecord remains unchaged
// Bug #31532
dataset1 := DBConnector.GetNDataset(16);
datasource1 := TDataSource.Create(nil);
datasource1.DataSet := dataset1;
datalink1 := TDataLink.Create;
datalink1:= TDataLink.create;
datalink1.DataSource:= datasource1;
datalink1.BufferCount:= 12;
dataset1.Open;
dataset1.MoveBy(4);
CheckEquals(5, dataset1.RecNo);
for i:=13 to 15 do begin
datalink1.BufferCount := datalink1.BufferCount+1;
r := dataset1.RecNo; // syncronizes source dataset to ActiveRecord
AssertTrue(r>=0);
datalink1.ActiveRecord := datalink1.BufferCount-1;
CheckEquals(i, dataset1.FieldByName('ID').AsInteger);
end;
datasource1.free;
datalink1.free;
end;
procedure TTestDBBasics.TestDetectionNonMatchingDataset;
var
F: TField;
ds: TDataSet;
begin
// TDataset.BindFields should detect problems when the underlying data does
// not reflect the fields of the dataset. This test is to check if this is
// really done.
ds := DBConnector.GetNDataset(true,6);
with ds do
begin
open;
close;
F := TStringField.Create(ds);
F.FieldName:='DOES_NOT_EXIST';
F.DataSet:=ds;
F.Size:=50;
CheckException(open,EDatabaseError);
end;
end;
procedure TTestCursorDBBasics.TestAppendInsertRecord;
begin
with DBConnector.GetNDataset(true,6) do
begin
open;
// InsertRecord should insert a record, set the values, post the record and
// make the new record active.
InsertRecord([152,'TestInsRec']);
CheckEquals(152,fields[0].AsInteger);
CheckEquals('TestInsRec',fields[1].AsString);
CheckTrue(State=dsBrowse);
// AppendRecord should append a record, further the same as InsertRecord
AppendRecord([151,'TestInsRec']);
CheckEquals(151,fields[0].AsInteger);
CheckEquals('TestInsRec',fields[1].AsString);
CheckTrue(state=dsBrowse);
next;
CheckTrue(EOF);
end;
end;
procedure TTestCursorDBBasics.TestBookmarks;
var BM1,BM2,BM3,BM4,BM5 : TBookmark;
begin
with DBConnector.GetNDataset(true,14) do
begin
{$ifdef fpc}
AssertNull(GetBookmark);
{$endif fpc}
open;
BM1:=GetBookmark; // id=1, BOF
next;next;
BM2:=GetBookmark; // id=3
next;next;next;
BM3:=GetBookmark; // id=6
next;next;next;next;next;next;next;next;
BM4:=GetBookmark; // id=14
next;
BM5:=GetBookmark; // id=14, EOF
GotoBookmark(BM2);
CheckEquals(3,FieldByName('id').AsInteger);
GotoBookmark(BM1);
CheckEquals(1,FieldByName('id').AsInteger);
GotoBookmark(BM3);
CheckEquals(6,FieldByName('id').AsInteger);
GotoBookmark(BM4);
CheckEquals(14,FieldByName('id').AsInteger);
GotoBookmark(BM3);
CheckEquals(6,FieldByName('id').AsInteger);
GotoBookmark(BM5);
CheckEquals(14,FieldByName('id').AsInteger);
GotoBookmark(BM1);
CheckEquals(1,FieldByName('id').AsInteger);
next;
delete; // id=2
GotoBookmark(BM2);
CheckEquals(3,FieldByName('id').AsInteger,'After #2 deleted');
delete;delete; // id=3,4
GotoBookmark(BM3);
CheckEquals(6,FieldByName('id').AsInteger);
GotoBookmark(BM1);
CheckEquals(1,FieldByName('id').AsInteger);
insert;
fieldbyname('id').AsInteger:=20;
insert;
fieldbyname('id').AsInteger:=21;
insert;
fieldbyname('id').AsInteger:=22;
insert;
fieldbyname('id').AsInteger:=23;
post;
GotoBookmark(BM3);
CheckEquals(6,FieldByName('id').AsInteger);
GotoBookmark(BM1);
CheckEquals(1,FieldByName('id').AsInteger);
GotoBookmark(BM5);
CheckEquals(14,FieldByName('id').AsInteger);
end;
end;
procedure TTestCursorDBBasics.TestBookmarkValid;
var BM1,BM2,BM3,BM4,BM5,BM6 : TBookmark;
begin
with DBConnector.GetNDataset(true,14) do
begin
BM1 := Nil;
CheckFalse(BookmarkValid(BM1));
open;
BM1:=GetBookmark; // id=1, BOF
CheckTrue(BookmarkValid(BM1));
next;next;
BM2:=GetBookmark; // id=3
CheckTrue(BookmarkValid(BM2));
next;next;next;
BM3:=GetBookmark; // id=6
CheckTrue(BookmarkValid(BM3));
next;next;next;next;next;next;next;next;
BM4:=GetBookmark; // id=14
CheckTrue(BookmarkValid(BM4));
next;
BM5:=GetBookmark; // id=14, EOF
CheckTrue(BookmarkValid(BM5));
CheckTrue(BookmarkValid(BM4));
CheckTrue(BookmarkValid(BM3));
CheckTrue(BookmarkValid(BM2));
CheckTrue(BookmarkValid(BM1));
GotoBookmark(BM2);
CheckTrue(BookmarkValid(BM5));
CheckTrue(BookmarkValid(BM4));
CheckTrue(BookmarkValid(BM3));
CheckTrue(BookmarkValid(BM2));
CheckTrue(BookmarkValid(BM1));
Append;
BM6 := GetBookmark;
CheckFalse(BookmarkValid(BM6));
end;
end;
procedure TTestCursorDBBasics.TestCompareBookmarks;
var
FirstBookmark, LastBookmark, EditBookmark, PostEditBookmark: TBookmark;
begin
with DBConnector.GetNDataset(true,14) do
begin
Open;
FirstBookmark := GetBookmark;
Edit;
EditBookmark := GetBookmark;
Post;
PostEditBookmark := GetBookmark;
Last;
LastBookmark := GetBookmark;
CheckEquals(0, CompareBookmarks(FirstBookmark, EditBookmark));
CheckEquals(0, CompareBookmarks(EditBookmark, PostEditBookmark));
CheckTrue(CompareBookmarks(FirstBookmark, LastBookmark) < 0, 'b1<b2');
CheckTrue(CompareBookmarks(LastBookmark, FirstBookmark) > 0, 'b1>b2');
CheckEquals(0, CompareBookmarks(nil, nil), '(nil,nil)');
CheckEquals(-1, CompareBookmarks(FirstBookmark, nil), '(b1,nil)');
CheckEquals(+1, CompareBookmarks(nil, FirstBookmark), '(nil,b2)');
end;
end;
procedure TTestCursorDBBasics.TestLocate;
begin
with DBConnector.GetNDataset(true,13) do
begin
open;
CheckTrue(Locate('id',3,[]));
CheckTrue(Locate('id',vararrayof([5]),[]));
CheckEquals(5,FieldByName('id').AsInteger);
CheckFalse(Locate('id',vararrayof([15]),[]));
CheckTrue(Locate('id',vararrayof([13]),[]));
CheckEquals(13,FieldByName('id').AsInteger);
close;
open;
CheckTrue(Locate('id',vararrayof([12]),[]));
CheckEquals(12,FieldByName('id').AsInteger);
CheckTrue(Locate('id;name',vararrayof([4,'TestName4']),[]));
CheckEquals(4,FieldByName('id').AsInteger);
CheckFalse(Locate('id;name',vararrayof([4,'TestName5']),[]));
end;
end;
procedure TTestCursorDBBasics.TestLocateCaseIns;
// Tests case insensitive locate, also partial key locate, both against string fields.
// Together with TestLocateCaseInsInts, checks 23509 DBF: locate with loPartialkey behaviour differs depending on index use
begin
with DBConnector.GetNDataset(true,13) do
begin
open;
CheckFalse(Locate('name',vararrayof(['TEstName5']),[]));
CheckTrue(Locate('name',vararrayof(['TEstName5']),[loCaseInsensitive]));
CheckEquals(5,FieldByName('id').AsInteger);
CheckFalse(Locate('name',vararrayof(['TestN']),[]));
CheckTrue(Locate('name',vararrayof(['TestN']),[loPartialKey]));
CheckFalse(Locate('name',vararrayof(['TestNA']),[loPartialKey]));
CheckTrue(Locate('name',vararrayof(['TestNA']),[loPartialKey, loCaseInsensitive]));
close;
end;
end;
procedure TTestCursorDBBasics.TestLocateCaseInsInts;
// Tests case insensitive locate, also partial key locate, both against integer fields.
// Together with TestLocateCaseIns, checks 23509 DBF: locate with loPartialkey behaviour differs depending on index use
begin
with DBConnector.GetNDataset(true,13) do
begin
open;
// To really test bug 23509: we should first have a record that matches greater than for non-string locate:
first;
insert;
fieldbyname('id').AsInteger:=55;
fieldbyname('name').AsString:='TestName55';
post;
first;
CheckTrue(Locate('id',vararrayof([5]),[]));
CheckEquals(5,FieldByName('id').AsInteger);
first;
CheckTrue(Locate('id',vararrayof([5]),[loCaseInsensitive]));
CheckEquals(5,FieldByName('id').AsInteger);
first;
// Check specifying partial key doesn't influence search results
CheckTrue(Locate('id',vararrayof([5]),[loPartialKey]));
CheckEquals(5,FieldByName('id').AsInteger);
first;
CheckTrue(Locate('id',vararrayof([5]),[loPartialKey, loCaseInsensitive]));
CheckEquals(5,FieldByName('id').AsInteger);
close;
end;
end;
procedure TTestCursorDBBasics.TestLookup;
var v: variant;
begin
// Lookup doesn't move the record pointer of the dataset
// and no scroll events should be generated (only OnCalcFields when matched record is found)
with DBConnector.GetNDataset(13) do
begin
Open;
Next;
CheckEquals('TestName5', Lookup('id',5,'name'));
CheckTrue(Lookup('id',15,'name')=Null);
v:=Lookup('id',7,'id;name');
CheckEquals(7, v[0]);
CheckEquals('TestName7', v[1]);
// Lookup shouldn't change current record
CheckEquals(2, FieldByName('id').AsInteger);
Close;
end;
end;
procedure TTestCursorDBBasics.TestFieldOldValueObsolete;
var v : variant;
ds: TDataset;
begin
// this test was created as reaction to AV bug found in TCustomBufDataset.GetFieldData
// when retrieving OldValue (State=dsOldValue) of newly inserted or appended record.
// In this case was CurrBuff set to nil (and not checked),
// because OldValuesBuffer for just inserted record is nil. See rev.17704
// (So purpose of this test isn't test InsertRecord on empty dataset or so)
// Later was this test replaced by more complex TestOldValue (superset of old test),
// but next to it was restored back also original test.
// So now we have two tests which test same thing, where this 'old' one is subset of 'new' one
// Ideal solution would be remove this 'old' test as it does not test anything what is not tested elsewhere ...
ds := DBConnector.GetNDataset(0) as TDataset;
ds.Open;
ds.InsertRecord([0,'name']);
v := VarToStr(ds.Fields[1].OldValue);
AssertTrue(v<>null);
end;
procedure TTestCursorDBBasics.TestFieldOldValue;
var ds: TDataSet;
OldValue: string;
Fmemo: TField;
begin
ds := DBConnector.GetFieldDataset;
with ds do
begin;
Open;
First;
Next;
OldValue := Fields[0].AsString;
CheckEquals(OldValue, VarToStr(Fields[0].OldValue), 'Original value'); // unmodified original value
CheckTrue(UpdateStatus=usUnmodified, 'Unmodified');
Edit;
Fields[0].AsInteger := -1;
CheckEquals(OldValue, VarToStr(Fields[0].OldValue), 'Editing'); // dsEdit, there is no update-buffer yet
Post;
CheckEquals(OldValue, VarToStr(Fields[0].OldValue), 'Edited'); // there is already update-buffer
CheckTrue(UpdateStatus=usModified, 'Modified');
Append;
Fields[0].AsInteger := -2;
CheckTrue(VarIsNull(Fields[0].OldValue), 'Inserting'); // dsInsert, there is no update-buffer yet
Post;
CheckTrue(VarIsNull(Fields[0].OldValue), 'Inserted'); // there is already update-buffer
CheckTrue(UpdateStatus=usInserted, 'Inserted');
// Blobs are stored in a special way
// Use TMemoField because it implements AsVariant as AsString
First;
Next;
Fmemo := FieldByName('F'+FieldTypeNames[ftMemo]);
OldValue := Fmemo.AsString;
CheckEquals(OldValue, Fmemo.OldValue, 'Memo.OldValue');
Edit;
Fmemo.AsString := 'Changed Memo value';
CheckEquals(OldValue, Fmemo.OldValue, 'Memo.OldValue before Post');
Post;
CheckEquals(OldValue, Fmemo.OldValue, 'Memo.OldValue after Post');
end;
if ds is TCustomBufDataset then
with ds as TCustomBufDataset do
begin
MergeChangeLog;
CheckEquals('Changed Memo value', Fmemo.OldValue, 'Memo.OldValue after MergeChangeLog');
end;
end;
procedure TTestCursorDBBasics.TestChangeBlobFieldBeforePost;
// Edit memo fields should read back new contents even before post
// Bug 15376
// See also TTestFieldTypes.TestChangeBlob
var
Fmemo: TField;
begin
with DBConnector.GetFieldDataset do
begin
Open;
Append;
FieldByName('ID').AsInteger := -1; // Required - not null
Fmemo := FieldByName('FMEMO');
CheckTrue(Fmemo.IsNull, 'IsNull after Append');
Fmemo.AsString:='MEMO1';
CheckFalse(Fmemo.IsNull, 'IsNull after change');
CheckEquals('MEMO1', Fmemo.AsString);
Fmemo.Clear;
CheckTrue(Fmemo.IsNull, 'IsNull after Clear');
Fmemo.AsString:='MEMO2';
CheckEquals('MEMO2', Fmemo.AsString);
Fmemo.AsString:='';
CheckTrue(Fmemo.IsNull, 'IsNull');
Fmemo.AsString:='MEMO3';
CheckEquals('MEMO3', Fmemo.AsString);
Post;
CheckEquals('MEMO3', Fmemo.AsString);
Close;
end;
end;
procedure TTestDBBasics.TestSetFieldValues;
var PassException : boolean;
begin
with DBConnector.GetNDataset(true,11) do
begin
open;
// First and Next methods are supported by UniDirectional datasets
first;
if IsUniDirectional then
CheckException(Edit, EDatabaseError)
else
begin
edit;
FieldValues['id']:=5;
post;
CheckEquals('TestName1',FieldByName('name').AsString);
CheckEquals(5,FieldByName('id').AsInteger);
edit;
FieldValues['name']:='FieldValuesTestName';
post;
CheckEquals('FieldValuesTestName',FieldByName('name').AsString);
CheckEquals(5,FieldByName('id').AsInteger);
edit;
FieldValues['id;name']:= VarArrayOf([243,'ValuesTestName']);
post;
CheckEquals('ValuesTestName',FieldByName('name').AsString);
CheckEquals(243,FieldByName('id').AsInteger);
PassException:=false;
try
edit;
FieldValues['id;name;fake']:= VarArrayOf([243,'ValuesTestName',4]);
except
on E: EDatabaseError do PassException := True;
end;
post;
CheckTrue(PassException);
end;
end;
end;
procedure TTestDBBasics.TestGetFieldValues;
var AVar : Variant;
PassException : boolean;
begin
with DBConnector.GetNDataset(true,14) do
begin
open;
AVar:=FieldValues['id'];
CheckEquals(AVar,1);
AVar:=FieldValues['name'];
CheckEquals(AVar,'TestName1');
AVar:=FieldValues['id;name'];
CheckEquals(AVar[0],1);
CheckEquals(AVar[1],'TestName1');
AVar:=FieldValues['name;id;'];
CheckEquals(AVar[1],1);
CheckEquals(AVar[0],'TestName1');
PassException:=false;
try
AVar:=FieldValues['name;id;fake'];
except
on E: EDatabaseError do PassException := True;
end;
CheckTrue(PassException);
end;
end;
procedure TTestDBBasics.TestClearFields;
begin
with DBConnector.GetNDataset(true,14) do
begin
Open;
AssertException('Cannot call ClearFields when not in edit mode',EDatabaseError,ClearFields);
end;
end;
procedure TTestCursorDBBasics.TestDelete1;
begin
FTestDelete1(false);
end;
procedure TTestCursorDBBasics.TestDelete2;
begin
FTestDelete2(false);
end;
procedure TTestCursorDBBasics.TestCancelUpdDelete1;
begin
FTestDelete1(true);
end;
procedure TTestCursorDBBasics.TestCancelUpdDelete2;
begin
FTestDelete2(true);
end;
procedure TTestCursorDBBasics.FTestDelete1(TestCancelUpdate : boolean);
// Test the deletion of records, including the first and the last one
var i : integer;
ds : TDataset;
begin
ds := DBConnector.GetNDataset(true,17);
with ds do
begin
Open;
for i := 0 to 16 do if i mod 4=0 then
delete
else
next;
First;
for i := 0 to 16 do
begin
if i mod 4<>0 then
begin
CheckEquals(i+1,FieldByName('ID').AsInteger);
CheckEquals('TestName'+inttostr(i+1),FieldByName('NAME').AsString);
next;
end;
end;
end;
{$ifdef fpc}
if TestCancelUpdate then
begin
if not (ds is TCustomBufDataset) then
Ignore('This test only applies to TCustomBufDataset and descendents.');
with TCustomBufDataset(ds) do
begin
CancelUpdates;
First;
for i := 0 to 16 do
begin
CheckEquals(i+1,FieldByName('ID').AsInteger);
CheckEquals('TestName'+inttostr(i+1),FieldByName('NAME').AsString);
next;
end;
close;
end;
end;
{$endif}
end;
procedure TTestCursorDBBasics.FTestDelete2(TestCancelUpdate : boolean);
// Test the deletion of edited and appended records
var i : integer;
ds : TDataset;
begin
ds := DBConnector.GetNDataset(true,17);
with ds do
begin
Open;
// modify records
for i := 0 to 16 do
begin
if i mod 4=0 then
begin
edit;
fieldbyname('name').AsString:='this record will be gone soon';
post;
end;
next;
end;
// append new records
for i := 18 to 21 do
begin
append;
fieldbyname('id').AsInteger:=i;
fieldbyname('name').AsString:='TestName'+inttostr(i);
post;
end;
// delete records #1,5,9,13,17,21 which was modified or appended before
first;
for i := 0 to 20 do if i mod 4=0 then
delete
else
next;
First;
i := 0;
for i := 0 to 20 do
begin
if i mod 4<>0 then
begin
CheckEquals(i+1,FieldByName('ID').AsInteger);
CheckEquals('TestName'+inttostr(i+1),FieldByName('NAME').AsString);
next;
end;
end;
end;
{$ifdef fpc}
if TestCancelUpdate then
begin
if not (ds is TCustomBufDataset) then
Ignore('This test only applies to TCustomBufDataset and descendents.');
with TCustomBufDataset(ds) do
begin
CancelUpdates;
First;
for i := 1 to 17 do
begin
CheckEquals(i, FieldByName('ID').AsInteger);
CheckEquals('TestName'+inttostr(i), FieldByName('NAME').AsString);
next;
end;
close;
end;
end;
{$endif fpc}
end;
procedure TTestCursorDBBasics.TestCancel;
begin
with DBConnector.GetNDataset(1) do
begin
Open;
Edit;
FieldByName('name').AsString := 'EditName1';
Cancel;
CheckEquals('TestName1', FieldByName('name').AsString, 'Cancel did not restored previous value');
end;
end;
procedure TTestCursorDBBasics.TestOnFilterProc(DataSet: TDataSet; var Accept: Boolean);
begin
Accept := odd(Dataset.FieldByName('ID').AsInteger);
end;
procedure TTestCursorDBBasics.TestOnFilter;
// Tests OnFilterRecord filtering
var
Counter : byte;
begin
with DBConnector.GetNDataset(15) do
begin
OnFilterRecord := TestOnFilterProc;
Filtered := True;
Open;
for Counter := 1 to 8 do
begin
CheckTrue(odd(FieldByName('ID').asinteger));
next;
end;
CheckTrue(EOF, 'Filter should give only odd records');
end;
end;
procedure TTestCursorDBBasics.TestIntFilter;
// Tests an integer range filter expression
var
Counter : byte;
begin
with DBConnector.GetNDataset(15) do
begin
Filtered := True;
Filter := '(id>4) and (id<9)';
Open;
for Counter := 5 to 8 do
begin
CheckEquals(Counter, FieldByName('ID').AsInteger);
Next;
end;
CheckTrue(EOF, 'Filter (id>4) and (id<9)');
Filter := '-id-ID=-4';
CheckEquals(2, FieldByName('ID').AsInteger, 'Unary minus');
Next;
CheckTrue(EOF, 'Unary minus');
Close;
end;
end;
procedure TTestCursorDBBasics.TestNegativeIntFilter;
// Tests a negative integer range filter expression
var
Counter : integer;
begin
with DBConnector.GetNDataset(15) do
begin
// Change ID values to -1..-15 instead of positive
Open;
while not(EOF) do
begin
Edit;
FieldByName('ID').AsInteger:=
-1*(FieldByname('ID').AsInteger);
Post;
Next;
end;
// Regular filter with negative integer values
Filtered := True;
Filter := '(id>-9) and (id<-4)';
First;
for Counter := -5 downto -8 do
begin
CheckEquals(Counter,FieldByName('ID').AsInteger);
Next;
end;
CheckTrue(EOF);
// Filter with negative integer values and subtraction calculations
Filtered := True;
Filter := '(id>(-8-1)) and (id<(-3-1))';
First;
for Counter := -5 downto -8 do
begin
CheckEquals(Counter,FieldByName('ID').AsInteger);
Next;
end;
CheckTrue(EOF);
Close;
end;
end;
procedure TTestCursorDBBasics.TestStringFilter;
// Tests string expression filters
begin
with DBConnector.GetNDataset(15) do
begin
Open;
// Check equality
Filter := '(name=''TestName3'')';
Filtered := True;
CheckFalse(EOF, 'Simple equality');
CheckEquals(3,FieldByName('ID').asinteger,'Simple equality');
CheckEquals('TestName3',FieldByName('NAME').asstring,'Simple equality');
next;
CheckTrue(EOF,'Simple equality');
// Check partial compare
Filter := '(name=''*Name5'')';
CheckFalse(EOF, 'Partial compare');
CheckEquals(5,FieldByName('ID').asinteger,'Partial compare');
CheckEquals('TestName5',FieldByName('NAME').asstring,'Partial compare');
next;
CheckTrue(EOF,'Partial compare');
// Check case-sensitivity
Filter := '(name=''*name3'')';
first;
CheckTrue(EOF,'Case-sensitive search');
FilterOptions:=[foCaseInsensitive];
Filter := '(name=''testname3'')';
first;
CheckFalse(EOF,'Case-insensitive search');
CheckEquals(3,FieldByName('ID').asinteger,'Case-insensitive search');
CheckEquals('TestName3',FieldByName('NAME').asstring,'Case-insensitive search');
next;
CheckTrue(EOF);
// Check case-insensitive partial compare
Filter := '(name=''*name3'')';
first;
CheckFalse(EOF, 'Case-insensitive partial compare');
CheckEquals(3,FieldByName('ID').asinteger, 'Case-insensitive partial compare');
CheckEquals('TestName3',FieldByName('NAME').asstring, 'Case-insensitive partial compare');
next;
CheckTrue(EOF);
// Multiple records with partial compare
Filter := '(name=''*name*'')';
first;
CheckFalse(EOF,'Partial compare multiple records');
CheckEquals(1,FieldByName('ID').asinteger,'Partial compare multiple records');
CheckEquals('TestName1',FieldByName('NAME').asstring,'Partial compare multiple records');
next;
CheckFalse(EOF,'Partial compare multiple records');
CheckEquals(2,FieldByName('ID').asinteger,'Partial compare multiple records');
CheckEquals('TestName2',FieldByName('NAME').asstring,'Partial compare multiple records');
// Invalid data with partial compare
Filter := '(name=''*neme*'')';
first;
CheckTrue(EOF,'Invalid data, partial compare');
// Multiple string filters
Filter := '(name=''*a*'') and (name=''*m*'')';
first;
CheckFalse(EOF,'Multiple string filters');
CheckEquals(1,FieldByName('ID').asinteger,'Multiple string filters');
CheckEquals('TestName1',FieldByName('NAME').asstring,'Multiple string filters');
next;
CheckFalse(EOF,'Multiple string filters');
CheckEquals(2,FieldByName('ID').asinteger,'Multiple string filters');
CheckEquals('TestName2',FieldByName('NAME').asstring,'Multiple string filters');
// Modify so we can use some tricky data
Filter := ''; //show all records again and allow edits
First;
Edit;
// Record 1=O'Malley
FieldByName('NAME').AsString := 'O''Malley';
Post;
Next;
Edit;
// Record 2="Magic" Mushroom
FieldByName('NAME').AsString := '"Magic" Mushroom';
Post;
Next;
Edit;
// Record 3=O'Malley's "Magic" Mushroom
FieldByName('NAME').AsString := 'O''Malley''s "Magic" Mushroom';
Post;
// Test searching on " which can be a delimiter
Filter := '(name=''*"Magic"*'')'; //should give record 2 and 3
first;
CheckFalse(EOF);
CheckEquals(2,FieldByName('ID').asinteger,'Search for strings with ", partial compare');
CheckEquals('"Magic" Mushroom',FieldByName('NAME').asstring,'Search for strings with ", partial compare');
next;
CheckFalse(EOF);
CheckEquals(3,FieldByName('ID').asinteger,'Search for strings with ", partial compare');
CheckEquals('O''Malley''s "Magic" Mushroom',FieldByName('NAME').asstring,'Search for strings with ", partial compare');
// Search for strings with ' escaped, partial compare delimited by '
Filter := '(name=''O''''Malley*'')'; //should give record 1 and 3
first;
CheckFalse(EOF);
CheckEquals(1,FieldByName('ID').asinteger,'Search for strings with '' escaped, partial compare delimited by ''');
CheckEquals('O''Malley',FieldByName('NAME').asstring,'Search for strings with '' escaped, partial compare delimited by ''');
next;
CheckFalse(EOF);
CheckEquals(3,FieldByName('ID').asinteger,'Search for strings with '' escaped, partial compare delimited by ''');
CheckEquals('O''Malley''s "Magic" Mushroom',FieldByName('NAME').asstring,'Search for strings with '' escaped, partial compare delimited by ''');
Close;
end;
end;
{$ifdef fpc}
procedure TTestBufDatasetDBBasics.TestIsEmpty;
begin
with DBConnector.GetNDataset(True,1) as TCustomBufDataset do
begin
open;
delete;
Resync([]);
ApplyUpdates;
CheckTrue(IsEmpty);
end;
end;
procedure TTestBufDatasetDBBasics.TestSaveAsXML;
var ds : TDataset;
LoadDs: TCustomBufDataset;
begin
ds := DBConnector.GetNDataset(true,5);
ds.open;
TCustomBufDataset(ds).SaveToFile('test.xml');
ds.close;
LoadDs := TMyCustomBufDataset.Create(nil);
try
LoadDs.LoadFromFile('test.xml');
FTestXMLDatasetDefinition(LoadDS);
finally
LoadDS.free;
end;
end;
procedure TTestBufDatasetDBBasics.TestFileNameProperty;
var ds1,ds2: TDataset;
begin
ds2 := nil;
ds1 := DBConnector.GetNDataset(true,5);
try
ds1.open;
TCustomBufDataset(ds1).FileName:='test.xml';
ds1.close;
ds2 := DBConnector.GetNDataset(True,7);
TCustomBufDataset(ds2).FileName:='test.xml';
ds2.Open;
FTestXMLDatasetDefinition(Ds2);
finally
TCustomBufDataset(ds1).FileName:='';
if assigned(ds2) then
TCustomBufDataset(ds2).FileName:='';
end;
end;
procedure TTestBufDatasetDBBasics.TestClientDatasetAsMemDataset;
var ds : TCustomBufDataset;
i : integer;
begin
ds := TMyCustomBufDataset.Create(nil);
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;
procedure TTestBufDatasetDBBasics.TestBufDatasetCancelUpd;
var i : byte;
begin
with DBConnector.GetNDataset(5) as TCustomBufDataset do
begin
open;
next;
next;
edit;
FieldByName('name').AsString := 'changed';
post;
next;
delete;
CancelUpdates;
First;
for i := 1 to 5 do
begin
CheckEquals(i,fields[0].AsInteger);
CheckEquals('TestName'+inttostr(i),fields[1].AsString);
Next;
end;
end;
end;
procedure TTestBufDatasetDBBasics.TestBufDatasetCancelUpd1;
var i : byte;
begin
with DBConnector.GetNDataset(5) as TCustomBufDataset do
begin
open;
next;
next;
delete;
insert;
FieldByName('id').AsInteger := 100;
post;
CancelUpdates;
last;
for i := 5 downto 1 do
begin
CheckEquals(i,fields[0].AsInteger);
CheckEquals('TestName'+inttostr(i),fields[1].AsString);
Prior;
end;
end;
end;
procedure TTestBufDatasetDBBasics.TestMultipleDeleteUpdateBuffer;
var ds : TDataset;
begin
ds := DBConnector.GetNDataset(true,5);
ds.open;
with TCustomBufDataset(ds) do
begin
CheckEquals(0,ChangeCount);
edit;
fieldbyname('id').asinteger := 500;
fieldbyname('name').AsString := 'JoJo';
post;
CheckEquals(1,ChangeCount);
next; next;
Delete;
CheckEquals(2,ChangeCount);
Delete;
CheckEquals(3,ChangeCount);
CancelUpdates;
end;
ds.close;
end;
procedure TTestBufDatasetDBBasics.TestDoubleDelete;
var ds : TCustomBufDataset;
begin
ds := TCustomBufDataset(DBConnector.GetNDataset(true,5));
with ds do
begin
open;
next; next;
Delete;
Delete;
first;
CheckEquals(1,fieldbyname('id').AsInteger);
next;
CheckEquals(2,fieldbyname('id').AsInteger);
next;
CheckEquals(5,fieldbyname('id').AsInteger);
CancelUpdates;
first;
CheckEquals(1,fieldbyname('id').AsInteger);
next;
CheckEquals(2,fieldbyname('id').AsInteger);
next;
CheckEquals(3,fieldbyname('id').AsInteger);
next;
CheckEquals(4,fieldbyname('id').AsInteger);
next;
CheckEquals(5,fieldbyname('id').AsInteger);
end;
end;
procedure TTestBufDatasetDBBasics.TestReadOnly;
var
ds: TCustomBufDataset;
begin
ds := DBConnector.GetFieldDataset as TCustomBufDataset;
with ds do
begin
ReadOnly:=true;
CheckFalse(CanModify);
end;
end;
procedure TTestBufDatasetDBBasics.TestMergeChangeLog;
var
ds: TCustomBufDataset;
i: integer;
s, FN: string;
begin
ds := DBConnector.GetNDataset(5) as TCustomBufDataset;
with ds do
begin
open;
Edit;
i := fields[0].AsInteger;
s := fields[1].AsString;
fields[0].AsInteger:=64;
fields[1].AsString:='Changed1';
Post;
checkequals(fields[0].OldValue,i);
checkequals(fields[1].OldValue,s);
CheckEquals(ChangeCount,1);
Next;
Edit;
i := fields[0].AsInteger;
s := fields[1].AsString;
fields[0].AsInteger:=23;
fields[1].AsString:='Changed2';
Post;
checkequals(fields[0].OldValue,i);
checkequals(fields[1].OldValue,s);
CheckEquals(ChangeCount,2);
MergeChangeLog;
CheckEquals(ChangeCount,0);
checkequals(fields[0].OldValue,23);
checkequals(fields[1].OldValue,'Changed2');
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;
procedure TTestBufDatasetDBBasics.TestRevertRecord;
begin
with DBConnector.GetNDataset(True,1) as TCustomBufDataset do
begin
Open;
// update value in one record and revert them
Edit;
FieldByName('ID').AsInteger := 100;
Post;
CheckEquals(100, FieldByName('ID').AsInteger);
RevertRecord;
CheckEquals(1, FieldByName('ID').AsInteger, 'Revert modified #1');
// append new record and delete prior and revert appended
AppendRecord([3,'']);
InsertRecord([2,'']);
Prior;
Delete; // 1st
Next;
RevertRecord; // 3rd
CheckEquals(2, FieldByName('ID').AsInteger, 'Revert inserted #1a');
RevertRecord; // 2nd
CheckTrue(Eof, 'Revert inserted #1b');
CancelUpdates; // restores 1st deleted record
CheckEquals(1, FieldByName('ID').AsInteger, 'CancelUpdates #1');
Close;
end;
with DBConnector.GetNDataset(False,0) as TCustomBufDataset do
begin
Open;
// insert one record and revert them
InsertRecord([1,'']);
RevertRecord;
CheckTrue(Eof);
CheckEquals(0, ChangeCount);
// insert two records and revert them in inverse order
AppendRecord([2,'']);
InsertRecord([1,'']); // this record in update-buffer is linked to 2
RevertRecord;
CheckEquals(2, FieldByName('ID').AsInteger);
CheckEquals(1, ChangeCount);
RevertRecord;
CheckTrue(Eof);
CheckEquals(0, ChangeCount);
// insert more records and some delete and some revert
AppendRecord([4,'']);
InsertRecord([3,'']);
InsertRecord([2,'']);
InsertRecord([1,'']);
CheckEquals(4, ChangeCount);
Delete; // 1
CheckEquals(4, ChangeCount);
Next; // 3
RevertRecord;
CheckEquals(4, FieldByName('ID').AsInteger);
CheckEquals(3, ChangeCount);
Prior; // 2
RevertRecord;
CheckEquals(4, FieldByName('ID').AsInteger);
CheckEquals(2, ChangeCount);
CancelUpdates;
CheckTrue(Eof);
CheckEquals(0, ChangeCount);
Close;
end;
end;
procedure TTestBufDatasetDBBasics.FTestXMLDatasetDefinition(ADataset: TDataset);
var i : integer;
begin
CheckEquals(2,ADataset.FieldDefs.Count);
CheckEquals(2,ADataset.Fields.Count);
CheckTrue(SameText('ID',ADataset.Fields[0].FieldName));
CheckTrue(SameText('NAME',ADataset.Fields[1].FieldName));
CheckEquals(ord(ftString), ord(ADataset.Fields[1].DataType), 'Incorrect FieldType');
i := 1;
while not ADataset.EOF do
begin
CheckEquals('TestName'+inttostr(i),ADataset.FieldByName('name').AsString);
ADataset.Next;
inc(i);
end;
end;
procedure TTestBufDatasetDBBasics.TestAddIndexFieldType(AFieldType: TFieldType; ActiveDS : boolean);
var ds : TCustomBufDataset;
LastValue : Variant;
begin
ds := DBConnector.GetFieldDataset as TCustomBufDataset;
with ds do
begin
if not ActiveDS then
begin
AddIndex('testindex','F'+FieldTypeNames[AfieldType],[]);
IndexName:='testindex';
end
else
MaxIndexesCount := 3;
try
open;
except
if not assigned(ds.FindField('F'+FieldTypeNames[AfieldType])) then
Ignore('Fields of the type ' + FieldTypeNames[AfieldType] + ' are not supported by this type of dataset')
else
raise;
end;
if ActiveDS then
begin
if not assigned(ds.FindField('F'+FieldTypeNames[AfieldType])) then
Ignore('Fields of the type ' + FieldTypeNames[AfieldType] + ' are not supported by this type of dataset');
AddIndex('testindex','F'+FieldTypeNames[AfieldType],[]);
IndexName:='testindex';
First;
end;
LastValue:=null;
while not eof do
begin
if AFieldType=ftString then
CheckTrue(AnsiCompareStr(VarToStr(LastValue),VarToStr(FieldByName('F'+FieldTypeNames[AfieldType]).AsString))<=0,'Forward, Correct string value')
else
CheckTrue(LastValue<=FieldByName('F'+FieldTypeNames[AfieldType]).AsVariant,'Forward, Correct variant value');
LastValue:=FieldByName('F'+FieldTypeNames[AfieldType]).AsVariant;
Next;
end;
while not bof do
begin
if AFieldType=ftString then
CheckTrue(AnsiCompareStr(VarToStr(LastValue),VarToStr(FieldByName('F'+FieldTypeNames[AfieldType]).AsString))>=0,'Backward, Correct string value')
else
CheckTrue(LastValue>=FieldByName('F'+FieldTypeNames[AfieldType]).AsVariant,'Backward, Correct variant value');
LastValue:=FieldByName('F'+FieldTypeNames[AfieldType]).AsVariant;
Prior;
end;
end;
end;
procedure TTestBufDatasetDBBasics.TestAddIndexSmallInt;
begin
TestAddIndexFieldType(ftSmallint,False);
end;
procedure TTestBufDatasetDBBasics.TestAddIndexBoolean;
begin
TestAddIndexFieldType(ftBoolean,False);
end;
procedure TTestBufDatasetDBBasics.TestAddIndexFloat;
begin
TestAddIndexFieldType(ftFloat,False);
end;
procedure TTestBufDatasetDBBasics.TestAddIndexInteger;
begin
TestAddIndexFieldType(ftInteger,False);
end;
procedure TTestBufDatasetDBBasics.TestAddIndexLargeInt;
begin
TestAddIndexFieldType(ftLargeint,False);
end;
procedure TTestBufDatasetDBBasics.TestAddIndexDateTime;
begin
TestAddIndexFieldType(ftDateTime,False);
end;
procedure TTestBufDatasetDBBasics.TestAddIndexCurrency;
begin
TestAddIndexFieldType(ftCurrency,False);
end;
procedure TTestBufDatasetDBBasics.TestAddIndexBCD;
begin
TestAddIndexFieldType(ftBCD,False);
end;
procedure TTestBufDatasetDBBasics.TestAddIndexFmtBCD;
begin
TestAddIndexFieldType(ftFmtBCD,False);
end;
procedure TTestBufDatasetDBBasics.TestAddIndex;
var ds : TCustomBufDataset;
AFieldType : TFieldType;
FList : TStringList;
i : integer;
begin
ds := DBConnector.GetFieldDataset as TCustomBufDataset;
with ds do
begin
AFieldType:=ftString;
AddIndex('testindex','F'+FieldTypeNames[AfieldType],[]);
FList := TStringList.Create;
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;
IndexName:='testindex';
first;
i:=0;
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;
finally
flist.free;
end;
end;
end;
procedure TTestBufDatasetDBBasics.TestAddDescIndex;
var ds : TCustomBufDataset;
AFieldType : TFieldType;
FList : TStringList;
i : integer;
begin
ds := DBConnector.GetFieldDataset as TCustomBufDataset;
with ds do
begin
AFieldType:=ftString;
AddIndex('testindex','F'+FieldTypeNames[AfieldType],[],'F'+FieldTypeNames[AfieldType]);
FList := TStringList.Create;
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;
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 bof do
begin
inc(i);
CheckEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
Prior;
end;
finally
flist.free;
end;
end;
end;
procedure TTestBufDatasetDBBasics.TestAddCaseInsIndex;
var ds : TCustomBufDataset;
AFieldType : TFieldType;
FList : TStringList;
i : integer;
begin
ds := DBConnector.GetFieldDataset as TCustomBufDataset;
with ds do
begin
AFieldType:=ftString;
AddIndex('testindex','F'+FieldTypeNames[AfieldType],[],'','F'+FieldTypeNames[AfieldType]);
FList := TStringList.Create;
try
FList.Sorted:=true;
FList.Duplicates:=dupAccept;
open;
while not eof do
begin
flist.Add(FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
Next;
end;
IndexName:='testindex';
first;
i:=0;
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;
finally
FList.Free;
end;
end;
end;
procedure TTestBufDatasetDBBasics.TestInactSwitchIndex;
// Test if the default-index is properly build when the active index is not
// the default-index while opening then dataset
var ds : TCustomBufDataset;
AFieldType : TFieldType;
i : integer;
begin
ds := DBConnector.GetFieldDataset as TCustomBufDataset;
with ds do
begin
AFieldType:=ftString;
AddIndex('testindex','F'+FieldTypeNames[AfieldType],[]);
IndexName:='testindex';
open;
IndexName:=''; // This should set the default index (default_order)
first;
i := 0;
while not eof do
begin
CheckEquals(testStringValues[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
inc(i);
Next;
end;
end;
end;
procedure TTestBufDatasetDBBasics.TestAddIndexActiveDS;
begin
TestAddIndexFieldType(ftString,true);
end;
procedure TTestBufDatasetDBBasics.TestAddIndexEditDS;
var ds : TCustomBufDataset;
LastValue : String;
begin
ds := DBConnector.GetNDataset(True,5) as TCustomBufDataset;
with ds do
begin
MaxIndexesCount:=3;
open;
edit;
FieldByName('name').asstring := 'Zz';
post;
next;
next;
edit;
FieldByName('name').asstring := 'aA';
post;
AddIndex('test','name',[]);
first;
ds.IndexName:='test';
first;
LastValue:='';
while not eof do
begin
CheckTrue(AnsiCompareStr(LastValue,FieldByName('name').AsString)<=0);
LastValue:=FieldByName('name').AsString;
Next;
end;
end;
end;
procedure TTestBufDatasetDBBasics.TestIndexFieldNamesActive;
var ds : TCustomBufDataset;
AFieldType : TFieldType;
FList : TStringList;
i : integer;
begin
ds := DBConnector.GetFieldDataset as TCustomBufDataset;
with ds do
begin
AFieldType:=ftString;
FList := TStringList.Create;
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;
IndexFieldNames:='F'+FieldTypeNames[AfieldType];
first;
i:=0;
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;
CheckEquals('F'+FieldTypeNames[AfieldType],IndexFieldNames);
IndexFieldNames:='ID';
first;
i:=0;
while not eof do
begin
CheckEquals(testStringValues[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
inc(i);
Next;
end;
CheckEquals('ID',IndexFieldNames);
IndexFieldNames:='';
first;
i:=0;
while not eof do
begin
CheckEquals(testStringValues[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
inc(i);
Next;
end;
CheckEquals('',IndexFieldNames);
finally
flist.free;
end;
end;
end;
procedure TTestBufDatasetDBBasics.TestIndexCurRecord;
// Test if the currentrecord stays the same after an index change
var ds : TCustomBufDataset;
AFieldType : TFieldType;
i : integer;
OldID : Integer;
OldStringValue : string;
begin
ds := DBConnector.GetFieldDataset as TCustomBufDataset;
with ds do
begin
AFieldType:=ftString;
AddIndex('testindex','F'+FieldTypeNames[AfieldType],[]);
open;
for i := 0 to (testValuesCount div 3) do
Next;
OldID:=FieldByName('id').AsInteger;
OldStringValue:=FieldByName('F'+FieldTypeNames[AfieldType]).AsString;
IndexName:='testindex';
CheckEquals(OldID,FieldByName('id').AsInteger);
CheckEquals(OldStringValue,FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
next;
CheckTrue(OldStringValue<=FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
prior;
prior;
CheckTrue(OldStringValue>=FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
OldID:=FieldByName('id').AsInteger;
OldStringValue:=FieldByName('F'+FieldTypeNames[AfieldType]).AsString;
IndexName:='';
CheckEquals(OldID,FieldByName('id').AsInteger);
CheckEquals(OldStringValue,FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
next;
CheckEquals(OldID+1,FieldByName('ID').AsInteger);
prior;
prior;
CheckEquals(OldID-1,FieldByName('ID').AsInteger);
end;
end;
procedure TTestBufDatasetDBBasics.TestAddDblIndex;
var ds : TCustomBufDataset;
LastInteger : Integer;
LastString : string;
begin
ds := DBConnector.GetFieldDataset as TCustomBufDataset;
with ds do
begin
AddIndex('testindex','F'+FieldTypeNames[ftString]+';F'+FieldTypeNames[ftInteger],[]);
open;
IndexName:='testindex';
first;
LastString:='';
while not eof do
begin
CheckTrue(AnsiCompareStr(FieldByName('F'+FieldTypeNames[ftString]).AsString,LastString)>=0);
LastString:= FieldByName('F'+FieldTypeNames[ftString]).AsString;
LastInteger:=-MaxInt;
while (FieldByName('F'+FieldTypeNames[ftString]).AsString=LastString) and not eof do
begin
CheckTrue(FieldByName('F'+FieldTypeNames[ftInteger]).AsInteger>=LastInteger);
LastInteger:=FieldByName('F'+FieldTypeNames[ftInteger]).AsInteger;
next;
end;
end;
while not bof do
begin
CheckTrue(AnsiCompareStr(FieldByName('F'+FieldTypeNames[ftString]).AsString,LastString)<=0);
LastString:= FieldByName('F'+FieldTypeNames[ftString]).AsString;
LastInteger:=+MaxInt;
while (FieldByName('F'+FieldTypeNames[ftString]).AsString=LastString) and not bof do
begin
CheckTrue(FieldByName('F'+FieldTypeNames[ftInteger]).AsInteger<=LastInteger);
LastInteger:=FieldByName('F'+FieldTypeNames[ftInteger]).AsInteger;
prior;
end;
end;
end;
end;
procedure TTestBufDatasetDBBasics.TestIndexEditRecord;
// Tests index sorting for string field type by
// editing an existing record in the middle
// with a value at the end of the alphabet
var ds : TCustomBufDataset;
AFieldType : TFieldType;
OldStringValue : string;
begin
ds := DBConnector.GetFieldDataset as TCustomBufDataset;
with ds do
begin
AFieldType:=ftString;
AddIndex('testindex','F'+FieldTypeNames[AfieldType],[]);
IndexName:='testindex';
Open;
OldStringValue:=FieldByName('F'+FieldTypeNames[AfieldType]).AsString;
next; //Now on record 1
CheckTrue(AnsiCompareStr(OldStringValue,FieldByName('F'+FieldTypeNames[AfieldType]).AsString)<=0,'Record 0 must be smaller than record 1 with asc sorted index');
OldStringValue:=FieldByName('F'+FieldTypeNames[AfieldType]).AsString;
next; //Now on record 2
CheckTrue(AnsiCompareStr(OldStringValue,FieldByName('F'+FieldTypeNames[AfieldType]).AsString)<=0,'Record 1 must be smaller than record 2 with asc sorted index');
prior; //Now on record 1
edit;
FieldByName('F'+FieldTypeNames[AfieldType]).AsString := 'ZZZ'; //should be sorted last
post;
prior; // Now on record 0
// Check ZZZ is sorted on/after record 0
CheckTrue(AnsiCompareStr('ZZZ',FieldByName('F'+FieldTypeNames[AfieldType]).AsString)>=0, 'Prior>');
next;
next; // Now on record 2
// Check ZZZ is sorted on/before record 2
CheckTrue(AnsiCompareStr('ZZZ',FieldByName('F'+FieldTypeNames[AfieldType]).AsString)<=0, 'Next<');
close;
end;
end;
procedure TTestBufDatasetDBBasics.TestIndexAppendRecord;
var i: integer;
LastValue: string;
begin
// start with empty dataset
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)]);
// insert data at begining
IndexName:='';
First;
for i:=21 to 22 do
InsertRecord([i, inttostr(i)]);
// swith to index and check if records are ordered
IndexName := 'testindex';
LastValue := '';
First;
for i:=22 downto 0 do
begin
CheckEquals(23-i, RecNo, 'testindex.RecNo:');
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;
PrevValue : String;
begin
ds := DBConnector.GetFieldDataset as TCustomBufDataset;
with ds do
begin
AFieldType:=ftString;
IndexFieldNames:='F'+FieldTypeNames[AfieldType];
open;
PrevValue:='';
while not eof do
begin
CheckTrue(AnsiCompareStr(FieldByName('F'+FieldTypeNames[AfieldType]).AsString,PrevValue)>=0,IntToStr(RecNo)+': '+FieldByName('F'+FieldTypeNames[AfieldType]).AsString+'>='+PrevValue+' ?');
PrevValue:=FieldByName('F'+FieldTypeNames[AfieldType]).AsString;
Next;
end;
CheckEquals('F'+FieldTypeNames[AfieldType],IndexFieldNames);
end;
end;
procedure TTestBufDatasetDBBasics.TestIndexFieldNamesClosed;
var s : string;
bufds: TCustomBufDataset;
begin
bufds := DBConnector.GetNDataset(5) as TCustomBufDataset;
s := bufds.IndexFieldNames;
s := bufds.IndexName;
CheckEquals('',S,'Default index name');
bufds.CompareBookmarks(nil,nil);
end;
{$endif fpc}
procedure TTestCursorDBBasics.TestFirst;
var i : integer;
begin
with DBConnector.GetNDataset(true,14) do
begin
open;
CheckEquals(1,FieldByName('ID').AsInteger);
First;
CheckEquals(1,FieldByName('ID').AsInteger);
next;
CheckEquals(2,FieldByName('ID').AsInteger);
First;
CheckEquals(1,FieldByName('ID').AsInteger);
for i := 0 to 12 do
next;
CheckEquals(14,FieldByName('ID').AsInteger);
First;
CheckEquals(1,FieldByName('ID').AsInteger);
close;
end;
end;
procedure TTestCursorDBBasics.TestEofAfterFirst;
begin
with DBConnector.GetNDataset(0) do
begin
open;
CheckTrue(eof);
CheckTrue(BOF);
first;
CheckTrue(eof);
CheckTrue(BOF);
end;
end;
procedure TTestDBBasics.TestFieldDefinition(AFieldType: TFieldType; ADataSize: integer);
var
ADataSet: TDataset;
AField: TField;
i: integer;
begin
TestFieldDefinition(AFieldType, ADataSize, ADataSet, AField);
for i := 0 to testValuesCount-1 do
begin
CheckEquals(testValues[AFieldType,i], AField.AsString);
ADataSet.Next;
end;
ADataSet.Close;
end;
procedure TTestDBBasics.TestFieldDefinition(AFieldType: TFieldType; ADataSize: integer; out ADS: TDataset; out AFld: TField);
begin
ADS := DBConnector.GetFieldDataset;
ADS.Open;
AFld := ADS.FindField('F'+FieldTypeNames[AFieldType]);
{$ifdef fpc}
if not assigned (AFld) then
Ignore('Fields of the type ' + FieldTypeNames[AFieldType] + ' are not supported by this type of dataset');
{$endif fpc}
if ADataSize <> -1 then
TestFieldDefinition(AFld, AFieldType, ADataSize);
end;
procedure TTestDBBasics.TestFieldDefinition(AFld: TField; AFieldType: TFieldType; ADataSize: integer);
begin
CheckEquals(FieldTypeNames[AFieldType], FieldTypeNames[AFld.DataType], 'DataType');
CheckEquals(ADatasize, AFld.DataSize, 'DataSize');
end;
procedure TTestDBBasics.TestSupportIntegerFields;
var i : integer;
DS : TDataset;
Fld : TField;
DbfTableLevel: integer;
begin
if (uppercase(dbconnectorname)='DBF') then
begin
DbfTableLevel:=strtointdef(dbconnectorparams,4);
if not(DBFTableLevel in [7,30]) then
Ignore('TDBF: only Visual Foxpro and DBase7 support full integer range.');
end;
TestFieldDefinition(ftInteger,-1,DS,Fld);
for i := 0 to testValuesCount-1 do
begin
CheckEquals(testIntValues[i],Fld.AsInteger);
DS.Next;
end;
TestFieldDefinition(Fld,ftInteger,4);
DS.Close;
end;
procedure TTestDBBasics.TestSupportSmallIntFields;
var i : byte;
ds : TDataset;
Fld : TField;
begin
if (uppercase(dbconnectorname)='DBF') then
Ignore('TDBF: Smallint support only from -999 to 9999');
TestFieldDefinition(ftSmallint,-1,ds,Fld);
for i := 0 to testValuesCount-1 do
begin
CheckEquals(testSmallIntValues[i],Fld.AsInteger);
ds.Next;
end;
TestFieldDefinition(Fld,ftSmallint,2);
ds.Close;
end;
procedure TTestDBBasics.TestSupportWordFields;
var i : byte;
ds : TDataset;
Fld : TField;
begin
TestFieldDefinition(ftWord,2,ds,Fld);
for i := 0 to testValuesCount-1 do
begin
CheckEquals(testWordValues[i],Fld.AsInteger);
ds.Next;
end;
ds.Close;
end;
procedure TTestDBBasics.TestSupportStringFields;
var i : byte;
ds : TDataset;
Fld : TField;
begin
TestFieldDefinition(ftString, 10*DBConnector.CharSize+1, ds, Fld);
for i := 0 to testValuesCount-1 do
begin
if (uppercase(dbconnectorname)<>'DBF') then
CheckEquals(testStringValues[i],Fld.AsString)
else {DBF right-trims spaces in string fields }
CheckEquals(TrimRight(testStringValues[i]),Fld.AsString);
ds.Next;
end;
ds.Close;
end;
procedure TTestDBBasics.TestSupportBooleanFields;
var i : byte;
ds : TDataset;
Fld : TField;
begin
TestFieldDefinition(ftBoolean,2,ds,Fld);
for i := 0 to testValuesCount-1 do
begin
CheckEquals(testBooleanValues[i],Fld.AsBoolean);
ds.Next;
end;
ds.Close;
end;
procedure TTestDBBasics.TestSupportBooleanFieldDisplayValue;
var
ds : TDataset;
Fld : TField;
BoolFld : TBooleanField absolute Fld;
begin
TestFieldDefinition(ftBoolean,2,ds,Fld);
CheckEquals(TBooleanField,Fld.ClassType,'Correct class');
BoolFld.DisplayValues:='+';
if ds.IsUniDirectional then
begin
CheckEquals('+',Fld.DisplayText,'Correct true'); // 1st record
ds.Next;
CheckEquals('',Fld.DisplayText,'Correct false'); // 2nd record
end
else
begin
ds.Edit;
Fld.AsBoolean:=True;
CheckEquals('+',Fld.DisplayText,'Correct true');
Fld.AsBoolean:=False;
CheckEquals('',Fld.DisplayText,'Correct false');
Fld.AsString:='+';
CheckEquals(true,Fld.AsBoolean,'Correct true');
Fld.AsString:='';
CheckEquals(False,Fld.AsBoolean,'Correct False');
BoolFld.DisplayValues:=';-';
CheckEquals('-',Fld.DisplayText,'Correct false');
end;
end;
procedure TTestDBBasics.TestSupportFloatFields;
var i : byte;
ds : TDataset;
Fld : TField;
begin
TestFieldDefinition(ftFloat,8,ds,Fld);
for i := 0 to testValuesCount-1 do
begin
CheckEquals(testFloatValues[i],Fld.AsFloat);
ds.Next;
end;
ds.Close;
end;
procedure TTestDBBasics.TestSupportLargeIntFields;
var i : byte;
ds : TDataset;
Fld : TField;
begin
TestFieldDefinition(ftLargeint,-1,ds,Fld);
for i := 0 to testValuesCount-1 do
begin
CheckEquals(testLargeIntValues[i],Fld.AsLargeInt);
ds.Next;
end;
TestFieldDefinition(Fld,ftLargeint,8);
ds.Close;
end;
procedure TTestDBBasics.TestSupportDateFields;
var i : byte;
ds : TDataset;
Fld : TField;
begin
TestFieldDefinition(ftDate,8,ds,Fld);
for i := 0 to testValuesCount-1 do
begin
CheckEquals(testDateValues[i], FormatDateTime('yyyy/mm/dd', Fld.AsDateTime, DBConnector.FormatSettings));
ds.Next;
end;
ds.Close;
end;
procedure TTestDBBasics.TestSupportTimeFields;
var i : byte;
ds : TDataset;
Fld : TField;
begin
TestFieldDefinition(ftTime,8,ds,Fld);
for i := 0 to testValuesCount-1 do
begin
CheckEquals(testTimeValues[i],DateTimeToTimeString(fld.AsDateTime));
ds.Next;
end;
ds.Close;
end;
procedure TTestDBBasics.TestSupportDateTimeFields;
var i : integer;
DS : TDataSet;
Fld : TField;
begin
TestFieldDefinition(ftDateTime,8,DS,Fld);
for i := 0 to testValuesCount-1 do
begin
CheckEquals(testValues[ftDateTime,i], DateTimeToStr(Fld.AsDateTime, DBConnector.FormatSettings));
DS.Next;
end;
DS.Close;
end;
procedure TTestDBBasics.TestSupportCurrencyFields;
var i : byte;
ds : TDataset;
Fld : TField;
begin
if (uppercase(dbconnectorname)='DBF') then
Ignore('This test does not apply to TDBF as they store currency in BCD fields.');
TestFieldDefinition(ftCurrency,8,ds,Fld);
for i := 0 to testValuesCount-1 do
begin
CheckEquals(testCurrencyValues[i],Fld.AsCurrency);
CheckEquals(testCurrencyValues[i],Fld.AsFloat);
ds.Next;
end;
ds.Close;
end;
procedure TTestDBBasics.TestSupportBCDFields;
var i : byte;
ds : TDataset;
Fld : TField;
begin
TestFieldDefinition(ftBCD,-1,ds,Fld);
for i := 0 to testValuesCount-1 do
begin
CheckEquals(testCurrencyValues[i], Fld.AsCurrency, 'AsCurrency');
CheckEquals(CurrToStr(testCurrencyValues[i]), Fld.AsString, 'AsString');
CheckEquals(testCurrencyValues[i], Fld.AsFloat, 'AsFloat');
ds.Next;
end;
TestFieldDefinition(Fld, ftBCD, 8);
ds.Close;
end;
procedure TTestDBBasics.TestSupportFmtBCDFields;
var i : byte;
ds : TDataset;
Fld : TField;
begin
TestFieldDefinition(ftFMTBcd,sizeof(TBCD),ds,Fld);
for i := 0 to testValuesCount-1 do
begin
CheckEquals(testFmtBCDValues[i], BCDToStr(Fld.AsBCD,DBConnector.FormatSettings), 'AsBCD');
CheckEquals(StrToFloat(testFmtBCDValues[i],DBConnector.FormatSettings), Fld.AsFloat, 1e-12, 'AsFloat');
ds.Next;
end;
ds.Close;
end;
procedure TTestDBBasics.TestSupportFixedStringFields;
var i : byte;
ds : TDataset;
Fld : TField;
begin
TestFieldDefinition(ftFixedChar, 10*DBConnector.CharSize+1, ds, Fld);
for i := 0 to testValuesCount-1 do
begin
if Fld.IsNull then // If the field is null, .AsString always returns an empty, non-padded string
CheckEquals(testStringValues[i],Fld.AsString)
else
{$ifdef fpc}
CheckEquals(PadRight(testStringValues[i],10),Fld.AsString);
{$else fpc}
CheckEquals(testStringValues[i],Fld.AsString);
{$endif fpc}
ds.Next;
end;
ds.Close;
end;
procedure TTestDBBasics.TestSupportBlobFields;
begin
TestFieldDefinition(ftBlob,0);
end;
procedure TTestDBBasics.TestSupportMemoFields;
begin
TestFieldDefinition(ftMemo,0);
end;
procedure TTestDBBasics.TestSupportByteFields;
begin
TestFieldDefinition(ftByte, SizeOf(Byte));
end;
procedure TTestDBBasics.TestSupportShortIntFields;
begin
TestFieldDefinition(ftShortInt, SizeOf(ShortInt));
end;
procedure TTestDBBasics.TestSupportExtendedFields;
begin
TestFieldDefinition(ftExtended, SizeOf(Extended));
end;
procedure TTestDBBasics.TestSupportSingleFields;
begin
TestFieldDefinition(ftSingle, SizeOf(Single));
end;
procedure TTestDBBasics.TestBlobBlobType;
// Verifies whether all created blob types actually have blobtypes that fall
// into the blobtype range (subset of datatype enumeration)
var
ds: TDataSet;
i:integer;
begin
ds := DBConnector.GetFieldDataset;
with ds do
begin;
Open;
for i:=0 to Fields.Count-1 do
begin
// This should only apply to blob types
if Fields[i].DataType in ftBlobTypes then
begin
// Type should certainly fall into wider old style, imprecise TBlobType
if not(TBlobField(Fields[i]).BlobType in ftBlobTypes) then
fail('BlobType for field '+
Fields[i].FieldName+' is not in old wide incorrect TBlobType range. Actual value: '+
inttostr(word(TBlobField(Fields[i]).BlobType)));
//.. it should also fall into the narrow ftBlobTypes
if not(TBlobField(Fields[i]).BlobType in ftBlobTypes) then
fail('BlobType for field '+
Fields[i].FieldName+' is not in ftBlobType range. Actual value: '+
inttostr(word(TBlobField(Fields[i]).BlobType)));
end;
end;
Close;
end;
end;
procedure TTestDBBasics.TestCalculatedField_OnCalcfields(DataSet: TDataSet);
begin
case dataset.fieldbyname('ID').asinteger of
1 : dataset.fieldbyname('CALCFLD').AsInteger := 5;
2 : dataset.fieldbyname('CALCFLD').AsInteger := 70000;
3 : dataset.fieldbyname('CALCFLD').Clear;
4 : dataset.fieldbyname('CALCFLD').AsInteger := 1234;
10 : dataset.fieldbyname('CALCFLD').Clear;
else
dataset.fieldbyname('CALCFLD').AsInteger := 1;
end;
CheckTrue(DataSet.State=dsCalcFields, 'State');
end;
procedure TTestDBBasics.TestCalculatedField;
var ds : TDataset;
AFld1, AFld2, AFld3 : Tfield;
begin
ds := DBConnector.GetNDataset(True,5);
with ds do
begin
AFld1 := TIntegerField.Create(ds);
AFld1.FieldName := 'ID';
AFld1.DataSet := ds;
AFld2 := TStringField.Create(ds);
AFld2.FieldName := 'NAME';
AFld2.DataSet := ds;
AFld3 := TIntegerField.Create(ds);
AFld3.FieldName := 'CALCFLD';
AFld3.DataSet := ds;
Afld3.FieldKind := fkCalculated;
CheckEquals(3,FieldCount);
ds.OnCalcFields := TestcalculatedField_OnCalcfields;
open;
CheckEquals(1, FieldByName('ID').AsInteger);
CheckEquals(5, FieldByName('CALCFLD').AsInteger);
next;
CheckEquals(70000,FieldByName('CALCFLD').AsInteger);
next;
CheckTrue(FieldByName('CALCFLD').IsNull, '#3 Null');
next;
CheckEquals(1234,FieldByName('CALCFLD').AsInteger);
if IsUniDirectional then
// The CanModify property is always False, so attempts to put the dataset into edit mode always fail
CheckException(Edit, EDatabaseError)
else
begin
Edit;
FieldByName('ID').AsInteger := 10;
Post;
CheckTrue(FieldByName('CALCFLD').IsNull, '#10 Null');
end;
close;
AFld1.Free;
AFld2.Free;
AFld3.Free;
end;
end;
procedure TTestDBBasics.TestCanModifySpecialFields;
var ds : TDataset;
lds : TDataset;
fld : TField;
begin
lds := DBConnector.GetNDataset(10);
ds := DBConnector.GetNDataset(5);
with ds do
begin
Fld := TIntegerField.Create(ds);
Fld.FieldName:='ID';
Fld.DataSet:=ds;
Fld := TStringField.Create(ds);
Fld.FieldName:='LookupFld';
Fld.FieldKind:=fkLookup;
Fld.DataSet:=ds;
Fld.LookupDataSet:=lds;
Fld.LookupResultField:='NAME';
Fld.LookupKeyFields:='ID';
Fld.KeyFields:='ID';
lds.Open;
Open;
if IsUniDirectional then
// The CanModify property is always False for UniDirectional datasets
CheckFalse(FieldByName('ID').CanModify)
else
CheckTrue(FieldByName('ID').CanModify);
CheckFalse(FieldByName('LookupFld').CanModify);
CheckFalse(FieldByName('ID').ReadOnly);
CheckFalse(FieldByName('LookupFld').ReadOnly);
CheckEquals(1,FieldByName('ID').AsInteger);
if IsUniDirectional then
// Lookup fields are not supported by UniDirectional datasets
CheckTrue(FieldByName('LookupFld').IsNull)
else
CheckEquals('TestName1',FieldByName('LookupFld').AsString);
Next;
Next;
CheckEquals(3,FieldByName('ID').AsInteger);
if IsUniDirectional then
CheckTrue(FieldByName('LookupFld').IsNull)
else
CheckEquals('TestName3',FieldByName('LookupFld').AsString);
Close;
lds.Close;
end;
end;
procedure TTestDBBasics.TestDoubleClose;
begin
with DBConnector.GetNDataset(1) do
begin
close;
close;
open;
close;
close;
end;
end;
procedure TTestDBBasics.TestFieldDefsUpdate;
begin
// FieldDefs.Update is called also by Lazarus IDE Fields editor
with DBConnector.GetNDataset(0) do
begin
// call Update on closed unprepared dataset
FieldDefs.Update;
CheckEquals(2, FieldDefs.Count);
end;
end;
procedure TTestDBBasics.TestAssignFieldftString;
var AParam : TParam;
AField : TField;
begin
AParam := TParam.Create(nil);
with DBConnector.GetNDataset(1) do
begin
open;
AField := fieldbyname('name');
AParam.AssignField(AField);
CheckEquals(ord(ftString), ord(AParam.DataType), 'DataType');
close;
end;
AParam.Free;
end;
procedure TTestDBBasics.TestAssignFieldftFixedChar;
var AParam : TParam;
AField : TField;
begin
AParam := TParam.Create(nil);
with DBConnector.GetNDataset(1) do
begin
open;
AField := fieldbyname('name');
(AField as tstringfield).FixedChar := true;
AParam.AssignField(AField);
CheckEquals(ord(ftFixedChar), ord(AParam.DataType), 'DataType');
close;
end;
AParam.Free;
end;
procedure TTestCursorDBBasics.TestBug7007;
var
datalink1: tdatalink;
datasource1: tdatasource;
query1: TDataSet;
begin
query1:= DBConnector.GetNDataset(6);
datalink1:= TTestDataLink.create;
datasource1:= tdatasource.create(nil);
try
datalink1.datasource:= datasource1;
datasource1.dataset:= query1;
datalink1.datasource:= datasource1;
DataEvents := '';
query1.open;
datalink1.buffercount:= query1.recordcount;
CheckEquals('deUpdateState:0;',DataEvents);
CheckEquals(0, datalink1.ActiveRecord);
CheckEquals(6, datalink1.RecordCount);
CheckEquals(6, query1.RecordCount);
CheckEquals(1, query1.RecNo);
DataEvents := '';
query1.append;
CheckEquals('deCheckBrowseMode:0;deUpdateState:0;deDataSetChange:0;DataSetChanged;',DataEvents);
CheckEquals(5, datalink1.ActiveRecord);
CheckEquals(6, datalink1.RecordCount);
CheckEquals(6, query1.RecordCount);
CheckTrue(query1.RecNo in [0,7]);
DataEvents := '';
query1.cancel;
CheckEquals('deCheckBrowseMode:0;deUpdateState:0;deDataSetChange:0;DataSetChanged;',DataEvents);
CheckEquals(5, datalink1.ActiveRecord);
CheckEquals(6, datalink1.RecordCount);
CheckEquals(6, query1.RecordCount);
CheckEquals(6, query1.RecNo);
finally
datalink1.free;
datasource1.free;
end;
end;
procedure TTestCursorDBBasics.TestBug6893;
var
datalink1: tdatalink;
datasource1: tdatasource;
query1: TDataSet;
begin
query1:= DBConnector.GetNDataset(25);
datalink1:= TDataLink.create;
datasource1:= tdatasource.create(nil);
try
datalink1.datasource:= datasource1;
datasource1.dataset:= query1;
datalink1.buffercount:= 5;
query1.active := true;
query1.MoveBy(20);
{$ifdef fpc}
CheckEquals(5, THackDataLink(datalink1).Firstrecord);
CheckEquals(4, datalink1.ActiveRecord);
CheckEquals(21, query1.RecNo);
query1.active := False;
CheckEquals(0, THackDataLink(datalink1).Firstrecord);
CheckEquals(0, datalink1.ActiveRecord);
query1.active := true;
CheckEquals(0, THackDataLink(datalink1).Firstrecord);
CheckEquals(0, datalink1.ActiveRecord);
CheckEquals(1, query1.RecNo);
{$endif fpc}
finally
datalink1.free;
datasource1.free;
end;
end;
procedure TTestCursorDBBasics.TestNullAtOpen;
begin
with dbconnector.getndataset(0) do
begin
active:= true;
CheckTrue(fieldbyname('id').IsNull,'Field isn''t NULL on a just-opened empty dataset');
append;
CheckTrue(fieldbyname('id').IsNull,'Field isn''t NULL after append on an empty dataset');
fieldbyname('id').asinteger:= 123;
cancel;
CheckTrue(fieldbyname('id').IsNull,'Field isn''t NULL after cancel');
end;
end;
{ TDBBasicsUniDirectionalTestSetup }
{$ifdef fpc}
procedure TDBBasicsUniDirectionalTestSetup.OneTimeSetup;
begin
inherited OneTimeSetup;
DBConnector.TestUniDirectional:=true;
end;
procedure TDBBasicsUniDirectionalTestSetup.OneTimeTearDown;
begin
DBConnector.TestUniDirectional:=false;
inherited OneTimeTearDown;
end;
{$endif fpc}
initialization
{$ifdef fpc}
RegisterTestDecorator(TDBBasicsTestSetup, TTestDBBasics);
RegisterTestDecorator(TDBBasicsTestSetup, TTestCursorDBBasics);
// 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);
end;
{$else fpc}
RegisterTest(TTestDBBasics.Suite);
{$endif fpc}
end.
Reference in New Issue View Git Blame Copy Permalink