* Patch from Laco to add TSingleField

packages/fcl-db/src/base/bufdataset.pas

@@ -1645,6 +1645,7 @@ begin
                  ftBCD,
                  ftFmtBCD   : F1.AsBCD:=F2.AsBCD;
                  ftExtended : F1.AsExtended:=F2.AsExtended;
+                 ftSingle   : F1.AsSingle:=F2.AsSingle;
             else
               if (F1.DataType in UseStreams) then
                 begin
@@ -2539,8 +2540,9 @@ begin
       ftOraClob,
       ftWideMemo : result := sizeof(TBufBlobField);
     ftExtended   : Result := sizeof(Extended);
+    ftSingle     : Result := sizeof(Single);
   else
-    DatabaseErrorFmt(SUnsupportedFieldType,[Fieldtypenames[FieldDef.DataType]]);
+    DatabaseErrorFmt(SUnsupportedFieldType,[FieldTypeNames[FieldDef.DataType]]);
   end;
 {$IFDEF FPC_REQUIRES_PROPER_ALIGNMENT}
   result:=Align(result,4);

packages/fcl-db/src/base/db.pas

@@ -111,7 +111,8 @@ type
     ftWideString, ftLargeint, ftADT, ftArray, ftReference,
     ftDataSet, ftOraBlob, ftOraClob, ftVariant, ftInterface,
     ftIDispatch, ftGuid, ftTimeStamp, ftFMTBcd, ftFixedWideChar, ftWideMemo,
-    ftOraTimeStamp, ftOraInterval, ftLongWord, ftShortint, ftByte, ftExtended);
+    ftOraTimeStamp, ftOraInterval, ftLongWord, ftShortint, ftByte, ftExtended,
+    ftSingle);
 
 { Part of DBCommon, but temporarily defined here (bug 8206) }
 
@@ -794,7 +795,6 @@ type
     FMaxValue: Extended;
     FMinValue: Extended;
     FPrecision: Longint;
-    procedure SetCurrency(const AValue: Boolean);
     procedure SetPrecision(const AValue: Longint);
   protected
     function GetAsBCD: TBCD; override;
@@ -820,12 +820,51 @@ type
     function CheckRange(AValue: Extended) : Boolean;
     property Value: Extended read GetAsExtended write SetAsExtended;
   published
-    property Currency: Boolean read FCurrency write SetCurrency default False;
+    property Currency: Boolean read FCurrency write FCurrency default False;
     property MaxValue: Extended read FMaxValue write FMaxValue;
     property MinValue: Extended read FMinValue write FMinValue;
     property Precision: Longint read FPrecision write SetPrecision default 15;
   end;
 
+{ TSingleField }
+
+  TSingleField = class(TNumericField)
+  private
+    FCurrency: Boolean;
+    FMaxValue: Single;
+    FMinValue: Single;
+    FPrecision: Longint;
+    procedure SetPrecision(const AValue: Longint);
+  protected
+    function GetAsBCD: TBCD; override;
+    function GetAsSingle: Single; override;
+    function GetAsFloat: Double; override;
+    function GetAsLargeInt: LargeInt; override;
+    function GetAsLongWord: LongWord; override;
+    function GetAsInteger: Longint; override;
+    function GetAsString: string; override;
+    function GetAsVariant: variant; override;
+    function GetDataSize: Integer; override;
+    procedure GetText(var AText: string; ADisplayText: Boolean); override;
+    procedure SetAsBCD(const AValue: TBCD); override;
+    procedure SetAsSingle(AValue: Single); override;
+    procedure SetAsFloat(AValue: Double); override;
+    procedure SetAsLargeInt(AValue: LargeInt); override;
+    procedure SetAsLongWord(AValue: LongWord); override;
+    procedure SetAsInteger(AValue: Longint); override;
+    procedure SetAsString(const AValue: string); override;
+    procedure SetVarValue(const AValue: Variant); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    function CheckRange(AValue: Single) : Boolean;
+    property Value: Single read GetAsSingle write SetAsSingle;
+  published
+    property Currency: Boolean read FCurrency write FCurrency default False;
+    property MaxValue: Single read FMaxValue write FMaxValue;
+    property MinValue: Single read FMinValue write FMinValue;
+    property Precision: Longint read FPrecision write SetPrecision default 7;
+  end;
+
 { TBooleanField }
 
   TBooleanField = class(TField)
