fcl-passrc: scanner: accelerated Macros

git-svn-id: trunk@36127 -

packages/fcl-passrc/src/pscanner.pp

@@ -21,7 +21,7 @@ unit PScanner;
 
 interface
 
-uses SysUtils, Classes;
+uses SysUtils, Classes, contnrs;
 
 // message numbers
 const
@@ -244,18 +244,6 @@ type
   );
   TModeSwitches = Set of TModeSwitch;
 
-  { TMacroDef }
-
-  TMacroDef = Class(TObject)
-  Private
-    FName: String;
-    FValue: String;
-  Public
-    Constructor Create(Const AName,AValue : String);
-    Property Name  : String Read FName;
-    Property Value : String Read FValue Write FValue;
-  end;
-
   { TLineReader }
 
   TLineReader = class
@@ -399,6 +387,32 @@ type
     Row, Column: Cardinal;
   end;
 
+  PPasNameValue = ^TPasNameValue;
+  TPasNameValue = Record
+    Name: String;
+    Value: String;
+  end;
+
+  { TPasNameValues }
+
+  TPasNameValues = class
+  private
+    FChangeStamp: integer;
+    FList: TFPHashList; // list of PPasNameValue
+    procedure OnClearItem(Item, Dummy: pointer);
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure Clear;
+    function Define(const Name: String; const Value: String = ''): PPasNameValue;
+    function UnDefine(const Name: String): boolean;
+    function Find(const Name: String): PPasNameValue;
+    function IsDefined(const Name: String): boolean; inline;
+    property ChangeStamp: integer read FChangeStamp;
+    procedure Modified; inline;
+    property List: TFPHashList read FList;
+  end;
+
 type
   { TPascalScanner }
 
@@ -423,7 +437,7 @@ type
     FCurToken: TToken;
     FCurTokenString: string;
     FCurLine: string;
-    FMacros,
+    FMacros: TPasNameValues;
     FDefines: TStrings;
     FOptions: TPOptions;
     FLogEvents: TPScannerLogEvents;
@@ -466,7 +480,7 @@ type
     function HandleInclude(const Param: String): TToken;virtual;
     procedure HandleMode(const Param: String);virtual;
     procedure HandleModeSwitch(const Param: String);virtual;
-    function HandleMacro(AIndex: integer): TToken;virtual;
+    function HandleMacro(aMacro: PPasNameValue): TToken;virtual;
     procedure PushStackItem; virtual;
     function DoFetchTextToken: TToken;
     function DoFetchToken: TToken;
@@ -480,9 +494,11 @@ type
     procedure OpenFile(const AFilename: string);
     function FetchToken: TToken;
     function ReadNonPascalTillEndToken(StopAtLineEnd: boolean): TToken;
-    Procedure AddDefine(S : String);
-    Procedure RemoveDefine(S : String);
-    Procedure SetCompilerMode(S : String);
+    Procedure AddDefine(aName: String);
+    Procedure RemoveDefine(const aName: String);
+    Procedure UnDefine(const aName: String); // remove form Defines and Macros
+    function IsDefined(const aName: String): boolean; // check Defines and Macros
+    Procedure SetCompilerMode(const S: String);
     function CurSourcePos: TPasSourcePos;
     Function SetForceCaret(AValue : Boolean) : Boolean;
 
@@ -500,7 +516,7 @@ type
     Property PreviousToken : TToken Read FPreviousToken;
 
     property Defines: TStrings read FDefines;
-    property Macros: TStrings read FMacros;
+    property Macros: TPasNameValues read FMacros;
     Property Options : TPOptions Read FOptions Write SetOptions;
     Property LogEvents : TPScannerLogEvents Read FLogEvents Write FLogEvents;
     Property OnLog : TPScannerLogHandler Read FOnLog Write FOnLog;
@@ -882,12 +898,90 @@ begin
   Result:=(TheFilename<>'') and (TheFilename[1]='/');
 end;
 
