* Implement ExtractIdentifierNames: fix issue 39454

packages/fcl-base/src/fpexprpars.pp

@@ -715,7 +715,7 @@ Type
   end;
 
   { TFPExpressionParser }
-
+  TIdentifierEvent = Procedure (Sender : TObject; Const aIdentifier : String) of object;
   TFPExpressionParser = class(TComponent)
   private
     FBuiltIns: TBuiltInCategories;
@@ -725,6 +725,9 @@ Type
     FIdentifiers : TFPExprIdentifierDefs;
     FHashList : TFPHashObjectlist;
     FDirty : Boolean;
+    FOnExtractIdentifier : TIdentifierEvent;
+    FExtractIdentifiers : TStrings;
+    FUnknownIdentifier : TFPExprIdentifierDef;
     procedure CheckEOF;
     function GetAsBoolean: Boolean;
     function GetAsDateTime: TDateTime;
@@ -732,10 +735,12 @@ Type
     function GetAsCurrency: Currency;
     function GetAsInteger: Int64;
     function GetAsString: String;
+    function GetExtractingIdentifiers: Boolean;
     function MatchNodes(Todo, Match: TFPExprNode): TFPExprNode;
     procedure CheckNodes(var Left, Right: TFPExprNode);
     procedure SetBuiltIns(const AValue: TBuiltInCategories);
     procedure SetIdentifiers(const AValue: TFPExprIdentifierDefs);
+    procedure AddIdentifierToStrings(Sender : TObject; Const aIdentifier : String);
   Protected
     procedure ParserError(Msg: String);
     procedure SetExpression(const AValue: String); virtual;
@@ -758,12 +763,15 @@ Type
     Property Scanner : TFPExpressionScanner Read FScanner;
     Property ExprNode : TFPExprNode Read FExprNode;
     Property Dirty : Boolean Read FDirty;
+    Property ExtractingIdentifiers : Boolean Read GetExtractingIdentifiers;
   public
     Constructor Create(AOwner :TComponent); override;
     Destructor Destroy; override;
     Function IdentifierByName(const AName : ShortString) : TFPExprIdentifierDef; virtual;
     Procedure Clear;
     Procedure EvaluateExpression(Out Result : TFPExpressionResult);
+    Procedure ExtractIdentifierNames(Const aExpression : String; aList : TStringList); overload;
+    Procedure ExtractIdentifierNames(Const aExpression : String; aCallback : TIdentifierEvent); overload;
     function ExtractNode(var N: TFPExprNode): Boolean;
     Function Evaluate : TFPExpressionResult;
     Function ResultType : TResultType;
@@ -856,6 +864,7 @@ var
   FileFormatSettings: TFormatSettings;
 
 Resourcestring
+  SErrCannotRecursivelyExtractIdentifiers = 'Cannot recursively extract identifiers';
   SBadQuotes        = 'Unterminated string';
   SUnknownDelimiter = 'Unknown delimiter character: "%s"';
   SErrUnknownCharacter = 'Unknown character at pos %d: "%s"';
@@ -1590,6 +1599,12 @@ begin
   FIdentifiers.Assign(AValue)
 end;
 
+procedure TFPExpressionParser.AddIdentifierToStrings(Sender: TObject; const aIdentifier: String);
+begin
+  If Assigned(FExtractIdentifiers) then
+    FExtractIdentifiers.Add(aIdentifier);
+end;
+
 procedure TFPExpressionParser.EvaluateExpression(Out Result: TFPExpressionResult);
 begin
   If (FExpression='') then
@@ -1599,6 +1614,48 @@ begin
   FExprNode.GetNodeValue(Result);
 end;
 