@@ -2318,12 +2357,13 @@ const
       {ftLongWord} varLongWord,
       {ftShortint} varShortint,
       {ftByte} varByte,
-      {ftExtended} varDouble
+      {ftExtended} varDouble,
+      {ftSingle} varSingle
     );
 
 
 Const
-  Fieldtypenames : Array [TFieldType] of String[15] =
+  FieldTypeNames : Array [TFieldType] of String[15] =
     (
       {ftUnknown} 'Unknown',
       {ftString} 'String',
@@ -2370,7 +2410,8 @@ Const
       {ftLongWord} 'LongWord',
       {ftShortint} 'Shortint',
       {ftByte} 'Byte',
-      {ftExtended} 'Extended'
+      {ftExtended} 'Extended',
+      {ftSingle} 'Single'
     );
 
 
@@ -2422,7 +2463,8 @@ const
       { ftLongWord} TLongWordField,
       { ftShortint} TShortintField,
       { ftByte} TByteField,
-      { ftExtended} TExtendedField
+      { ftExtended} TExtendedField,
+      { ftSingle} TSingleField
     );
 
   dsEditModes = [dsEdit, dsInsert, dsSetKey];

packages/fcl-db/src/base/dsparams.inc

@@ -824,7 +824,7 @@ end;
 
 Procedure TParam.SetAsSingle(AValue: Single);
 begin
-  FDataType:=ftFloat; // we doesn't have ftSingle ATM
+  FDataType:=ftSingle;
   Value:=AValue;
 end;
 
@@ -883,14 +883,14 @@ begin
   if FDataType = ftUnknown then
     case VarType(Value) of
       varBoolean  : FDataType:=ftBoolean;
-      varSmallint,
-      varShortInt,
-      varByte     : FDataType:=ftSmallInt;
+      varShortInt : FDataType:=ftShortInt;
+      varByte     : FDataType:=ftByte;
+      varSmallint : FDataType:=ftSmallInt;
       varWord,
       varInteger  : FDataType:=ftInteger;
       varCurrency : FDataType:=ftCurrency;
       varLongWord : FDataType:=ftLongWord;
-      varSingle,
+      varSingle   : FDataType:=ftSingle;
       varDouble   : FDataType:=ftFloat;
       varDate     : FDataType:=ftDateTime;
       varString,
@@ -1022,6 +1022,8 @@ begin
       ftFmtBCD   : Field.AsBCD:=AsFMTBCD;
       ftFixedWideChar,
       ftWideString: Field.AsWideString:=AsWideString;
+      ftExtended : Field.AsExtended:=Value;
+      ftSingle   : Field.AsSingle:=AsSingle;
     else
       If not (DataType in [ftCursor, ftArray, ftDataset,ftReference]) then
         DatabaseErrorFmt(SBadParamFieldType, [Name], DataSet);
@@ -1066,6 +1068,8 @@ begin
       ftFmtBCD   : AsFMTBCD:=Field.AsBCD;
       ftFixedWideChar,
       ftWideString: AsWideString:=Field.AsWideString;
+      ftExtended : Value:=Field.AsExtended;
+      ftSingle   : AsSingle:=Field.AsSingle;
     else
       If not (DataType in [ftCursor, ftArray, ftDataset,ftReference]) then
         DatabaseErrorFmt(SBadParamFieldType, [Name], DataSet);
@@ -1166,6 +1170,9 @@ begin
         end;
       end;
     ftFmtBCD   : PBCD(Buffer)^:=AsFMTBCD;
+    ftShortInt : PShortInt(Buffer)^:=AsShortInt;
+    ftByte     : PByte(Buffer)^:=AsByte;
+    ftSingle   : PSingle(Buffer)^:=AsSingle;
   else
     If not (DataType in [ftCursor, ftArray, ftDataset,ftReference]) then
       DatabaseErrorFmt(SBadParamFieldType, [Name], DataSet);
