* fcl-db: tdbf: better support ftWord field type

* fcl-db tests: test ftWord for bufdataset, tdbf etc
To do: verify why all bufdataset export tests now get an access violation

git-svn-id: trunk@24545 -

packages/fcl-db/src/dbase/dbf_fields.pas

@@ -163,14 +163,18 @@ database.
     ... dbf supports:       -999 to  9999
                            4 digits max in practice
         therefore         DIGITS_SMALLINT = 4;
-    ftInteger  32 bits = -2147483648 to 2147483647
+    ftWord 16 bits sign = 0 to     65535
-    ... dbf supports:      -99999999 to  999999999                                        12345678901 = 11 digits max
+    ... dbf supports:     0 to 999999999 (in an N field)
-        therefore        DIGITS_INTEGER = 9;
+        therefore         DIGITS_WORD = 5;
-    ftLargeInt 64 bits = -9223372036854775808 to 9223372036854775807
+    ftInteger  32 bits  = -2147483648 to 2147483647
-    ... dbf supports:      -99999999999999999 to  999999999999999999
+    ... dbf supports:       -99999999 to  999999999                                        12345678901 = 11 digits max
-        therefore        DIGITS_LARGEINT = 18;
+        therefore         DIGITS_INTEGER = 9;
+    ftLargeInt 64 bits  = -9223372036854775808 to 9223372036854775807
+    ... dbf supports:       -99999999999999999 to  999999999999999999
+        therefore         DIGITS_LARGEINT = 18;
  *)
   DIGITS_SMALLINT = 4;
+  DIGITS_WORD = 5;
   DIGITS_INTEGER = 9;
   DIGITS_LARGEINT = 18;
 
@@ -448,7 +452,6 @@ begin
     ftAutoInc  :
       if DbfVersion=xVisualFoxPro then
         FNativeFieldType  := 'I'
-        //todo: set autoincrement fields: offset 18: add flag $0c; 19-22: value of next autoincrement; 23 value of autoincrement step value
       else
         FNativeFieldType  := '+'; //Apparently xbaseV/7+ only; not (Visual) Foxpro
     ftDateTime :
@@ -530,11 +533,16 @@ begin
         // FPC ftBCD/ftCurrency TFieldDef.Size has max 4 which is 4 bytes after decimal
         FPrecision := 4; //Total number of digits
       end;
-    ftSmallInt, ftWord:
+    ftSmallInt:
       begin
         FSize := DIGITS_SMALLINT;
         FPrecision := 0;
       end;
+    ftWord:
+      begin
+        FSize := DIGITS_WORD;
+        FPrecision := 0;
+      end;
     ftInteger, ftAutoInc:
       begin
         if DbfVersion in [xBaseVII,xVisualFoxPro] then

packages/fcl-db/tests/bufdatasettoolsunit.pas

@@ -152,6 +152,7 @@ begin
       FieldByName('FSTRING').AsString := testStringValues[i];
       FieldByName('FSMALLINT').AsInteger := testSmallIntValues[i];
       FieldByName('FINTEGER').AsInteger := testIntValues[i];
+      FieldByName('FWORD').AsInteger := testWordValues[i];
       FieldByName('FBOOLEAN').AsBoolean := testBooleanValues[i];
       FieldByName('FFLOAT').AsFloat := testFloatValues[i];
       FieldByName('FCURRENCY').AsCurrency := testCurrencyValues[i];

packages/fcl-db/tests/dbftoolsunit.pas

@@ -227,6 +227,7 @@ begin
       FieldByName('FSTRING').AsString := testStringValues[i];
       FieldByName('FSMALLINT').AsInteger := testSmallIntValues[i];
       FieldByName('FINTEGER').AsInteger := testIntValues[i];
+      FieldByName('FWORD').AsInteger := testWordValues[i];
       FieldByName('FBOOLEAN').AsBoolean := testBooleanValues[i];
       FieldByName('FFLOAT').AsFloat := testFloatValues[i];
       if (Result as TDBF).TableLevel >= TDBF_TABLELEVEL_FOXPRO then

packages/fcl-db/tests/testdbbasics.pas

@@ -32,6 +32,7 @@ type
 
     procedure TestSupportIntegerFields;
     procedure TestSupportSmallIntFields;
+    procedure TestSupportWordFields;
     procedure TestSupportStringFields;
     procedure TestSupportBooleanFields;
     procedure TestSupportFloatFields;
@@ -2297,8 +2298,17 @@ procedure TTestDBBasics.TestSupportIntegerFields;
 var i          : byte;
     ds         : TDataset;
     Fld        : TField;
+    DbfTableLevel: integer;
 
 begin
+  DbfTableLevel:=4;
+  if (uppercase(dbconnectorname)='DBF') then
+  begin
+    DbfTableLevel:=strtointdef(dbconnectorparams,4);
+    if not(DBFTableLevel in [7,30]) then
+      Ignore('TDBF: only Visual Foxpro and DBase7 support full integer range.');
+  end;
+
   TestfieldDefinition(ftInteger,4,ds,Fld);
 
   for i := 0 to testValuesCount-1 do
@@ -2328,6 +2338,22 @@ begin
   ds.close;
 end;
 
+procedure TTestDBBasics.TestSupportWordFields;
+var i          : byte;
+    ds         : TDataset;
+    Fld        : TField;
+
+begin
+  TestfieldDefinition(ftWord,2,ds,Fld);
+
+  for i := 0 to testValuesCount-1 do
+    begin
+    CheckEquals(testWordValues[i],Fld.AsInteger);
+    ds.Next;
+    end;
+  ds.close;
+end;
+
 
 procedure TTestDBBasics.TestSupportStringFields;
 

packages/fcl-db/tests/toolsunit.pas

@@ -107,6 +107,7 @@ const
   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);
+  testWordValues : Array[0..testValuesCount-1] of Word = (1,2,3,4,5,6,7,8,0,1,127,128,255,256,maxSmallint,maxSmallint+1,maxSmallInt-1,maxSmallInt,65535,100,130,150,151,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);
   testBooleanValues : Array[0..testValuesCount-1] of boolean = (true,false,false,true,true,false,false,true,false,true,true,true,false,false,false,false,true,true,true,true,false,true,true,false,false);