Browse Source

* Better float parsing and conversion of integer to float where floats are accepted (bug 22934)

git-svn-id: trunk@22587 -
michael 13 years ago
parent
commit
2127e0e292
1 changed files with 44 additions and 16 deletions
  1. 44 16
      packages/fcl-base/src/fpexprpars.pp

+ 44 - 16
packages/fcl-base/src/fpexprpars.pp

@@ -653,6 +653,7 @@ Function ResultTypeName (AResult : TResultType) : String;
 Function CharToResultType(C : Char) : TResultType;
 Function CharToResultType(C : Char) : TResultType;
 Function BuiltinIdentifiers : TExprBuiltInManager;
 Function BuiltinIdentifiers : TExprBuiltInManager;
 Procedure RegisterStdBuiltins(AManager : TExprBuiltInManager);
 Procedure RegisterStdBuiltins(AManager : TExprBuiltInManager);
+function ArgToFloat(Arg: TFPExpressionResult): TExprFloat;
 
 
 Const
 Const
   AllBuiltIns = [bcStrings,bcDateTime,bcMath,bcBoolean,bcConversion,bcData,bcVaria,bcUser];
   AllBuiltIns = [bcStrings,bcDateTime,bcMath,bcBoolean,bcConversion,bcData,bcVaria,bcUser];
@@ -923,14 +924,21 @@ Var
   C : Char;
   C : Char;
   X : TExprFloat;
   X : TExprFloat;
   I : Integer;
   I : Integer;
+  prevC: Char;
 
 
 begin
 begin
   C:=CurrentChar;
   C:=CurrentChar;
-  while (not IsWordDelim(C)) and (C<>cNull) do
+  prevC := #0;
+  while (not IsWordDelim(C) or (prevC='E')) and (C<>cNull) do
     begin
     begin
-    If Not (IsDigit(C) or ((FToken<>'') and (Upcase(C)='E'))) then
+    If Not ( IsDigit(C)
+             or ((FToken<>'') and (Upcase(C)='E'))
+             or ((FToken<>'') and (C in ['+','-']) and (prevC='E'))
+           )
+    then
       ScanError(Format(SErrInvalidNumberChar,[C]));
       ScanError(Format(SErrInvalidNumberChar,[C]));
     FToken := FToken+C;
     FToken := FToken+C;
+    prevC := Upcase(C);
     C:=NextPos;
     C:=NextPos;
     end;
     end;
   Val(FToken,X,I);
   Val(FToken,X,I);
@@ -2808,9 +2816,18 @@ begin
     begin
     begin
     rtp:=CharToResultType(FID.ParameterTypes[i+1]);
     rtp:=CharToResultType(FID.ParameterTypes[i+1]);
     rta:=FArgumentNodes[i].NodeType;
     rta:=FArgumentNodes[i].NodeType;
-    If (rtp<>rta) then
+    If (rtp<>rta) then begin
+
+      // Automatically convert integers to floats in functions that return
+      // a float
+      if (rta = rtInteger) and (rtp = rtFloat) then begin
+        FArgumentNodes[i] := TIntToFloatNode(FArgumentNodes[i]);
+        exit;
+      end;
+
       RaiseParserError(SErrInvalidArgumentType,[I+1,ResultTypeName(rtp),ResultTypeName(rta)])
       RaiseParserError(SErrInvalidArgumentType,[I+1,ResultTypeName(rtp),ResultTypeName(rta)])
     end;
     end;
+    end;
 end;
 end;
 
 
 constructor TFPExprFunction.CreateFunction(AID: TFPExprIdentifierDef;
 constructor TFPExprFunction.CreateFunction(AID: TFPExprIdentifierDef;
@@ -2897,46 +2914,57 @@ end;
 
 
 }
 }
 
 