@@ -1207,6 +1214,9 @@ begin
     ftReference,
     ftCursor   : Result:=0;
     ftFmtBCD   : Result:=SizeOf(TBCD);
+    ftShortInt : Result:=SizeOf(ShortInt);
+    ftByte     : Result:=SizeOf(Byte);
+    ftSingle   : Result:=SizeOf(Single);
   else
     DatabaseErrorFmt(SBadParamFieldType,[Name],DataSet);
   end;
@@ -1290,6 +1300,9 @@ begin
     ftOraBlob,
     ftOraClob  : SetBlobData(Buffer, StrLen(PChar(Buffer)));
     ftFmtBCD   : AsFMTBCD:=PBCD(Buffer)^;
+    ftShortInt : AsShortInt:=PShortInt(Buffer)^;
+    ftByte     : AsByte:=PByte(Buffer)^;
+    ftSingle   : AsSingle:=PSingle(Buffer)^;
   else
     DatabaseErrorFmt(SBadParamFieldType,[Name],DataSet);
   end;

packages/fcl-db/src/base/fields.inc

@@ -2401,12 +2401,6 @@ begin
   FValidChars := [DefaultFormatSettings.DecimalSeparator, '+', '-', '0'..'9', 'E', 'e'];
 end;
 
-procedure TExtendedField.SetCurrency(const AValue: Boolean);
-begin
-  if FCurrency=AValue then Exit;
-  FCurrency:=AValue;
-end;
-
 procedure TExtendedField.SetPrecision(const AValue: Longint);
 begin
   if (AValue = -1) or (AValue > 1) then
@@ -2425,11 +2419,8 @@ begin
 end;
 
 function TExtendedField.GetAsExtended: Extended;
-var e: Extended;
 begin
-  if GetData(@e) then
-    Result := e
-  else
+  if not GetData(@Result) then
     Result := 0.0;
 end;
 
@@ -2567,6 +2558,173 @@ begin
     Result := True;
 end;
 