-{ TMacroDef }
+{ TPasNameValues }
+
+// inline
+function TPasNameValues.IsDefined(const Name: String): boolean;
+begin
+  Result:=Find(Name)<>nil;
+end;
+
+// inline
+procedure TPasNameValues.Modified;
+begin
+  if FChangeStamp=High(FChangeStamp) then
+    FChangeStamp:=Low(FChangeStamp)+1
+  else
+    inc(FChangeStamp);
+end;
+
+procedure TPasNameValues.OnClearItem(Item, Dummy: pointer);
+var
+  NameValue: PPasNameValue absolute Item;
+begin
+  if Dummy=nil then ;
+  Dispose(NameValue);
+end;
+
+constructor TPasNameValues.Create;
+begin
+  FList:=TFPHashList.Create;
+end;
+
+destructor TPasNameValues.Destroy;
+begin
+  Clear;
+  FreeAndNil(FList);
+  inherited Destroy;
+end;
+
+procedure TPasNameValues.Clear;
+begin
+  if FList.Count=0 then exit;
+  FList.ForEachCall(@OnClearItem,nil);
+  FList.Clear;
+  Modified;
+end;
+
+function TPasNameValues.Define(const Name: String; const Value: String
+  ): PPasNameValue;
+var
+  Item: PPasNameValue;
+begin
+  Item:=Find(Name);
+  if Item<>nil then
+    begin
+    if Item^.Value=Value then exit(Item);
+    Item^.Value:=Value;
+    end
+  else
+    begin
+    New(Item);
+    Item^.Name:=Name;
+    Item^.Value:=Value;
+    FList.Add(uppercase(Name),Item);
+    end;
+  Modified;
+  Result:=Item;
+end;
+
+function TPasNameValues.UnDefine(const Name: String): boolean;
+var
+  Item: PPasNameValue;
+  Index: Integer;
+begin
+  Index:=FList.FindIndexOf(uppercase(Name));
+  if Index<0 then exit(false);
+  Item:=PPasNameValue(FList.List^[Index].Data);
+  FList.Delete(Index);
+  Dispose(Item);
+  Modified;
+  Result:=true;
+end;
 
-constructor TMacroDef.Create(const AName, AValue: String);
+function TPasNameValues.Find(const Name: String): PPasNameValue;
 begin
-  FName:=AName;
-  FValue:=AValue;
+  Result:=PPasNameValue(FList.Find(uppercase(Name)));
 end;
 
 { TStreamResolver }
@@ -1246,7 +1340,7 @@ begin
   FFileResolver := AFileResolver;
   FIncludeStack := TFPList.Create;
   FDefines := CS;
-  FMacros:=CS;
+  FMacros:=TPasNameValues.Create;
   FCurrentModeSwitches:=FPCModeSwitches;
   FAllowedModeSwitches:=msAllFPCModeSwitches;
 end;
@@ -1275,13 +1369,7 @@ begin
 end;
 
 procedure TPascalScanner.ClearMacros;
-
-Var
-  I : Integer;
-
 begin
-  For I:=0 to FMacros.Count-1 do
-      FMacros.Objects[i].Free;
   FMacros.Clear;
 end;
 
@@ -1555,16 +1643,14 @@ begin
     DoLog(mtInfo,nLogOpeningFile,SLogOpeningFile,[FCurFileName],True);
 end;
 
-function TPascalScanner.HandleMacro(AIndex : integer) : TToken;
+function TPascalScanner.HandleMacro(aMacro: PPasNameValue): TToken;
 
 Var
-  M : TMacroDef;
   ML : TMacroReader;
 
 begin
   PushStackItem;
-  M:=FMacros.Objects[AIndex] as TMacroDef;
-  ML:=TMacroReader.Create(FCurFileName,M.Value);
+  ML:=TMacroReader.Create(FCurFileName,aMacro^.Value);
   ML.CurRow:=FCurRow;
   ML.CurCol:=CurColumn;
   FCurSourceFile:=ML;
