mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-12 00:05:58 +02:00
* fcl-db: tests: test blobtype for blob fields; tests for mantis issue #26064
git-svn-id: trunk@27648 -
This commit is contained in:
parent
b1435f7756
commit
0ce9623ed8
@ -44,6 +44,8 @@ type
|
|||||||
procedure TestSupportBlobFields;
|
procedure TestSupportBlobFields;
|
||||||
procedure TestSupportMemoFields;
|
procedure TestSupportMemoFields;
|
||||||
|
|
||||||
|
procedure TestBlobBlobType; //bug 26064
|
||||||
|
|
||||||
procedure TestCalculatedField;
|
procedure TestCalculatedField;
|
||||||
procedure TestCanModifySpecialFields;
|
procedure TestCanModifySpecialFields;
|
||||||
|
|
||||||
@ -2630,7 +2632,7 @@ begin
|
|||||||
ds.close;
|
ds.close;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TTestDBBasics.TestSupportfmtBCDFields;
|
procedure TTestDBBasics.TestSupportFmtBCDFields;
|
||||||
var i : byte;
|
var i : byte;
|
||||||
ds : TDataset;
|
ds : TDataset;
|
||||||
Fld : TField;
|
Fld : TField;
|
||||||
@ -2700,6 +2702,32 @@ begin
|
|||||||
ds.close;
|
ds.close;
|
||||||
end;
|
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);
|
procedure TTestDBBasics.TestcalculatedField_OnCalcfields(DataSet: TDataSet);
|
||||||
begin
|
begin
|
||||||
case dataset.fieldbyname('ID').asinteger of
|
case dataset.fieldbyname('ID').asinteger of
|
||||||
|
Loading…
Reference in New Issue
Block a user