+{ TSingleField }
+
+constructor TSingleField.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  SetDataType(ftSingle);
+  FPrecision:=7;
+  FValidChars := [DefaultFormatSettings.DecimalSeparator, '+', '-', '0'..'9', 'E', 'e'];
+end;
+
+procedure TSingleField.SetPrecision(const AValue: Longint);
+begin
+  if (AValue = -1) or (AValue > 1) then
+    FPrecision := AValue
+  else
+    FPrecision := 2;
+end;
+
+function TSingleField.GetAsBCD: TBCD;
+var f: Single;
+begin
+  if GetData(@f) then
+    Result := DoubleToBCD(f)
+  else
+    Result := NullBCD;
+end;
+
+function TSingleField.GetAsSingle: Single;
+begin
+  if not GetData(@Result) then
+    Result := 0.0;
+end;
+
+function TSingleField.GetAsFloat: Double;
+begin
+  Result := GetAsSingle;
+end;
+
+function TSingleField.GetAsLargeInt: LargeInt;
+begin
+  Result := Round(GetAsSingle);
+end;
+
+function TSingleField.GetAsLongWord: LongWord;
+begin
+  Result := Round(GetAsSingle);
+end;
+
+function TSingleField.GetAsInteger: Longint;
+begin
+  Result := Round(GetAsSingle);
+end;
+
+function TSingleField.GetAsString: string;
+var f: Single;
+begin
+  if GetData(@f) then
+    Result := FloatToStr(f)
+  else
+    Result := '';
+end;
+
+function TSingleField.GetAsVariant: Variant;
+var f: Single;
+begin
+  if GetData(@f) then
+    Result := f
+  else
+    Result := Null;
+end;
+
+function TSingleField.GetDataSize: Integer;
+begin
+  Result:=SizeOf(Single);
+end;
+
+procedure TSingleField.GetText(var AText: string; ADisplayText: Boolean);
+var
+  Fmt: string;
+  f: Single;
+  Digits: integer;
+  ff: TFloatFormat;
+begin
+  AText:='';
+  if not GetData(@f) then Exit;
+  if ADisplayText or (FEditFormat = '') then
+    Fmt := FDisplayFormat
+  else
+    Fmt := FEditFormat;
+
+  Digits := 0;
+  if not FCurrency then
+    ff := ffGeneral
+  else
+    begin
+    Digits := DefaultFormatSettings.CurrencyDecimals;
+    if ADisplayText then
+      ff := ffCurrency
+    else
+      ff := ffFixed;
+    end;
+
+  if Fmt<>'' then
+    AText := FormatFloat(Fmt, f)
+  else
+    AText := FloatToStrF(f, ff, FPrecision, Digits);
+end;
+
+procedure TSingleField.SetAsBCD(const AValue: TBCD);
+begin
+  SetAsSingle(BCDToDouble(AValue));
+end;
+
+procedure TSingleField.SetAsSingle(AValue: Single);
+begin
+  if CheckRange(AValue) then
+    SetData(@AValue)
+  else
+    RangeError(AValue,FMinValue,FMaxValue);
+end;
+
+procedure TSingleField.SetAsFloat(AValue: Double);
+begin
+  SetAsSingle(AValue);
+end;
+
+procedure TSingleField.SetAsLargeInt(AValue: LargeInt);
+begin
+  SetAsSingle(AValue);
+end;
+
+procedure TSingleField.SetAsLongWord(AValue: LongWord);
+begin
+  SetAsSingle(AValue);
+end;
+
+procedure TSingleField.SetAsInteger(AValue: Longint);
+begin
+  SetAsSingle(AValue);
+end;
+
+procedure TSingleField.SetAsString(const AValue: string);
+var f: Single;
+begin
+  if AValue='' then
+    Clear
+  else
+    begin
+    if not TryStrToFloat(AValue, f) then
+      DatabaseErrorFmt(SNotAFloat, [AValue]);
+    SetAsSingle(f);
+    end;
+end;
+
+procedure TSingleField.SetVarValue(const AValue: Variant);
+begin
+  SetAsSingle(AValue);
+end;
+
+function TSingleField.CheckRange(AValue: Single) : Boolean;
+begin
+  if (FMinValue<>0) or (FMaxValue<>0) then
+    Result := (AValue>=FMinValue) and (AValue<=FMaxValue)
+  else
+    Result := True;
+end;
+
 { TBooleanField }
 
 function TBooleanField.GetAsBoolean: Boolean;

packages/fcl-db/src/base/xmldatapacketreader.pp

@@ -92,7 +92,7 @@ const
       '',
       'string',             // ftFixedChar
       'string.uni',         // ftWideString
-      'i8',
+      'i8',                 // ftLargeint
       '',
       '',
       '',
@@ -112,7 +112,8 @@ const
       'ui4',                // ftLongWord
       'i1',                 // ftShortint
       'ui1',                // ftByte
-      ''                    // ftExtended
+      '',                   // ftExtended
+      'r4'                  // ftSingle
     );
 
 resourcestring

packages/fcl-db/src/codegen/fpddcodegen.pp

@@ -405,7 +405,7 @@ Var
     ptWideString, ptInt64, ptCustom, ptCustom, ptCustom,
     ptCustom, ptCustom, ptCustom, ptCustom, ptCustom,
     ptCustom, ptAnsiString, ptDateTime, ptCurrency, ptWideString, ptWideString,
-    ptDateTime, ptDateTime, ptCustom, ptCustom, ptCustom, ptCustom);
+    ptDateTime, ptDateTime, ptCustom, ptCustom, ptCustom, ptCustom, ptSingle);
     
   PropTypeToVisibilityMap : TPropertyVisibilityMap = (
     vPrivate,

packages/fcl-db/src/datadict/fpdatadict.pp

@@ -722,7 +722,7 @@ Const
     'CHAR', 'BIGINT', '', '', '',
     '', '', '', '', '',
     '', '', 'TIMESTAMP', 'DECIMAL','CHAR','BLOB',
-    '', '', '', '', '', '');
+    '', '', '', '', '', '','FLOAT');
     
 { ---------------------------------------------------------------------
   Constants which can be localized

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

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

packages/fcl-db/src/export/fpfixedexport.pp

@@ -196,8 +196,9 @@ Const
     {ftOraInterval} 0,
     {ftLongWord} 10,
     {ftShortint} 4,
-    {ftByte} 1,
-    {ftExtended} 20
+    {ftByte} 3,
+    {ftExtended} 20,
+    {ftSingle} 8
     );
 
   Function CalcLbool: integer;