+function ArgToFloat(Arg: TFPExpressionResult): TExprFloat;
+// Utility function for the built-in math functions. Accepts also integers
+// in place of the floating point arguments. To be called in builtins or
+// user-defined callbacks having float results.
+begin
+  if Arg.ResultType = rtInteger then
+    result := Arg.resInteger
+  else
+    result := Arg.resFloat;
+end;
+
 // Math builtins
 // Math builtins
 
 
 Procedure BuiltInCos(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 Procedure BuiltInCos(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 begin
 begin
-  Result.resFloat:=Cos(Args[0].resFloat);
+  Result.resFloat:=Cos(ArgToFloat(Args[0]));
 end;
 end;
 
 
 Procedure BuiltInSin(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 Procedure BuiltInSin(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 begin
 begin
-  Result.resFloat:=Sin(Args[0].resFloat);
+  Result.resFloat:=Sin(ArgToFloat(Args[0]));
 end;
 end;
 
 
 Procedure BuiltInArcTan(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 Procedure BuiltInArcTan(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 begin
 begin
-  Result.resFloat:=Arctan(Args[0].resFloat);
+  Result.resFloat:=Arctan(ArgToFloat(Args[0]));
 end;
 end;
 
 
 Procedure BuiltInAbs(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 Procedure BuiltInAbs(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 begin
 begin
-  Result.resFloat:=Abs(Args[0].resFloat);
+  Result.resFloat:=Abs(ArgToFloat(Args[0]));
 end;
 end;
 
 
 Procedure BuiltInSqr(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 Procedure BuiltInSqr(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 begin
 begin
-  Result.resFloat:=Sqr(Args[0].resFloat);
+  Result.resFloat:=Sqr(ArgToFloat(Args[0]));
 end;
 end;
 
 
 Procedure BuiltInSqrt(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 Procedure BuiltInSqrt(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 begin
 begin
-  Result.resFloat:=Sqrt(Args[0].resFloat);
+  Result.resFloat:=Sqrt(ArgToFloat(Args[0]));
 end;
 end;
 
 
 Procedure BuiltInExp(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 Procedure BuiltInExp(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 begin
 begin
-  Result.resFloat:=Exp(Args[0].resFloat);
+  Result.resFloat:=Exp(ArgToFloat(Args[0]));
 end;
 end;
 
 
 Procedure BuiltInLn(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 Procedure BuiltInLn(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 begin
 begin
-  Result.resFloat:=Ln(Args[0].resFloat);
+  Result.resFloat:=Ln(ArgToFloat(Args[0]));
 end;
 end;
 
 
 Const
 Const
@@ -2944,27 +2972,27 @@ Const
 
 
 Procedure BuiltInLog(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 Procedure BuiltInLog(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 begin
 begin
-  Result.resFloat:=Ln(Args[0].resFloat)/L10;
+  Result.resFloat:=Ln(ArgToFloat(Args[0]))/L10;
 end;
 end;
 
 
 Procedure BuiltInRound(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 Procedure BuiltInRound(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 begin
 begin
-  Result.resInteger:=Round(Args[0].resFloat);
+  Result.resInteger:=Round(ArgToFloat(Args[0]));
 end;
 end;
 
 
 Procedure BuiltInTrunc(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 Procedure BuiltInTrunc(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 begin
 begin
-  Result.resInteger:=Trunc(Args[0].resFloat);
+  Result.resInteger:=Trunc(ArgToFloat(Args[0]));
 end;
 end;
 
 
 Procedure BuiltInInt(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 Procedure BuiltInInt(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 begin
 begin
-  Result.resFloat:=Int(Args[0].resFloat);
+  Result.resFloat:=Int(ArgToFloat(Args[0]));
 end;
 end;
 
 
 Procedure BuiltInFrac(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 Procedure BuiltInFrac(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 begin
 begin
-  Result.resFloat:=frac(Args[0].resFloat);
+  Result.resFloat:=frac(ArgToFloat(Args[0]));
 end;
 end;
 
 
 // String builtins
 // String builtins