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

* Patch from Laco to add tests

Browse Source 
(cherry picked from commit 6cc82086a9)
This commit is contained in:
Michaël Van Canneyt 2022-01-14 15:41:48 +01:00 committed by marcoonthegit
parent 6337d59160
commit d5cf7d02ac
8 changed files with 72 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1644,6 +1644,7 @@ begin
ftCurrency : F1.AsCurrency:=F2.AsCurrency;
ftBCD,
ftFmtBCD : F1.AsBCD:=F2.AsBCD;
ftExtended : F1.AsExtended:=F2.AsExtended;
else
if (F1.DataType in UseStreams) then
begin
@ -2536,7 +2537,8 @@ begin
ftTypedBinary,
ftOraBlob,
ftOraClob,
ftWideMemo : result := sizeof(TBufBlobField)
ftWideMemo : result := sizeof(TBufBlobField);
ftExtended : Result := sizeof(Extended);
else
DatabaseErrorFmt(SUnsupportedFieldType,[Fieldtypenames[FieldDef.DataType]]);
end;

7
packages/fcl-db/src/dbase/dbf_fields.pas
View File

@ -477,7 +477,7 @@ begin
, ftLargeInt
{$endif}
{$ifdef SUPPORT_LONGWORD}
, ftLongWord, ftShortInt, ftByte
, ftLongWord, ftShortInt, ftByte, ftExtended
{$endif}
:
FNativeFieldType := 'N'; //numerical
@ -576,6 +576,11 @@ begin
FSize := 3;
FPrecision := 0;
end;
ftExtended:
begin
FSize := 19;
FPrecision := 8;
end;
{$endif}
ftString {$ifdef SUPPORT_FIELDTYPES_V4}, ftFixedChar, ftWideString{$endif}:
begin

12
packages/fcl-db/src/memds/memds.pp
View File

@ -486,6 +486,10 @@ begin
ftVarBytes: result := FD.Size + SizeOf(Word);
ftBlob, ftMemo, ftWideMemo:
result := SizeOf(TMDSBlobField);
ftLongWord: Result := SizeOf(LongWord);
ftShortInt: Result := SizeOf(ShortInt);
ftByte: Result := SizeOf(Byte);
ftExtended: Result := SizeOf(Extended);
else
RaiseError(SErrFieldTypeNotSupported,[FD.Name]);
end;
@ -1170,11 +1174,15 @@ begin
ftBoolean : F1.AsBoolean:=F2.AsBoolean;
ftFloat : F1.AsFloat:=F2.AsFloat;
ftLargeInt : F1.AsLargeInt:=F2.AsLargeInt;
ftSmallInt : F1.AsInteger:=F2.AsInteger;
ftInteger : F1.AsInteger:=F2.AsInteger;
ftSmallInt,
ftInteger,
ftShortInt,
ftByte : F1.AsInteger:=F2.AsInteger;
ftDate : F1.AsDateTime:=F2.AsDateTime;
ftTime : F1.AsDateTime:=F2.AsDateTime;
ftDateTime : F1.AsDateTime:=F2.AsDateTime;
ftLongWord : F1.AsLongWord:=F2.AsLongWord;
ftExtended : F1.AsExtended:=F2.AsExtended;
else F1.AsString:=F2.AsString;
end;
end;

8
packages/fcl-db/tests/bufdatasettoolsunit.pas
View File

@ -90,9 +90,9 @@ begin
end;
function TbufdatasetDBConnector.InternalGetNDataset(n: integer): TDataset;
var BufDataset : TPersistentBufDataSet;
i : integer;
var
BufDataset : TPersistentBufDataSet;
i : integer;
begin
BufDataset := TPersistentBufDataSet.Create(nil);
with BufDataset do
@ -158,6 +158,7 @@ begin
FieldDefs.Add('FLONGWORD',ftLongWord);
FieldDefs.Add('FSHORTINT',ftShortInt);
FieldDefs.Add('FBYTE',ftByte);
FieldDefs.Add('FEXTENDED',ftExtended);
CreateDataset;
Open;
for i := 0 to testValuesCount-1 do
@ -189,6 +190,7 @@ begin
FieldByName('FLONGWORD').AsLongWord := testLongWordValues[i];
FieldByName('FSHORTINT').AsInteger := testShortIntValues[i];
FieldByName('FBYTE').AsInteger := testByteValues[i];
FieldByName('FEXTENDED').AsExtended := testFloatValues[i];
Post;
end;
MergeChangeLog;