packages/fcl-db/src/export/fprtfexport.pp

@@ -152,7 +152,7 @@ Const
                   0,0,0,0,0,
                   0,0,0,0,0,
                   0,0,0,0,0,0,
-                  0,0,10,4,1,20);
+                  0,0,10,4,1,20,8);
 
 Var
   I  : Integer;

packages/fcl-db/src/export/fptexexport.pp

@@ -174,7 +174,7 @@ Const
                   0,0,0,0,0,
                   0,0,0,0,0,
                   0,0,0,0,0,0,
-                  0,0,10,4,1,20);
+                  0,0,10,4,1,20,8);
 
 Var
   I  : Integer;

packages/fcl-db/src/memds/memds.pp

@@ -490,6 +490,7 @@ begin
   ftShortInt: Result := SizeOf(ShortInt);
   ftByte:     Result := SizeOf(Byte);
   ftExtended: Result := SizeOf(Extended);
+  ftSingle  : Result := SizeOf(Single);
  else
   RaiseError(SErrFieldTypeNotSupported,[FD.Name]);
  end;
@@ -1184,6 +1185,7 @@ begin
                   ftDateTime : F1.AsDateTime:=F2.AsDateTime;
                   ftLongWord : F1.AsLongWord:=F2.AsLongWord;
                   ftExtended : F1.AsExtended:=F2.AsExtended;
+                  ftSingle   : F1.AsSingle:=F2.AsSingle;
                   else         F1.AsString:=F2.AsString;
                 end;
               end;

packages/fcl-db/src/sqldb/odbc/odbcconn.pas

@@ -392,9 +392,11 @@ var
   PVal, Buf, PStrLenOrInd: pointer;
   I, Size: integer;
   IntVal: clong;
+  UIntVal: culong;
   LargeVal: clonglong;
   StrVal: ansistring;
   WideStrVal: widestring;
+  SingleVal: cfloat;
   FloatVal: cdouble;
   DateVal: SQL_DATE_STRUCT;
   TimeVal: SQL_TIME_STRUCT;
@@ -428,7 +430,7 @@ begin
     StrLenOrInd:=0;
 
     case AParams[ParamIndex].DataType of
-      ftInteger, ftSmallInt, ftWord, ftAutoInc:
+      ftInteger, ftSmallInt, ftWord, ftAutoInc, ftShortInt, ftByte:
         begin
           IntVal:=AParams[ParamIndex].AsInteger;
           PVal:=@IntVal;
@@ -437,6 +439,15 @@ begin
           SqlType:=SQL_INTEGER;
           ColumnSize:=10;
         end;
+      ftLongWord:
+        begin
+          UIntVal:=AParams[ParamIndex].AsLongWord;
+          PVal:=@UIntVal;
+          Size:=SizeOf(UIntVal);
+          CType:=SQL_C_ULONG;
+          SqlType:=SQL_INTEGER;
+          ColumnSize:=9;
+        end;
       ftLargeInt:
         begin
           LargeVal:=AParams[ParamIndex].AsLargeInt;
@@ -486,6 +497,15 @@ begin
             else        SqlType:=SQL_WVARCHAR;
           end;
         end;
+      ftSingle:
+        begin
+          SingleVal:=AParams[ParamIndex].AsSingle;
+          PVal:=@SingleVal;
+          Size:=SizeOf(SingleVal);
+          CType:=SQL_C_FLOAT;
+          SqlType:=SQL_REAL;
+          ColumnSize:=7;
+        end;
       ftFloat:
         begin
           FloatVal:=AParams[ParamIndex].AsFloat;

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

@@ -877,7 +877,8 @@ const TypeStrings : array[TFieldType] of string =
       'Unknown',   // ftLongWord
       'Unknown',   // ftShortint
       'Unknown',   // ftByte
