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

* Added ftCurrency and ftBCD-fields tests

Browse Source 
* Renamed testname which was too long for testsuite-database
 * Fixed some TFiels.Size issues with postgres
 * Added money support to TPQConnection

git-svn-id: trunk@8871 -
This commit is contained in:
joost 2007-10-21 09:19:35 +00:00
parent ce4acf5b49
commit 575406dbc9
5 changed files with 73 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
packages/fcl-db/src/sqldb/postgres/pqconnection.pp
View File

@ -39,7 +39,7 @@ type
FConnectString : string;
FSQLDatabaseHandle : pointer;
FIntegerDateTimes : boolean;
function TranslateFldType(Type_Oid : integer) : TFieldType;
function TranslateFldType(res : PPGresult; Tuple : integer; var Size : integer) : TFieldType;
procedure ExecuteDirectPG(const Query : String);
protected
procedure DoInternalConnect; override;
@ -109,6 +109,7 @@ const Oid_Bool = 16;
Oid_int2 = 21;
Oid_Int4 = 23;
Oid_Float4 = 700;
Oid_Money = 790;
Oid_Float8 = 701;
Oid_Unknown = 705;
Oid_bpchar = 1042;
@ -374,12 +375,21 @@ begin
end;
function TPQConnection.TranslateFldType(Type_Oid : integer) : TFieldType;
function TPQConnection.TranslateFldType(res : PPGresult; Tuple : integer; var Size : integer) : TFieldType;
begin
case Type_Oid of
Size := 0;
case PQftype(res,Tuple) of
Oid_varchar,Oid_bpchar,
Oid_name : Result := ftstring;
Oid_name : begin
Result := ftstring;
size := PQfsize(Res, Tuple);
if (size = -1) then
begin
size := pqfmod(res,Tuple)-4;
if size = -5 then size := dsMaxStringSize;
end
end;
// Oid_text : Result := ftstring;
Oid_text : Result := ftBlob;
Oid_oid : Result := ftInteger;
@ -392,7 +402,11 @@ begin
Oid_Date : Result := ftDate;
Oid_Time : Result := ftTime;
Oid_Bool : Result := ftBoolean;
Oid_Numeric : Result := ftBCD;
Oid_Numeric : begin
Result := ftBCD;
size := PQfmod(res,Tuple)-4;
end;
Oid_Money : Result := ftCurrency;
Oid_Unknown : Result := ftUnknown;
else
Result := ftUnknown;
@ -610,19 +624,7 @@ begin
setlength(FieldBinding,nFields);
for i := 0 to nFields-1 do
begin
size := PQfsize(Res, i);
fieldtype := TranslateFldType(PQftype(Res, i));
if (fieldtype = ftstring) and (size = -1) then
begin
size := pqfmod(res,i)-4;
if size = -5 then size := dsMaxStringSize;
end
else if fieldtype = ftdate then
size := sizeof(double)
else if fieldtype = ftblob then
size := 0;
fieldtype := TranslateFldType(Res, i,size);
with TFieldDef.Create(FieldDefs, PQfname(Res, i), fieldtype,size, False, (i + 1)) do
FieldBinding[FieldNo-1] := i;
end;
@ -743,6 +745,11 @@ begin
Move(Cur, Buffer^, sizeof(currency));
end;
end;
ftCurrency :
begin
dbl := pointer(buffer);
dbl^ := BEtoN(PInteger(CurrBuff)^) / 100;
end;
ftBoolean:
pchar(buffer)[0] := CurrBuff[0]
else

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

@ -24,8 +24,8 @@ const MySQLdbTypes = [mysql40,mysql41,mysql50];
'',
'',
'FLOAT',
'DECIMAL(18,4)',
'',
'DECIMAL(18,4)',
'DATE',
'TIMESTAMP',
'TIMESTAMP',
@ -115,6 +115,7 @@ begin
FieldtypeDefinitions[ftBlob] := 'TEXT';
FieldtypeDefinitions[ftMemo] := 'TEXT';
FieldtypeDefinitions[ftGraphic] := '';
FieldtypeDefinitions[ftCurrency] := 'MONEY';
end;
if SQLDbType = INTERBASE then Fconnection := tIBConnection.Create(nil);
if SQLDbType = ODBC then Fconnection := tODBCConnection.Create(nil);

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