8
packages/fcl-db/tests/memdstoolsunit.pas
View File

@ -105,6 +105,10 @@ begin
FieldDefs.Add('FWIDESTRING',ftWideString);
FieldDefs.Add('FFIXEDWIDECHAR',ftFixedWideChar);
FieldDefs.Add('FWIDEMEMO',ftWideMemo);
FieldDefs.Add('FLONGWORD',ftLongWord);
FieldDefs.Add('FSHORTINT',ftShortInt);
FieldDefs.Add('FBYTE',ftByte);
FieldDefs.Add('FEXTENDED',ftExtended);
CreateTable;
Open;
for i := 0 to testValuesCount-1 do
@ -130,6 +134,10 @@ begin
FieldByName('FWIDESTRING').AsWideString := testValues[ftWideString, i];
FieldByName('FFIXEDWIDECHAR').AsWideString := testValues[ftFixedWideChar, i];
FieldByName('FWIDEMEMO').AsWideString := testValues[ftWideMemo, i];
FieldByName('FLONGWORD').AsLongWord := testLongWordValues[i];
FieldByName('FSHORTINT').AsInteger := testShortIntValues[i];
FieldByName('FBYTE').AsInteger := testByteValues[i];
FieldByName('FEXTENDED').AsExtended := testFloatValues[i];
Post;
end;
Close;

2
packages/fcl-db/tests/sqldbtoolsunit.pas
View File

@ -150,7 +150,7 @@ const
// fall back mapping (e.g. in case GetConnectionInfo(citServerType) is not implemented)
SQLConnTypeToServerTypeMap : array[TSQLConnType] of TSQLServerType =
(ssMySQL,ssMySQL,ssMySQL,ssMySQL,ssMySQL,ssMySQL,ssMySQL,ssMysql,ssPostgreSQL,ssFirebird,ssUnknown,ssOracle,ssSQLite,ssMSSQL,ssSybase);
(ssMySQL,ssMySQL,ssMySQL,ssMySQL,ssMySQL,ssMySQL,ssMySQL,ssMySQL,ssPostgreSQL,ssFirebird,ssUnknown,ssOracle,ssSQLite,ssMSSQL,ssSybase);
function IdentifierCase(const s: string): string;

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

@ -20,6 +20,7 @@ type
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);
@ -47,6 +48,9 @@ type
procedure TestSupportFixedStringFields;
procedure TestSupportBlobFields;
procedure TestSupportMemoFields;
procedure TestSupportByteFields;
procedure TestSupportShortIntFields;
procedure TestSupportExtendedFields;
procedure TestBlobBlobType; //bug 26064
@ -2588,6 +2592,22 @@ begin
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;
@ -2911,34 +2931,28 @@ begin
end;
procedure TTestDBBasics.TestSupportBlobFields;
var i : byte;
ds : TDataset;
Fld : TField;
begin
TestFieldDefinition(ftBlob,0,ds,Fld);
for i := 0 to testValuesCount-1 do
begin
CheckEquals(testValues[ftBlob,i],Fld.AsString);
ds.Next;
end;
ds.Close;
TestFieldDefinition(ftBlob,0);
end;
procedure TTestDBBasics.TestSupportMemoFields;
var i : byte;
ds : TDataset;
Fld : TField;
begin
TestFieldDefinition(ftMemo,0,ds,Fld);
TestFieldDefinition(ftMemo,0);
end;
for i := 0 to testValuesCount-1 do
begin
CheckEquals(testValues[ftMemo,i],Fld.AsString);
ds.Next;
end;
ds.Close;
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.TestBlobBlobType;

3
packages/fcl-db/tests/toolsunit.pas
View File

@ -577,6 +577,9 @@ begin
testValues[ftDateTime,i] := testDateValues[i] + ' ' + testTimeValues[i]
else
testValues[ftDateTime,i] := testDateValues[i];
testValues[ftShortInt,i] := IntToStr(testShortIntValues[i]);
testValues[ftByte,i] := IntToStr(testByteValues[i]);
testValues[ftExtended,i] := FloatToStr(testFloatValues[i]);
end;
if dbconnectorname = '' then raise Exception.Create('There is no db connector specified');