-      'Unknown'    // ftExtended
+      'Unknown',   // ftExtended
+      'real'       // ftSingle
     );
 
 

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

@@ -1925,6 +1925,7 @@ begin
     ftBcd      : Result := CurrToStr(Param.AsCurrency, FSQLFormatSettings);
     ftFloat    : Result := FloatToStr(Param.AsFloat, FSQLFormatSettings);
     ftFMTBcd   : Result := StringReplace(Param.AsString, DefaultFormatSettings.DecimalSeparator, FSQLFormatSettings.DecimalSeparator, []);
+    ftSingle   : Result := FloatToStr(Param.AsSingle, FSQLFormatSettings);
   else
     Result := Param.AsString;
   end; {case}

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

@@ -213,13 +213,17 @@ begin
       case P.DataType of
         ftInteger,
         ftAutoInc,
-        ftSmallint: checkerror(sqlite3_bind_int(fstatement,I,P.AsInteger));
-        ftWord:     checkerror(sqlite3_bind_int(fstatement,I,P.AsWord));
-        ftBoolean:  checkerror(sqlite3_bind_int(fstatement,I,ord(P.AsBoolean)));
-        ftLargeint: checkerror(sqlite3_bind_int64(fstatement,I,P.AsLargeint));
+        ftSmallint,
+        ftWord,
+        ftShortInt,
+        ftByte    : checkerror(sqlite3_bind_int(fstatement,I,P.AsInteger));
+        ftBoolean : checkerror(sqlite3_bind_int(fstatement,I,ord(P.AsBoolean)));
+        ftLargeint,
+        ftLongWord: checkerror(sqlite3_bind_int64(fstatement,I,P.AsLargeint));
         ftBcd,
         ftFloat,
-        ftCurrency: checkerror(sqlite3_bind_double(fstatement, I, P.AsFloat));
+        ftCurrency,
+        ftSingle  : checkerror(sqlite3_bind_double(fstatement, I, P.AsFloat));
         ftDateTime,
         ftDate,
         ftTime:     checkerror(sqlite3_bind_double(fstatement, I, P.AsFloat - JulianEpoch));

packages/fcl-db/tests/bufdatasettoolsunit.pas

@@ -159,6 +159,7 @@ begin
     FieldDefs.Add('FSHORTINT',ftShortInt);
     FieldDefs.Add('FBYTE',ftByte);
     FieldDefs.Add('FEXTENDED',ftExtended);
+    FieldDefs.Add('FSINGLE',ftSingle);
     CreateDataset;
     Open;
     for i := 0 to testValuesCount-1 do
@@ -191,6 +192,7 @@ begin
       FieldByName('FSHORTINT').AsInteger := testShortIntValues[i];
       FieldByName('FBYTE').AsInteger := testByteValues[i];
       FieldByName('FEXTENDED').AsExtended := testFloatValues[i];
+      FieldByName('FSINGLE').AsSingle := testSingleValues[i];
       Post;
     end;
     MergeChangeLog;

packages/fcl-db/tests/memdstoolsunit.pas

@@ -109,6 +109,7 @@ begin
     FieldDefs.Add('FSHORTINT',ftShortInt);
     FieldDefs.Add('FBYTE',ftByte);
     FieldDefs.Add('FEXTENDED',ftExtended);
+    FieldDefs.Add('FSINGLE',ftSingle);
     CreateTable;
     Open;
     for i := 0 to testValuesCount-1 do
@@ -138,6 +139,7 @@ begin
       FieldByName('FSHORTINT').AsInteger := testShortIntValues[i];
       FieldByName('FBYTE').AsInteger := testByteValues[i];
       FieldByName('FEXTENDED').AsExtended := testFloatValues[i];
+      FieldByName('FSINGLE').AsSingle := testSingleValues[i];
       Post;
       end;
     Close;

packages/fcl-db/tests/sqldbtoolsunit.pas

@@ -133,7 +133,8 @@ const
       {ftLongWord} '',
       {ftShortint} '',
       {ftByte} '',