@ -36,7 +36,9 @@ type
procedure TestSupportFloatFields;
procedure TestSupportLargeIntFields;
procedure TestSupportDateFields;
procedure TestSupportCurrencyFields;
procedure TestSupportBCDFields;
procedure TestIsEmpty;
procedure TestAppendOnEmptyDataset;
procedure TestInsertOnEmptyDataset;
@ -741,6 +743,42 @@ begin
ds.close;
end;
procedure TTestDBBasics.TestSupportCurrencyFields;
var i : byte;
ds : TDataset;
Fld : TField;
begin
TestfieldDefinition(ftCurrency,8,ds,Fld);
for i := 0 to testValuesCount-1 do
begin
AssertEquals(testCurrencyValues[i],Fld.AsCurrency);
AssertEquals(testCurrencyValues[i],Fld.AsFloat);
ds.Next;
end;
ds.close;
end;
procedure TTestDBBasics.TestSupportBCDFields;
var i : byte;
ds : TDataset;
Fld : TField;
begin
TestfieldDefinition(ftBCD,8,ds,Fld);
for i := 0 to testValuesCount-1 do
begin
AssertEquals(testCurrencyValues[i],Fld.AsCurrency);
AssertEquals(testCurrencyValues[i],Fld.AsFloat);
ds.Next;
end;
ds.close;
end;
procedure TTestDBBasics.TestDoubleClose;
begin
with DBConnector.GetNDataset(1) do

4
packages/fcl-db/tests/testsqlfieldtypes.pas
View File

@ -26,7 +26,7 @@ type
procedure TearDown; override;
procedure RunTest; override;
published
procedure TestInsertLargeStringFields; // bug 9600
procedure TestInsertLargeStrFields; // bug 9600
procedure TestRowsAffected; // bug 9758
procedure TestStringsReplace;
procedure TestCircularParams;
@ -872,7 +872,7 @@ begin
inherited RunTest;
end;
procedure TTestFieldTypes.TestInsertLargeStringFields;
procedure TTestFieldTypes.TestInsertLargeStrFields;
begin
with TSQLDBConnector(DBConnector) do
begin

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

@ -80,6 +80,7 @@ const
const
testValuesCount = 25;
testFloatValues : Array[0..testValuesCount-1] of double = (-maxSmallint-1,-maxSmallint,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint+1,0.123456,-0.123456,4.35,12.434E7,9.876e-5,123.45678,2.4,3.2,0.4,23);
testCurrencyValues : Array[0..testValuesCount-1] of currency = (-100,-65.5,-54.34,-43.34,-2.50,-0.2,45.40,0.3,45.4,127,128,255,256,45,0.3,45.4,127,128,255,256,45,1234.56,43.23,43.43,99.88);
testIntValues : Array[0..testValuesCount-1] of integer = (-maxInt,-maxInt+1,-maxSmallint-1,-maxSmallint,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint+1,MaxInt-1,MaxInt,100,130,150,-150,-132,234);
testSmallIntValues : Array[0..testValuesCount-1] of smallint = (-maxSmallint,-maxSmallint+1,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint-1,100,110,120,130,150,-150,-132,234,231,42);
testLargeIntValues : Array[0..testValuesCount-1] of smallint = (-MaxSIntValue,MaxSIntValue+1,-maxInt-1,-maxInt+1,-maxSmallint,-maxSmallint+1,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint-1,maxSmallint+1,MaxInt-1,MaxInt,MaxSIntValue-1,MaxSIntValue,235253244);
@ -228,6 +229,10 @@ begin
testValues[ftFloat,i] := FloatToStr(testFloatValues[i]);
testValues[ftSmallint,i] := IntToStr(testSmallIntValues[i]);
testValues[ftInteger,i] := IntToStr(testIntValues[i]);
DecimalSeparator:=',';
testValues[ftCurrency,i] := CurrToStr(testCurrencyValues[i]);
DecimalSeparator:='.';
testValues[ftBCD,i] := CurrToStr(testCurrencyValues[i]);
end;
if dbconnectorname = '' then raise Exception.Create('There is no db-connector specified');