* Fixed support of TFmtBcd fields for sqlite3, bug #16853

 * Cleaned up accidentally comitted files in r16948

git-svn-id: trunk@16954 -

packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

@@ -491,6 +491,9 @@ var
  i64: int64;
  int1,int2: integer;
  str1: string;
+ bcd: tBCD;
+ StoreDecimalPoint: tDecimalPoint;
+ bcdstr: FmtBCDStringtype;
  ar1,ar2: TStringArray;
  st    : psqlite3_stmt;
 
@@ -509,7 +512,6 @@ begin
     ftBoolean  : pwordbool(buffer)^ := sqlite3_column_int(st,fnum)<>0;
     ftLargeInt : PInt64(buffer)^:= sqlite3_column_int64(st,fnum);
     ftBCD      : PCurrency(buffer)^:= FloattoCurr(sqlite3_column_double(st,fnum));
-    ftFmtBCD   : PBCD(buffer)^ := DoubleToBCD(sqlite3_column_double(st,fnum));
     ftFloat,
     ftCurrency : pdouble(buffer)^:= sqlite3_column_double(st,fnum);
     ftDateTime,
@@ -529,6 +531,27 @@ begin
               if int1 > 0 then 
                  move(sqlite3_column_text(st,fnum)^,buffer^,int1);
               end;
+    ftFmtBCD: begin
+              int1:= sqlite3_column_bytes(st,fnum);
+              if int1>255 then
+                int1:=255;
+              if int1 > 0 then
+                begin
+                SetLength(bcdstr,int1);
+                move(sqlite3_column_text(st,fnum)^,bcdstr[1],int1);
+                StoreDecimalPoint:=FmtBCD.DecimalPoint;
+                // sqlite always uses the point as decimal-point
+                FmtBCD.DecimalPoint:=DecimalPoint_is_Point;
+                if not TryStrToBCD(bcdstr,bcd) then
+                  // sqlite does the same, if the value can't be interpreted as a
+                  // number in sqlite3_column_int, return 0
+                  bcd := 0;
+                FmtBCD.DecimalPoint:=StoreDecimalPoint;
+                end
+              else
+                bcd := 0;
+              pBCD(buffer)^:= bcd;
+              end;
     ftMemo,
     ftBlob: CreateBlob:=True;
   else { Case }

packages/fcl-db/tests/dbtestframework.pas

@@ -18,10 +18,9 @@ uses
   SdfDSToolsUnit,
 // Units wich contains the tests
   testbasics,
-  testdbbasics,
   testfieldtypes,
   TestDatasources,
-  //  testdbbasics,
+  testdbbasics,
   TestBufDatasetStreams;
 
 var

packages/fcl-db/tests/testdbbasics.pas

@@ -27,11 +27,6 @@ type
     procedure TearDown; override;
   published
     procedure TestCancelUpdDelete1;
-
-
-    procedure TestSupportfmtBCDFields;
-
-
     procedure TestCancelUpdDelete2;
     procedure TestAppendInsertRecord;
     procedure TestBookmarks;
@@ -61,7 +56,7 @@ type
     procedure TestSupportDateFields;
     procedure TestSupportCurrencyFields;
     procedure TestSupportBCDFields;
-    //    procedure TestSupportfmtBCDFields;
+    procedure TestSupportfmtBCDFields;
     procedure TestSupportFixedStringFields;
 
     procedure TestAppendOnEmptyDataset;
@@ -151,7 +146,7 @@ type
 
 implementation
 
-uses bufdataset, variants, strutils, sqldb;
+uses bufdataset, variants, strutils, sqldb, FmtBCD;
 
 type THackDataLink=class(TdataLink);
 
@@ -1965,13 +1960,13 @@ var i          : byte;
     Fld        : TField;
 
 begin
-  TestfieldDefinition(ftFMTBcd,8,ds,Fld);
+  TestfieldDefinition(ftFMTBcd,sizeof(TBCD),ds,Fld);
 
   for i := 0 to testValuesCount-1 do
     begin
-    AssertEquals(CurrToStr(testCurrencyValues[i]),Fld.AsString);
-    AssertEquals(testCurrencyValues[i],Fld.AsCurrency);
-    AssertEquals(testCurrencyValues[i],Fld.AsFloat);
+    AssertEquals(testFmtBCDValues[i],Fld.AsString);
+    AssertEquals(testFmtBCDValues[i],Fld.AsBCD);
+    AssertEquals(StrToFloat(testFmtBCDValues[i]),Fld.AsFloat);
     ds.Next;
     end;
   ds.close;

packages/fcl-db/tests/toolsunit.pas

@@ -7,7 +7,7 @@ unit ToolsUnit;
 interface
 
 uses
-  Classes, SysUtils, DB, testdecorator;
+  Classes, SysUtils, DB, testdecorator, FmtBCD;
   
 Const MaxDataSet = 35;
   
@@ -95,6 +95,7 @@ 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);
+  testFmtBCDValues : Array[0..testValuesCount-1] of string = ('-100','-65.5','-54.3333','-43.3334','-2.5','-0.234567','45.4','0.3','45.414585','127','128','255','256','45','0.3','45.4','127','128','255','256','45','1234.56789','43.23','43.500001','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 LargeInt = ( -$7fffffffffffffff,-$7ffffffffffffffe,-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,$7fffffffffffffff-1,$7fffffffffffffff,235253244);
@@ -255,6 +256,7 @@ begin
   if DBConnectorRefCount>0 then exit;
   testValues[ftString] := testStringValues;
   testValues[ftFixedChar] := testStringValues;
+  testValues[ftFMTBcd] := testFmtBCDValues;
   for i := 0 to testValuesCount-1 do
     begin
     testValues[ftFloat,i] := FloatToStr(testFloatValues[i]);