-      {ftExtended} ''
+      {ftExtended} '',
+      {ftSingle} ''
     );
 
   // names as returned by ODBC SQLGetInfo(..., SQL_DBMS_NAME, ...) and GetConnectionInfo(citServerType)

packages/fcl-db/tests/testdbbasics.pas

@@ -51,6 +51,7 @@ type
     procedure TestSupportByteFields;
     procedure TestSupportShortIntFields;
     procedure TestSupportExtendedFields;
+    procedure TestSupportSingleFields;
 
     procedure TestBlobBlobType; //bug 26064
 
@@ -2738,23 +2739,34 @@ begin
 end;
 
 procedure TTestDBBasics.TestSupportBooleanFieldDisplayValue;
-var i          : byte;
-    ds         : TDataset;
-    Fld        : TField;
-    BoolFld : TBooleanField absolute Fld;
+var
+  ds      : TDataset;
+  Fld     : TField;
+  BoolFld : TBooleanField absolute Fld;
 begin
   TestFieldDefinition(ftBoolean,2,ds,Fld);
   CheckEquals(TBooleanField,Fld.ClassType,'Correct class');
   BoolFld.DisplayValues:='+';
-  ds.Edit;
-  Fld.AsBoolean:=True;
-  CheckEquals('+',Fld.DisplayText,'Correct true');
-  Fld.AsBoolean:=False;
-  CheckEquals('',Fld.DisplayText,'Correct false');
-  Fld.AsString:='+';
-  CheckEquals(true,Fld.AsBoolean,'Correct true');
-  Fld.AsString:='';
-  CheckEquals(False,Fld.AsBoolean,'Correct False');
+  if ds.IsUniDirectional then
+    begin
+    CheckEquals('+',Fld.DisplayText,'Correct true'); // 1st record
+    ds.Next;
+    CheckEquals('',Fld.DisplayText,'Correct false'); // 2nd record
+    end
+  else
+    begin
+    ds.Edit;
+    Fld.AsBoolean:=True;
+    CheckEquals('+',Fld.DisplayText,'Correct true');
+    Fld.AsBoolean:=False;
+    CheckEquals('',Fld.DisplayText,'Correct false');
+    Fld.AsString:='+';
+    CheckEquals(true,Fld.AsBoolean,'Correct true');
+    Fld.AsString:='';
+    CheckEquals(False,Fld.AsBoolean,'Correct False');
+    BoolFld.DisplayValues:=';-';
+    CheckEquals('-',Fld.DisplayText,'Correct false');
+    end;
 end;
 
 procedure TTestDBBasics.TestSupportFloatFields;
@@ -2955,6 +2967,11 @@ begin
   TestFieldDefinition(ftExtended, SizeOf(Extended));
 end;
 
+procedure TTestDBBasics.TestSupportSingleFields;
+begin
+  TestFieldDefinition(ftSingle, SizeOf(Single));
+end;
+
 procedure TTestDBBasics.TestBlobBlobType;
 // Verifies whether all created blob types actually have blobtypes that fall
 // into the blobtype range (subset of datatype enumeration)

packages/fcl-db/tests/testdbexport.pas

@@ -92,13 +92,13 @@ const
   // Alphabetically sorted for quick review:
   DBaseVIIUnsupported=[ftADT,ftArray,ftBCD,ftBytes,ftCurrency,ftCursor,ftDataSet,
     ftFixedWideChar,
-    ftFMTBcd,ftFmtMemo,ftGraphic,ftGuid,ftIDispatch,ftInterface,ftOraBlob,
-    ftOraClob,ftParadoxOle,ftReference,ftTime,ftTimeStamp,ftTypedBinary,
+    ftFMTBcd,ftFmtMemo,ftGraphic,ftGuid,ftIDispatch,ftInterface,ftLongWord,
+    ftOraBlob,ftOraClob,ftParadoxOle,ftReference,ftTime,ftTimeStamp,ftTypedBinary,
     ftUnknown,ftVarBytes,ftVariant,ftWidememo,ftWideString];
   FoxProUnsupported=  [ftADT,ftArray,      ftBytes,           ftCursor,ftDataSet,
     ftFixedWideChar,
-    ftFMTBcd,ftFmtMemo,ftGraphic,ftGuid,ftIDispatch,ftInterface,ftOraBlob,
-    ftOraClob,ftParadoxOle,ftReference,ftTime,ftTimeStamp,ftTypedBinary,
+    ftFMTBcd,ftFmtMemo,ftGraphic,ftGuid,ftIDispatch,ftInterface,ftLongWord,
+    ftOraBlob,ftOraClob,ftParadoxOle,ftReference,ftTime,ftTimeStamp,ftTypedBinary,
     ftUnknown,ftVarBytes,ftVariant,ftWideMemo,ftWideString];
 begin
   result:=true;