@@ -1576,7 +1662,7 @@ procedure TPascalScanner.HandleDefine(Param: String);
 
 Var
   Index : Integer;
-  MN,MV : String;
+  MName,MValue : String;
 
 begin
   Param := UpperCase(Param);
@@ -1585,14 +1671,10 @@ begin
     AddDefine(Param)
   else
     begin
-    MV:=Trim(Param);
-    MN:=Trim(Copy(MV,1,Index-1));
-    Delete(MV,1,Index+1);
-    Index:=FMacros.IndexOf(MN);
-    If (Index=-1) then
-      FMacros.AddObject(MN,TMacroDef.Create(MN,MV))
-    else
-      TMacroDef(FMacros.Objects[index]).Value:=MV;
+    MValue:=Trim(Param);
+    MName:=Trim(Copy(MValue,1,Index-1));
+    Delete(MValue,1,Index+1);
+    FMacros.Define(MName,MValue);
     end;
 end;
 
@@ -1602,24 +1684,8 @@ begin
 end;
 
 procedure TPascalScanner.HandleUnDefine(Param: String);
-
-Var
-  Index : integer;
-
 begin
-  Param := UpperCase(Param);
-  Index:=FDefines.IndexOf(Param);
-  If (Index>=0) then
-    RemoveDefine(Param)
-  else
-    begin
-    Index := FMacros.IndexOf(Param);
-    If (Index>=0) then
-      begin
-      FMacros.Objects[Index].FRee;
-      FMacros.Delete(Index);
-      end;
-    end;
+  UnDefine(Param);
 end;
 
 function TPascalScanner.HandleInclude(const Param: String): TToken;
@@ -1724,27 +1790,19 @@ end;
 
 procedure TPascalScanner.HandleIFDEF(const AParam: String);
 
-Var
-  ADefine : String;
-  Index : Integer;
-
 begin
   PushSkipMode;
   if PPIsSkipping then
     PPSkipMode := ppSkipAll
   else
     begin
-    ADefine := UpperCase(AParam);
-    Index := Defines.IndexOf(ADefine);
-    if Index < 0 then
-      Index := Macros.IndexOf(ADefine);
-    if Index < 0 then
+    if IsDefined(UpperCase(AParam)) then
+      PPSkipMode := ppSkipElseBranch
+    else
       begin
       PPSkipMode := ppSkipIfBranch;
       PPIsSkipping := true;
-      end
-    else
-      PPSkipMode := ppSkipElseBranch;
+      end;
     If LogEvent(sleConditionals) then
       if PPSkipMode=ppSkipElseBranch then
         DoLog(mtInfo,nLogIFDefAccepted,sLogIFDefAccepted,[AParam])
@@ -1755,28 +1813,19 @@ end;
 
 procedure TPascalScanner.HandleIFNDEF(const AParam: String);
 
-Var
-  ADefine : String;
-  Index : Integer;
-
 begin
   PushSkipMode;
   if PPIsSkipping then
     PPSkipMode := ppSkipAll
   else
     begin
-    ADefine := UpperCase(AParam);
-    Index := Defines.IndexOf(ADefine);
-    // Not sure about this
-    if Index < 0 then
-      Index := Macros.IndexOf(ADefine);
-    if Index >= 0 then
+    if IsDefined(UpperCase(AParam)) then
+      PPSkipMode := ppSkipElseBranch
+    else
       begin
       PPSkipMode := ppSkipIfBranch;
       PPIsSkipping := true;
-      end
-    else
-      PPSkipMode := ppSkipElseBranch;
+      end;
     If LogEvent(sleConditionals) then
       if PPSkipMode=ppSkipElseBranch then
         DoLog(mtInfo,nLogIFNDefAccepted,sLogIFNDefAccepted,[AParam])
