Browse Source

--- Merging r22586 into '.':
U packages/fcl-base/src/fpobserver.pp
--- Merging r22587 into '.':
U packages/fcl-base/src/fpexprpars.pp
--- Merging r22588 into '.':
U packages/fcl-base/examples/testexprpars.pp
--- Merging r22589 into '.':
U rtl/objpas/classes/compon.inc

# revisions: 22586,22587,22588,22589
r22586 | michael | 2012-10-08 13:04:27 +0200 (Mon, 08 Oct 2012) | 1 line
Changed paths:
M /trunk/packages/fcl-base/src/fpobserver.pp

* Some optimizations from Luiz Americo (bug ID 23022)
r22587 | michael | 2012-10-08 13:45:06 +0200 (Mon, 08 Oct 2012) | 1 line
Changed paths:
M /trunk/packages/fcl-base/src/fpexprpars.pp

* Better float parsing and conversion of integer to float where floats are accepted (bug 22934)
r22588 | michael | 2012-10-08 13:45:19 +0200 (Mon, 08 Oct 2012) | 1 line
Changed paths:
M /trunk/packages/fcl-base/examples/testexprpars.pp

* Better float parsing and conversion of integer to float where floats are accepted (bug 22934)
r22589 | michael | 2012-10-08 14:02:11 +0200 (Mon, 08 Oct 2012) | 1 line
Changed paths:
M /trunk/rtl/objpas/classes/compon.inc

* Fix from Luiz Americo to avoid crash when a freenotification is registered during destroy. (bug ID 23031)

git-svn-id: branches/fixes_2_6@22691 -

marco 13 years ago
parent
commit
84d23010ee

+ 1 - 0
packages/fcl-base/examples/testexprpars.pp

@@ -950,6 +950,7 @@ begin
   TestString('123.4',ttNumber);
   TestString('123.E4',ttNumber);
   TestString('1.E4',ttNumber);
+  TestString('1e-2',ttNumber);
   DoInvalidNumber('1..1');
   DoInvalidNumber('1.E--1');
   DoInvalidNumber('.E-1');

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

@@ -653,6 +653,7 @@ Function ResultTypeName (AResult : TResultType) : String;
 Function CharToResultType(C : Char) : TResultType;
 Function BuiltinIdentifiers : TExprBuiltInManager;
 Procedure RegisterStdBuiltins(AManager : TExprBuiltInManager);
+function ArgToFloat(Arg: TFPExpressionResult): TExprFloat;
 
 Const
   AllBuiltIns = [bcStrings,bcDateTime,bcMath,bcBoolean,bcConversion,bcData,bcVaria,bcUser];
@@ -923,14 +924,21 @@ Var
   C : Char;
   X : TExprFloat;
   I : Integer;
+  prevC: Char;
 
 begin
   C:=CurrentChar;
-  while (not IsWordDelim(C)) and (C<>cNull) do
+  prevC := #0;
+  while (not IsWordDelim(C) or (prevC='E')) and (C<>cNull) do
     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]));
     FToken := FToken+C;
+    prevC := Upcase(C);
     C:=NextPos;
     end;
   Val(FToken,X,I);
@@ -2808,9 +2816,18 @@ begin
     begin
     rtp:=CharToResultType(FID.ParameterTypes[i+1]);
     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)])
     end;