packages/fcl-db/tests/toolsunit.pas

@@ -125,7 +125,8 @@ 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);
+  testSingleValues : Array[0..testValuesCount-1] of single = (-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.4567,2.4,3.2,0.4,-2.3);
+  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.4567,2.4,3.2,0.4,23);
   testCurrencyValues : Array[0..testValuesCount-1] of currency = (-MaxLongInt-1,-MaxSmallint-1,-256,-255,-43.34,-2.5,-0.21,0,0.32,45.45,256,45,1234.56,12.34,0.12,MaxSmallInt+1,MaxLongInt+1,-6871947.67,68719476736,2748779069.44,922337203685.47,-92233720368547,99999999999999,-9223372036854.25,-9223372036854.7);
   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);
@@ -580,6 +581,7 @@ begin
     testValues[ftShortInt,i] := IntToStr(testShortIntValues[i]);
     testValues[ftByte,i] := IntToStr(testByteValues[i]);
     testValues[ftExtended,i] := FloatToStr(testFloatValues[i]);
+    testValues[ftSingle,i] := FloatToStr(testSingleValues[i]);
     end;
 
   if dbconnectorname = '' then raise Exception.Create('There is no db connector specified');

packages/fcl-sdo/src/das/sdo_das_utils.pas

@@ -59,14 +59,17 @@ const
 {$IFEND }
 {$IF Declared(ftLongWord)}
     , StringType, StringType, StringType, StringType 
-    //ftLongWord, ftShortint, ftByte, ftExtended, 
-    {$IFNDEF FPC}
-    , StringType, StringType, StringType,
-    // ftConnection, ftParams, ftStream,
-    StringType, StringType, StringType
-    //ftTimeStampOffset, ftObject, ftSingle
+    // ftLongWord, ftShortint, ftByte, ftExtended 
+    {$IFDEF FPC}
+    {$IF Declared(ftSingle)}
+    , StringType
+    {$IFEND}
+    // ftSingle
+    {$ELSE}
+    , StringType, StringType, StringType, StringType, StringType, StringType
+    // ftConnection, ftParams, ftStream, ftTimeStampOffset, ftObject, ftSingle
     {$ENDIF}
-{$IFEND }
+{$IFEND}
   );
 
 type

packages/fcl-web/src/restbridge/sqldbrestschema.pp

@@ -1227,7 +1227,8 @@ Const
      rftString, rftLargeInt, rftUnknown, rftUnknown, rftUnknown,              // ftWideString, ftLargeint, ftADT, ftArray, ftReference,
      rftUnknown, rftBlob, rftBlob, rftUnknown, rftUnknown,                    // ftDataSet, ftOraBlob, ftOraClob, ftVariant, ftInterface,
      rftUnknown, rftString, rftDateTime, rftFloat, rftString, rftString,      // ftIDispatch, ftGuid, ftTimeStamp, ftFMTBcd, ftFixedWideChar, ftWideMemo
-     rftDateTime, rftDateTime, rftInteger, rftInteger, rftInteger, rftFloat   // ftOraTimeStamp, ftOraInterval, ftLongWord, ftShortint, ftByte, ftExtended
+     rftDateTime, rftDateTime, rftInteger, rftInteger, rftInteger, rftFloat,  // ftOraTimeStamp, ftOraInterval, ftLongWord, ftShortint, ftByte, ftExtended
+     rftFloat                                                                 // Single
      );
 
 begin