paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-18 22:09:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-db: tests: cosmetic (comments + grouping similar tests)

Browse Source 
git-svn-id: trunk@27125 -
This commit is contained in:
lacak 2014-03-13 11:14:33 +00:00
parent f9bb91d722
commit 2d8c0942c7
1 changed files with 259 additions and 254 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

513
packages/fcl-db/tests/testdbbasics.pas
View File

@ -24,6 +24,7 @@ type
procedure TestcalculatedField_OnCalcfields(DataSet: TDataSet); procedure TestcalculatedField_OnCalcfields(DataSet: TDataSet);
published published
// fields
procedure TestSetFieldValues; procedure TestSetFieldValues;
procedure TestGetFieldValues; procedure TestGetFieldValues;
@ -43,9 +44,12 @@ type
procedure TestSupportBlobFields; procedure TestSupportBlobFields;
procedure TestSupportMemoFields; procedure TestSupportMemoFields;
procedure TestCalculatedField;
procedure TestCanModifySpecialFields;
// dataset
procedure TestDoubleClose; procedure TestDoubleClose;
procedure TestFieldDefsUpdate; procedure TestFieldDefsUpdate;
procedure TestCalculatedField;
procedure TestAssignFieldftString; procedure TestAssignFieldftString;
procedure TestAssignFieldftFixedChar; procedure TestAssignFieldftFixedChar;
procedure TestSelectQueryBasics; procedure TestSelectQueryBasics;
@ -53,13 +57,13 @@ type
procedure TestMove; // bug 5048 procedure TestMove; // bug 5048
procedure TestActiveBufferWhenClosed; procedure TestActiveBufferWhenClosed;
procedure TestEOFBOFClosedDataset; procedure TestEOFBOFClosedDataset;
procedure TestRecordcountAfterReopen; // partly bug 8228
procedure TestExceptionLocateClosed; // bug 13938
procedure TestDetectionNonMatchingDataset;
// events
procedure TestLayoutChangedEvents; procedure TestLayoutChangedEvents;
procedure TestDataEventsResync; procedure TestDataEventsResync;
procedure TestRecordcountAfterReopen; // partly bug 8228
procedure TestdeFieldListChange; procedure TestdeFieldListChange;
procedure TestExceptionLocateClosed; // bug 13938
procedure TestCanModifySpecialFields;
procedure TestDetectionNonMatchingDataset;
end; end;
{ TTestBufDatasetDBBasics } { TTestBufDatasetDBBasics }
@ -69,18 +73,17 @@ type
procedure FTestXMLDatasetDefinition(ADataset : TDataset); procedure FTestXMLDatasetDefinition(ADataset : TDataset);
procedure TestAddIndexFieldType(AFieldType : TFieldType; ActiveDS : boolean); procedure TestAddIndexFieldType(AFieldType : TFieldType; ActiveDS : boolean);
published published
procedure TestClosedIndexFieldNames; // bug 16695
procedure TestFileNameProperty; procedure TestFileNameProperty;
procedure TestClientDatasetAsMemDataset; procedure TestClientDatasetAsMemDataset;
procedure TestSaveAsXML; procedure TestSaveAsXML;
procedure TestIsEmpty; procedure TestIsEmpty;
procedure TestReadOnly;
// cached updates
procedure TestBufDatasetCancelUpd; //bug 6938 procedure TestBufDatasetCancelUpd; //bug 6938
procedure TestBufDatasetCancelUpd1; procedure TestBufDatasetCancelUpd1;
procedure TestMultipleDeleteUpdateBuffer; procedure TestMultipleDeleteUpdateBuffer;
procedure TestDoubleDelete; procedure TestDoubleDelete;
procedure TestReadOnly;
procedure TestMergeChangeLog; procedure TestMergeChangeLog;
procedure TestEditedBlobBeforePost; //bug 15376
// index tests // index tests
procedure TestAddIndexInteger; procedure TestAddIndexInteger;
procedure TestAddIndexSmallInt; procedure TestAddIndexSmallInt;
@ -100,7 +103,8 @@ type
procedure TestAddIndexEditDS; procedure TestAddIndexEditDS;
procedure TestIndexFieldNames; procedure TestIndexFieldNames;
procedure TestIndexFieldNamesAct; procedure TestIndexFieldNamesActive;
procedure TestIndexFieldNamesClosed; // bug 16695
procedure TestIndexCurRecord; procedure TestIndexCurRecord;
@ -156,9 +160,11 @@ type
procedure TestBug7007; procedure TestBug7007;
procedure TestBug6893; procedure TestBug6893;
procedure TestRequired; procedure TestRequired;
procedure TestOldValueObsolete;
procedure TestOldValue;
procedure TestModified; procedure TestModified;
// fields
procedure TestFieldOldValueObsolete;
procedure TestFieldOldValue;
procedure TestChangeBlobFieldBeforePost; //bug 15376
end; end;
@ -312,34 +318,6 @@ begin
end; end;
end; end;
procedure TTestDBBasics.TestdeFieldListChange;
var i,count : integer;
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.TestActiveBufferWhenClosed; procedure TTestDBBasics.TestActiveBufferWhenClosed;
begin begin
with DBConnector.GetNDataset(0) do with DBConnector.GetNDataset(0) do
@ -436,6 +414,33 @@ begin
end; end;
end; end;
procedure TTestDBBasics.TestdeFieldListChange;
var i,count : integer;
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; procedure TTestDBBasics.TestRecordcountAfterReopen;
var var
datalink1: tdatalink; datalink1: tdatalink;
@ -631,72 +636,6 @@ begin
end; end;
end; end;
procedure TTestCursorDBBasics.TestOldValueObsolete;
var v : variant;
bufds: 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 ...
bufds := DBConnector.GetNDataset(0) as TDataset;
bufds.Open;
bufds.InsertRecord([0,'name']);
v := VarToStr(bufds.fields[1].OldValue);
end;
procedure TTestCursorDBBasics.TestOldValue;
var OldValue: string;
Fmemo: TField;
begin
with DBConnector.GetFieldDataset as TCustomBufDataset 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');
MergeChangeLog;
CheckEquals('Changed Memo value', Fmemo.OldValue, 'Memo.OldValue after MergeChangeLog');
end;
end;
procedure TTestCursorDBBasics.TestModified; procedure TTestCursorDBBasics.TestModified;
begin begin
// Tests TDataSet.Modified property // Tests TDataSet.Modified property
@ -723,58 +662,6 @@ begin
end; end;
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.TestDetectionNonMatchingDataset; procedure TTestDBBasics.TestDetectionNonMatchingDataset;
var var
F: TField; F: TField;
@ -1032,6 +919,96 @@ begin
end; end;
end; end;
procedure TTestCursorDBBasics.TestFieldOldValueObsolete;
var v : variant;
bufds: 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 ...
bufds := DBConnector.GetNDataset(0) as TDataset;
bufds.Open;
bufds.InsertRecord([0,'name']);
v := VarToStr(bufds.fields[1].OldValue);
end;
procedure TTestCursorDBBasics.TestFieldOldValue;
var OldValue: string;
Fmemo: TField;
begin
with DBConnector.GetFieldDataset as TCustomBufDataset 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');
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
DS : TBufDataset;
begin
DS := TBufDataset.Create(nil);
DS.FieldDefs.Add('ID',ftInteger);
DS.FieldDefs.Add('NAME',ftString,50);
DS.FIeldDefs.Add('MEMO1',ftMemo);
DS.CreateDataset;
DS.Open;
with DS do
begin
Append;
FieldByName('ID').AsInteger:=1;
FieldByName('NAME').AsString:='NAME1';
FieldByName('MEMO1').AsString:='NAME1';
CheckEquals('NAME1',FieldByName('MEMO1').AsString,'Memo field must match before post');
Post;
end;
DS.Close;
end;
procedure TTestDBBasics.TestSetFieldValues; procedure TTestDBBasics.TestSetFieldValues;
var PassException : boolean; var PassException : boolean;
begin begin
@ -1477,16 +1454,6 @@ begin
end; end;
end; end;
procedure TTestBufDatasetDBBasics.TestClosedIndexFieldNames;
var s : string;
bufds: TCustomBufDataset;
begin
bufds := DBConnector.GetNDataset(5) as TCustomBufDataset;
s := bufds.IndexFieldNames;
s := bufds.IndexName;
bufds.CompareBookmarks(nil,nil);
end;
procedure TTestBufDatasetDBBasics.TestSaveAsXML; procedure TTestBufDatasetDBBasics.TestSaveAsXML;
var ds : TDataset; var ds : TDataset;
LoadDs: TCustomBufDataset; LoadDs: TCustomBufDataset;
@ -1742,30 +1709,6 @@ begin
end; end;
end; end;
procedure TTestBufDatasetDBBasics.TestEditedBlobBeforePost;
// Edit memo fields should read back new contents even before post
// Bug 15376
var
ds : TBufDataset;
begin
ds := TBufDataset.Create(nil);
DS.FieldDefs.Add('ID',ftInteger);
DS.FieldDefs.Add('NAME',ftString,50);
DS.FIeldDefs.Add('MEMO1',ftMemo);
DS.CreateDataset;
DS.Open;
with DS do
begin
Append;
FieldByName('ID').AsInteger:=1;
FieldByName('NAME').AsString:='NAME1';
FieldByName('MEMO1').AsString:='NAME1';
CheckEquals('NAME1',FieldByName('MEMO1').AsString,'Memo field must match before post');
Post;
end;
DS.Close;
end;
procedure TTestBufDatasetDBBasics.FTestXMLDatasetDefinition(ADataset: TDataset); procedure TTestBufDatasetDBBasics.FTestXMLDatasetDefinition(ADataset: TDataset);
var i : integer; var i : integer;
begin begin
@ -2095,7 +2038,7 @@ begin
end; end;
end; end;
procedure TTestBufDatasetDBBasics.TestIndexFieldNamesAct; procedure TTestBufDatasetDBBasics.TestIndexFieldNamesActive;
var ds : TCustomBufDataset; var ds : TCustomBufDataset;
AFieldType : TFieldType; AFieldType : TFieldType;
FList : TStringList; FList : TStringList;
@ -2393,70 +2336,18 @@ begin
end; end;
end; end;
procedure TTestBufDatasetDBBasics.TestIndexFieldNamesClosed;
var s : string;
bufds: TCustomBufDataset;
begin
bufds := DBConnector.GetNDataset(5) as TCustomBufDataset;
s := bufds.IndexFieldNames;
s := bufds.IndexName;
bufds.CompareBookmarks(nil,nil);
end;
{$endif fpc} {$endif fpc}
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(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 TTestCursorDBBasics.TestFirst; procedure TTestCursorDBBasics.TestFirst;
var i : integer; var i : integer;
begin begin
@ -2785,6 +2676,120 @@ begin
ds.close; ds.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(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; procedure TTestDBBasics.TestDoubleClose;
begin begin
with DBConnector.GetNDataset(1) do with DBConnector.GetNDataset(1) do