+
+Procedure TFPExpressionParser.ExtractIdentifierNames(Const aExpression : String; aCallback : TIdentifierEvent); overload;
+
+
+Var
+  N : TFPExprNode;
+  OldExpr : String;
+
+begin
+  if Assigned(Self.FOnExtractIdentifier) then
+    ParserError(SErrCannotRecursivelyExtractIdentifiers);
+  N:=Nil;
+  FOnExtractIdentifier:=aCallBack;
+  try
+    // for safety
+    FreeAndNil(FUnknownIdentifier);
+    // Save old data
+    OldExpr:=Expression;
+    ExtractNode(N);
+    // Parse
+   Expression:=aExpression;
+  finally
+    FOnExtractIdentifier:=Nil;
+    FreeAndNil(FUnknownIdentifier);
+    FExpression:=OldExpr;
+    FExprNode:=N;
+  end;
+end;
+
+procedure TFPExpressionParser.ExtractIdentifierNames(const aExpression: String; aList: TStringList);
+
+begin
+   if Assigned(FExtractIdentifiers) then
+     ParserError(SErrCannotRecursivelyExtractIdentifiers);
+   FExtractIdentifiers:=aList;
+   try
+     ExtractIdentifierNames(aExpression,@AddIdentifierToStrings);
+   finally
+     FExtractIdentifiers:=Nil;
+   end;
+end;
+
 function TFPExpressionParser.ExtractNode(Var N : TFPExprNode) : Boolean;
 begin
   Result:=Assigned(FExprNode);
@@ -1710,6 +1767,11 @@ begin
   Result:=Res.ResString;
 end;
 