+    end;
 end;
 
 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
 
 Procedure BuiltInCos(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 begin
-  Result.resFloat:=Cos(Args[0].resFloat);
+  Result.resFloat:=Cos(ArgToFloat(Args[0]));
 end;
 
 Procedure BuiltInSin(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 begin
-  Result.resFloat:=Sin(Args[0].resFloat);
+  Result.resFloat:=Sin(ArgToFloat(Args[0]));
 end;
 
 Procedure BuiltInArcTan(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 begin
-  Result.resFloat:=Arctan(Args[0].resFloat);
+  Result.resFloat:=Arctan(ArgToFloat(Args[0]));
 end;
 
 Procedure BuiltInAbs(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 begin
-  Result.resFloat:=Abs(Args[0].resFloat);
+  Result.resFloat:=Abs(ArgToFloat(Args[0]));
 end;
 
 Procedure BuiltInSqr(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 begin
-  Result.resFloat:=Sqr(Args[0].resFloat);
+  Result.resFloat:=Sqr(ArgToFloat(Args[0]));
 end;
 
 Procedure BuiltInSqrt(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 begin
-  Result.resFloat:=Sqrt(Args[0].resFloat);
+  Result.resFloat:=Sqrt(ArgToFloat(Args[0]));
 end;
 
 Procedure BuiltInExp(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 begin
-  Result.resFloat:=Exp(Args[0].resFloat);
+  Result.resFloat:=Exp(ArgToFloat(Args[0]));
 end;
 
 Procedure BuiltInLn(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 begin
-  Result.resFloat:=Ln(Args[0].resFloat);
+  Result.resFloat:=Ln(ArgToFloat(Args[0]));
 end;
 
 Const
@@ -2944,27 +2972,27 @@ Const
 
 Procedure BuiltInLog(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 begin
-  Result.resFloat:=Ln(Args[0].resFloat)/L10;
+  Result.resFloat:=Ln(ArgToFloat(Args[0]))/L10;
 end;
 
 Procedure BuiltInRound(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 begin
-  Result.resInteger:=Round(Args[0].resFloat);
+  Result.resInteger:=Round(ArgToFloat(Args[0]));
 end;
 
 Procedure BuiltInTrunc(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 begin
-  Result.resInteger:=Trunc(Args[0].resFloat);
+  Result.resInteger:=Trunc(ArgToFloat(Args[0]));
 end;
 
 Procedure BuiltInInt(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 begin
-  Result.resFloat:=Int(Args[0].resFloat);
+  Result.resFloat:=Int(ArgToFloat(Args[0]));
 end;
 
 Procedure BuiltInFrac(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 begin
-  Result.resFloat:=frac(Args[0].resFloat);
+  Result.resFloat:=frac(ArgToFloat(Args[0]));
 end;
 
 // String builtins

+ 7 - 13
packages/fcl-base/src/fpobserver.pp

@@ -64,7 +64,7 @@ Type
     Procedure ViewChangedHandler(Sender : TObject);  virtual;
     // Check if APropertyName is published property of AObject.
     // Only performed if both parameters are not empty.
-    procedure CheckPropertyName(AObject: TObject; APropertyName: String);
+    procedure CheckPropertyName(AObject: TObject; const APropertyName: String);
     // If all CheckObjectSubject and Active are true, call ObjectToView.
     Procedure MaybeObjectToView;
     // If all CheckObjectSubject and Active are true, call ViewToObject.
@@ -137,7 +137,6 @@ Type
     procedure SetComponent(const AValue: TComponent);
   Public
     procedure Notification(AComponent: TComponent;  Operation: TOperation); override;
-    Procedure ViewChangedHandler(Sender : TObject); override;
   Published
     // General component which can be set in Object Inspector
     Property ViewComponent : TComponent Read FViewComponent Write SetComponent;
@@ -353,7 +352,7 @@ Type
     destructor Destroy; override;
     // If APropName is empty or APropInfo is Nil, a composite mediator will be searched.
     function FindDefFor(ASubject: TObject; AGui: TComponent): TMediatorDef; overload;
-    function FindDefFor(ASubject: TObject; AGui: TComponent; APropName: string): TMediatorDef; overload;
+    function FindDefFor(ASubject: TObject; AGui: TComponent; const APropName: string): TMediatorDef; overload;
     function FindDefFor(ASubject: TObject; AGui: TComponent; APropInfo: PPropInfo): TMediatorDef; overload;
     function RegisterMediator(MediatorClass: TMediatorClass; MinSubjectClass: TClass): TMediatorDef; overload;
     function RegisterMediator(MediatorClass: TMediatorClass; MinSubjectClass: TClass; PropertyName: string): TMediatorDef; overload;
@@ -365,7 +364,7 @@ Type
 
 function MediatorManager: TMediatorManager;
 Procedure MediatorError(Sender : TObject; Const Msg : String); overload;
-Procedure MediatorError(Sender : TObject; Fmt : String; Args : Array of const); overload;
+Procedure MediatorError(Sender : TObject; Const Fmt : String; Args : Array of const); overload;
 
 implementation
 
@@ -400,7 +399,7 @@ begin
     Err:=Msg
   else If Sender is TBaseMediator then
     begin
-    M:=Sender as TBaseMediator;
+    M:=TBaseMediator(Sender);
     V:=M.View;
     S:=M.Subject;
     CN:='';
@@ -429,7 +428,7 @@ begin
   Raise EMediator.Create(Err);
 end;
 
-Procedure MediatorError(Sender : TObject; Fmt : String; Args : Array of const); overload;
+Procedure MediatorError(Sender : TObject; const Fmt : String; Args : Array of const); overload;
 
 begin
   MediatorError(Sender,Format(Fmt,Args));
@@ -582,7 +581,7 @@ begin
   ValueListChanged;
 end;
 
-procedure TBaseMediator.CheckPropertyName(AObject : TObject; APropertyName : String);
+procedure TBaseMediator.CheckPropertyName(AObject : TObject; const APropertyName : String);
 
 begin
   If Assigned(AObject) and (APropertyName<>'') then
@@ -808,11 +807,6 @@ begin
     end;
 end;
 
-procedure TComponentMediator.ViewChangedHandler(Sender: TObject);
-begin
-  inherited ViewChangedHandler(Sender);
-end;
-
 { TMediatorDef }
 
 function TMediatorDef.Handles(ASubject: TObject; AGui: TComponent; APropInfo: PPropInfo): Boolean;
@@ -910,7 +904,7 @@ begin
   Result := FindDefFor(ASubject, AGUI, PPropInfo(nil));
 end;
 
-function TMediatorManager.FindDefFor(ASubject: TObject; AGui: TComponent; APropName: string): TMediatorDef;
+function TMediatorManager.FindDefFor(ASubject: TObject; AGui: TComponent; const APropName: string): TMediatorDef;
 var
   propinfo: PPropInfo;
 begin

+ 5 - 10
rtl/objpas/classes/compon.inc

@@ -559,17 +559,12 @@ Procedure TComponent.FreeNotification(AComponent: TComponent);
 
 begin
   If (Owner<>Nil) and (AComponent=Owner) then exit;
-  if csDestroying in ComponentState then
-    AComponent.Notification(Self,opRemove)
-  else
+  If not (Assigned(FFreeNotifies)) then
+    FFreeNotifies:=TFpList.Create;
+  If FFreeNotifies.IndexOf(AComponent)=-1 then
     begin
-    If not (Assigned(FFreeNotifies)) then
-      FFreeNotifies:=TFpList.Create;
-    If FFreeNotifies.IndexOf(AComponent)=-1 then
-      begin
-      FFreeNotifies.Add(AComponent);
-      AComponent.FreeNotification (self);
-      end;
+    FFreeNotifies.Add(AComponent);
+    AComponent.FreeNotification (self);
     end;
 end;