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

* fcl-db: tests: test blobtype for blob fields; tests for mantis issue #26064

Browse Source 
git-svn-id: trunk@27648 -
This commit is contained in:
reiniero 2014-04-24 15:08:31 +00:00
parent b1435f7756
commit 0ce9623ed8
1 changed files with 29 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -44,6 +44,8 @@ type
procedure TestSupportBlobFields;
procedure TestSupportMemoFields;
procedure TestBlobBlobType; //bug 26064
procedure TestCalculatedField;
procedure TestCanModifySpecialFields;
@ -2630,7 +2632,7 @@ begin
ds.close;
end;
procedure TTestDBBasics.TestSupportfmtBCDFields;
procedure TTestDBBasics.TestSupportFmtBCDFields;
var i : byte;
ds : TDataset;
Fld : TField;
@ -2700,6 +2702,32 @@ begin
ds.close;
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 [Low(TBlobType)..High(TBlobType)] then
begin
if not(TBlobField(Fields[i]).BlobType in [Low(TBlobType)..High(TBlobType)]) then
fail('BlobType for field '+
Fields[i].FieldName+' is not in blob type 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