@@ -1901,7 +1950,8 @@ function TPascalScanner.DoFetchToken: TToken;
 var
   TokenStart: PChar;
   i: TToken;
-  OldLength, SectionLength, NestingLevel, Index: Integer;
+  OldLength, SectionLength, NestingLevel: Integer;
+  MacroValue: PPasNameValue;
 begin
   result:=tkLineEnding;
   if TokenStr = nil then
@@ -2314,11 +2364,11 @@ begin
             FCurToken := Result;
             exit;
           end;
-        Index:=FMacros.IndexOf(CurtokenString);
-        if (Index=-1) then
+        MacroValue:=FMacros.Find(CurTokenString);
+        if (MacroValue=nil) then
           Result := tkIdentifier
         else
-          Result:=HandleMacro(index);
+          Result:=HandleMacro(MacroValue);
       end;
   else
     if PPIsSkipping then
@@ -2423,25 +2473,37 @@ begin
   CreateMsgArgs(FLastMsgArgs,Args);
 end;
 
-procedure TPascalScanner.AddDefine(S: String);
+procedure TPascalScanner.AddDefine(aName: String);
 
 begin
-  If FDefines.IndexOf(S)=-1 then
-    FDefines.Add(S);
+  aName:=UpperCase(aName);
+  If FDefines.IndexOf(aName)=-1 then
+    FDefines.Add(aName);
 end;
 
-procedure TPascalScanner.RemoveDefine(S: String);
+procedure TPascalScanner.RemoveDefine(const aName: String);
 
 Var
-  I : Integer;
+  Index : Integer;
+
+begin
+  Index:=FDefines.IndexOf(UpperCase(aName));
+  If (Index>=0) then
+    FDefines.Delete(Index);
+end;
+
+procedure TPascalScanner.UnDefine(const aName: String);
+begin
+  RemoveDefine(aName);
+  Macros.UnDefine(aName);
+end;
 
+function TPascalScanner.IsDefined(const aName: String): boolean;
 begin
-  I:=FDefines.IndexOf(S);
-  if (I<>-1) then
-    FDefines.Delete(I);
+  Result:=(FDefines.IndexOf(aName)>=0) or Macros.IsDefined(aName);
 end;
 
-procedure TPascalScanner.SetCompilerMode(S: String);
+procedure TPascalScanner.SetCompilerMode(const S: String);
 begin
   HandleMode(S);
 end;

packages/fcl-passrc/tests/tcresolver.pas

@@ -460,6 +460,7 @@ type
     Procedure TestPropertyReadAccessorFuncWrongResult;
     Procedure TestPropertyReadAccessorFuncWrongArgCount;
     Procedure TestPropertyReadAccessorFunc;
+    // ToDo: read accessor allow ancestor of field
     Procedure TestPropertyWriteAccessorVarWrongType;
     Procedure TestPropertyWriteAccessorFuncNotProc;
     Procedure TestPropertyWriteAccessorProcWrongArgCount;

packages/fcl-passrc/tests/tcscanner.pas

@@ -44,7 +44,7 @@ type
   private
     FDoSpecial: Boolean;
   protected
-    function HandleMacro(AIndex: integer): TToken;override;
+    function HandleMacro(aMacro: PPasNameValue): TToken; override;
   Public
     Property DoSpecial : Boolean Read FDoSpecial Write FDoSpecial;
   end;
@@ -231,7 +231,7 @@ implementation
 
 { TTestingPascalScanner }
 
-function TTestingPascalScanner.HandleMacro(AIndex: integer): TToken;
+function TTestingPascalScanner.HandleMacro(aMacro: PPasNameValue): TToken;
 begin
   if DoSpecial then
     begin
@@ -239,7 +239,7 @@ begin
     SetCurTokenstring('somethingweird');
     end
   else
-    Result:=inherited HandleMacro(AIndex);
+    Result:=inherited HandleMacro(aMacro);
 end;
 
 { TTestTokenFinder }