+function TFPExpressionParser.GetExtractingIdentifiers: Boolean;
+begin
+  Result:=Assigned(FOnExtractIdentifier);
+end;
+
 {
   Checks types of todo and match. If ToDO can be converted to it matches
   the type of match, then a node is inserted.
@@ -1847,7 +1909,8 @@ begin
       GetToken;
       CheckEOF;
       Right:=Level4;
-      CheckNodes(Result,Right);
+      if Not ExtractingIdentifiers then
+        CheckNodes(Result,Right);
       Case tt of
         ttPlus  : Result:=TFPAddOperation.Create(Result,Right);
         ttMinus : Result:=TFPSubtractOperation.Create(Result,Right);
@@ -1877,7 +1940,8 @@ begin
       tt:=TokenType;
       GetToken;
       Right:=Level5;
-      CheckNodes(Result,Right);
+      if Not ExtractingIdentifiers then
+        CheckNodes(Result,Right);
       Case tt of
         ttMul : Result:=TFPMultiplyOperation.Create(Result,Right);
         ttDiv : Result:=TFPDivideOperation.Create(Result,Right);
@@ -1960,6 +2024,7 @@ Var
   ID : TFPExprIdentifierDef;
   Args : TExprArgumentArray;
   AI : Integer;
+  S : String;
 
 begin
 {$ifdef debugexpr}  Writeln('Primitive : ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr}
@@ -1989,9 +2054,22 @@ begin
     IFC:=TokenType=ttCase;
     if Not (IFF or IFC) then
       begin
-      ID:=self.IdentifierByName(CurrentToken);
+      S:=CurrentToken;
+      ID:=self.IdentifierByName(S);
       If (ID=Nil) then
-        ParserError(Format(SErrUnknownIdentifier,[CurrentToken]))
+        begin
+        if Assigned(FOnExtractIdentifier) then
+          begin
+          if not Assigned(FUnknownIdentifier) then
+            FUnknownIdentifier:=TFPExprIdentifierDef.Create(Nil);
+          ID:=FUnknownIdentifier;
+          // Call only once in case of stringlist.
+          If Not (Assigned(FExtractIdentifiers) and (FExtractIdentifiers.IndexOf(S)<>-1)) then
+            FOnExtractIdentifier(Self,S);
+          end
+        else
+          ParserError(Format(SErrUnknownIdentifier,[S]))
+        end
       end;
     // Determine number of arguments
     if Iff then
@@ -2070,7 +2148,8 @@ begin
     FExprNode:=Level1;
     If (TokenType<>ttEOF) then
       ParserError(Format(SErrUnterminatedExpression,[Scanner.Pos,CurrentToken]));
-    FExprNode.Check;
+    if not ExtractingIdentifiers then
+      FExprNode.Check;
     end
   else
     FExprNode:=Nil;

packages/fcl-base/tests/testexprpars.pp

@@ -730,6 +730,8 @@ type
     FEventName: String;
     FBoolValue : Boolean;
     FTest33 : TFPExprIdentifierDef;
+    FIdentifiers : TStrings;
+    procedure AddIdentifier(Sender: TObject; const aIdentifier: String);
     procedure DoGetBooleanVar(var Res: TFPExpressionResult; ConstRef AName: ShortString);
     procedure DoGetBooleanVarWrong(var Res: TFPExpressionResult; ConstRef AName: ShortString);
     procedure TestAccess(Skip: TResultType);
@@ -780,6 +782,10 @@ type
     procedure TestVariable34;
     procedure TestVariable35;
     procedure TestVariable36;
+    Procedure TestGetIdentifierNames;
+    Procedure TestGetIdentifierNamesCallback;
+    Procedure TestGetIdentifierNamesDouble;
+    Procedure TestGetIdentifierNamesDoubleCallback;
   end;
 
   { TTestParserFunctions }
@@ -4686,6 +4692,70 @@ begin
   AssertCurrencyResult(1.23);
 end;
 
+procedure TTestParserVariables.TestGetIdentifierNames;
+
+Var
+  L : TStringList;
+
+begin
+  L:=TStringList.Create;
+  try
+    L.Sorted:=true;
+    FP.ExtractIdentifierNames('a+b',L);
+    AssertEquals('Element count',2,L.Count);
+    AssertEquals('First element','a',L[0]);
+    AssertEquals('second element','b',L[1]);
+  finally
+    L.Free;
+  end;
+end;
+
+procedure TTestParserVariables.TestGetIdentifierNamesCallback;
+
+begin
+  FIdentifiers:=TStringList.Create;
+  try
+    TStringList(FIdentifiers).Sorted:=true;
+    FP.ExtractIdentifierNames('a+b',@AddIdentifier);
+    AssertEquals('Element count',2,FIdentifiers.Count);
+    AssertEquals('First element','a',FIdentifiers[0]);
+    AssertEquals('second element','b',FIdentifiers[1]);
+  Finally
+    FreeAndNil(FIdentifiers);
+  end;
+end;
+
+procedure TTestParserVariables.TestGetIdentifierNamesDouble;
+Var
+  L : TStringList;
+
+begin
+  L:=TStringList.Create;
+  try
+    L.Sorted:=true;
+    FP.ExtractIdentifierNames('a+(b*a)',L);
+    AssertEquals('Element count',2,L.Count);
+    AssertEquals('First element','a',L[0]);
+    AssertEquals('second element','b',L[1]);
+  finally
+    L.Free;
+  end;
+end;
+
+procedure TTestParserVariables.TestGetIdentifierNamesDoubleCallback;
+begin
+  FIdentifiers:=TStringList.Create;
+  try
+    FP.ExtractIdentifierNames('a+(b*a)',@AddIdentifier);
+    AssertEquals('Element count',3,FIdentifiers.Count);
+    AssertEquals('First element','a',FIdentifiers[0]);
+    AssertEquals('second element','b',FIdentifiers[1]);
+    AssertEquals('third element','a',FIdentifiers[2]);
+  Finally
+    FreeAndNil(FIdentifiers);
+  end;
+end;
+
 procedure TTestParserVariables.TestVariable12;
 
 Var
@@ -4927,6 +4997,12 @@ begin
   Res.ResBoolean:=FBoolValue;
 end;
 
+procedure TTestParserVariables.AddIdentifier(Sender: TObject; const aIdentifier: String);
+begin
+  AssertNotNull('Have identifier list',FIdentifiers);
+  FIdentifiers.Add(aIdentifier);
+end;
+
 procedure TTestParserVariables.TestVariable31;
 
 Var