* Added ftCurrency and ftBCD-fields tests

* 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 -

packages/fcl-db/src/sqldb/postgres/pqconnection.pp

@@ -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(Res, i,size);
-      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;
-
       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

packages/fcl-db/tests/sqldbtoolsunit.pas

@@ -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);

packages/fcl-db/tests/testdbbasics.pas

@@ -36,6 +36,8 @@ type
     procedure TestSupportFloatFields;
     procedure TestSupportLargeIntFields;
     procedure TestSupportDateFields;
+    procedure TestSupportCurrencyFields;
+    procedure TestSupportBCDFields;
 
     procedure TestIsEmpty;
     procedure TestAppendOnEmptyDataset;
@@ -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

packages/fcl-db/tests/testsqlfieldtypes.pas

@@ -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

packages/fcl-db/tests/toolsunit.pas

@@ -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');