diff --git a/components/codetools/codetoolmanager.pas b/components/codetools/codetoolmanager.pas index 8536dbd814..10a0c37eec 100644 --- a/components/codetools/codetoolmanager.pas +++ b/components/codetools/codetoolmanager.pas @@ -156,6 +156,8 @@ type function DirectoryCachePoolGetString(const ADirectory: string; const AStringType: TCTDirCacheString): string; function DirectoryCachePoolFindVirtualFile(const Filename: string): string; + function DirectoryCachePoolGetUnitFromSet(const UnitSet, AnUnitName: string + ): string; public DefinePool: TDefinePool; // definition templates (rules) DefineTree: TDefineTree; // cache for defines (e.g. initial compiler values) @@ -163,6 +165,7 @@ type SourceChangeCache: TSourceChangeCache; // cache for write accesses GlobalValues: TExpressionEvaluator; DirectoryCachePool: TCTDirectoryCachePool; + FPCDefinesCache: TFPCDefinesCache; IdentifierList: TIdentifierList; IdentifierHistory: TIdentifierHistoryList; Positions: TCodeXYPositions; @@ -292,6 +295,9 @@ type function FindUnitInUnitLinks(const Directory, AUnitName: string): string; function GetUnitLinksForDirectory(const Directory: string; UseCache: boolean = false): string; + function FindUnitInUnitSet(const Directory, AUnitName: string): string; + function GetUnitSetForDirectory(const Directory: string; + UseCache: boolean = false): string; function GetFPCUnitPathForDirectory(const Directory: string; UseCache: boolean = false): string;// unit paths reported by FPC procedure GetFPCVersionForDirectory(const Directory: string; @@ -828,7 +834,9 @@ begin DirectoryCachePool:=TCTDirectoryCachePool.Create; DirectoryCachePool.OnGetString:=@DirectoryCachePoolGetString; DirectoryCachePool.OnFindVirtualFile:=@DirectoryCachePoolFindVirtualFile; + DirectoryCachePool.OnGetUnitFromSet:=@DirectoryCachePoolGetUnitFromSet; DefineTree.DirectoryCachePool:=DirectoryCachePool; + FPCDefinesCache:=TFPCDefinesCache.Create(nil); FAddInheritedCodeToOverrideMethod:=true; FAdjustTopLineDueToComment:=true; FCatchExceptions:=true; @@ -882,6 +890,7 @@ begin DefaultConfigCodeCache:=nil; FreeAndNil(SourceCache); FreeAndNil(DirectoryCachePool); + FreeAndNil(FPCDefinesCache); {$IFDEF CTDEBUG} DebugLn('[TCodeToolManager.Destroy] F'); {$ENDIF} @@ -1433,6 +1442,27 @@ begin end; end; +function TCodeToolManager.FindUnitInUnitSet(const Directory, AUnitName: string + ): string; +begin + Result:=DirectoryCachePool.FindUnitInUnitSet(Directory,AUnitName); +end; + +function TCodeToolManager.GetUnitSetForDirectory(const Directory: string; + UseCache: boolean): string; +var + Evaluator: TExpressionEvaluator; +begin + if UseCache then begin + Result:=DirectoryCachePool.GetString(Directory,ctdcsUnitSet,true) + end else begin + Result:=''; + Evaluator:=DefineTree.GetDefinesForDirectory(Directory,true); + if Evaluator=nil then exit; + Result:=Evaluator[UnitSetMacroName]; + end; +end; + function TCodeToolManager.GetFPCUnitPathForDirectory(const Directory: string; UseCache: boolean): string; var @@ -5212,6 +5242,7 @@ begin ctdcsIncludePath: Result:=GetIncludePathForDirectory(ADirectory,false); ctdcsCompleteSrcPath: Result:=GetCompleteSrcPathForDirectory(ADirectory,false); ctdcsUnitLinks: Result:=GetUnitLinksForDirectory(ADirectory,false); + ctdcsUnitSet: Result:=GetUnitSetForDirectory(ADirectory,false); ctdcsFPCUnitPath: Result:=GetFPCUnitPathForDirectory(ADirectory,false); else RaiseCatchableException(''); end; @@ -5230,6 +5261,18 @@ begin Result:=Code.Filename; end; +function TCodeToolManager.DirectoryCachePoolGetUnitFromSet(const UnitSet, + AnUnitName: string): string; +var + Changed: boolean; + UnitSetCache: TFPCUnitSetCache; + Tree: TStringToStringTree; +begin + UnitSetCache:=FPCDefinesCache.FindUnitToSrcCache(UnitSet,Changed,true); + Tree:=UnitSetCache.GetUnitToSourceTree(false); + Result:=Tree[AnUnitName]; +end; + procedure TCodeToolManager.OnToolSetWriteLock(Lock: boolean); begin if Lock then ActivateWriteLock else DeactivateWriteLock; diff --git a/components/codetools/definetemplates.pas b/components/codetools/definetemplates.pas index 5d32f5d58e..dc045846c0 100644 --- a/components/codetools/definetemplates.pas +++ b/components/codetools/definetemplates.pas @@ -79,6 +79,7 @@ const DCUSrcPathMacroName = ExternalMacroStart+'DCUSrcPath'; CompiledSrcPathMacroName = ExternalMacroStart+'CompiledSrcPath'; UnitLinksMacroName = ExternalMacroStart+'UnitLinks'; + UnitSetMacroName = ExternalMacroStart+'UnitSet'; FPCUnitPathMacroName = ExternalMacroStart+'FPCUnitPath'; TargetOSMacroName = ExternalMacroStart+'TargetOS'; TargetCPUMacroName = ExternalMacroStart+'TargetCPU'; @@ -92,6 +93,7 @@ const DCUSrcPathMacro = '$('+DCUSrcPathMacroName+')'; CompiledSrcPathMacro = '$('+CompiledSrcPathMacroName+')'; UnitLinksMacro = '$('+UnitLinksMacroName+')'; + UnitSetMacro = '$('+UnitSetMacroName+')'; FPCUnitPathMacro = '$('+FPCUnitPathMacroName+')'; TargetOSMacro = '$('+TargetOSMacroName+')'; TargetCPUMacro = '$('+TargetCPUMacroName+')'; @@ -772,11 +774,11 @@ type ); TFPCUnitToSrcCacheFlags = set of TFPCUnitToSrcCacheFlag; - { TFPCUnitToSrcCache + { TFPCUnitSetCache Unit name to FPC source file. Specific to one compiler, targetos, targetcpu and FPC source directory. } - TFPCUnitToSrcCache = class(TComponent) + TFPCUnitSetCache = class(TComponent) private FCaches: TFPCDefinesCache; FChangeStamp: integer; @@ -821,6 +823,7 @@ type function GetSourceDuplicates(AutoUpdate: boolean): TStringToStringTree; // lower case unit to semicolon separated list of files property ChangeStamp: integer read FChangeStamp; procedure IncreaseChangeStamp; + function GetUnitSetID: string; end; { TFPCDefinesCache } @@ -832,7 +835,7 @@ type FSourceCaches: TFPCSourceCaches; FSourceCachesSaveStamp: integer; FTestFilename: string; - fUnitToSrcCaches: TFPList; // list of TFPCUnitToSrcCache + fUnitToSrcCaches: TFPList; // list of TFPCUnitSetCache procedure SetConfigCaches(const AValue: TFPCTargetConfigCaches); procedure SetSourceCaches(const AValue: TFPCSourceCaches); procedure ClearUnitToSrcCaches; @@ -847,11 +850,17 @@ type function NeedsSave: boolean; property SourceCaches: TFPCSourceCaches read FSourceCaches write SetSourceCaches; property ConfigCaches: TFPCTargetConfigCaches read FConfigCaches write SetConfigCaches; - function FindUnitToSrcCache(const CompilerFilename, TargetOS, TargetCPU, - FPCSrcDir: string; CreateIfNotExists: boolean - ): TFPCUnitToSrcCache; - property TestFilename: string read FTestFilename write FTestFilename; // an empty file to test the compiler, will be auto created + function FindUnitToSrcCache(const CompilerFilename, TargetOS, TargetCPU, + Options, FPCSrcDir: string; + CreateIfNotExists: boolean): TFPCUnitSetCache; + function FindUnitToSrcCache(const UnitSetID: string; out Changed: boolean; + CreateIfNotExists: boolean): TFPCUnitSetCache; + function GetUnitSetID(CompilerFilename, TargetOS, TargetCPU, Options, + FPCSrcDir: string; ChangeStamp: integer): string; + procedure ParseUnitSetID(ID: string; out CompilerFilename, + TargetOS, TargetCPU, Options, FPCSrcDir: string; + out ChangeStamp: integer); end; function DefineActionNameToAction(const s: string): TDefineAction; @@ -899,7 +908,9 @@ function GatherUnitsInFPCSources(Files: TStringList; Duplicates: TStringToStringTree = nil; // lower case unit to semicolon separated list of files Rules: TFPCSourceRules = nil): TStringToStringTree; function CreateFPCTemplate(Config: TFPCTargetConfigCache; - Owner: TObject): TDefineTemplate; + Owner: TObject): TDefineTemplate; overload; +function CreateFPCTemplate(Config: TFPCUnitSetCache; + Owner: TObject): TDefineTemplate; overload; procedure CheckPPUSources(PPUFiles, // lowercase unitname to filename UnitToSource, // lowercase unitname to file name UnitToDuplicates: TStringToStringTree; // lowercase unitname to semicolon separated list of files @@ -1671,6 +1682,14 @@ begin Result.SetDefineOwner(Owner,true); end; +function CreateFPCTemplate(Config: TFPCUnitSetCache; Owner: TObject + ): TDefineTemplate; overload; +begin + Result:=CreateFPCTemplate(Config.GetConfigCache(false),Owner); + Result.AddChild(TDefineTemplate.Create('UnitSet','UnitSet identifier', + UnitSetMacroName,Config.GetUnitSetID,da_DefineRecurse)); +end; + procedure CheckPPUSources(PPUFiles, UnitToSource, UnitToDuplicates: TStringToStringTree; var Duplicates, Missing: TStringToStringTree); @@ -7643,25 +7662,117 @@ begin end; function TFPCDefinesCache.FindUnitToSrcCache(const CompilerFilename, TargetOS, - TargetCPU, FPCSrcDir: string; CreateIfNotExists: boolean - ): TFPCUnitToSrcCache; + TargetCPU, Options, FPCSrcDir: string; CreateIfNotExists: boolean + ): TFPCUnitSetCache; var i: Integer; begin for i:=0 to fUnitToSrcCaches.Count-1 do begin - Result:=TFPCUnitToSrcCache(fUnitToSrcCaches[i]); + Result:=TFPCUnitSetCache(fUnitToSrcCaches[i]); if (CompareFilenames(Result.CompilerFilename,CompilerFilename)=0) and (SysUtils.CompareText(Result.TargetOS,TargetOS)=0) and (SysUtils.CompareText(Result.TargetCPU,TargetCPU)=0) - and (CompareFilenames(Result.FPCSourceDirectory,FPCSrcDir)=0) then + and (CompareFilenames(Result.FPCSourceDirectory,FPCSrcDir)=0) + and (Result.CompilerOptions=Options) + then exit; end; - Result:=nil; + if CreateIfNotExists then begin + Result:=TFPCUnitSetCache.Create(nil); + Result.CompilerFilename:=CompilerFilename; + Result.CompilerOptions:=Options; + Result.TargetOS:=TargetOS; + Result.TargetCPU:=TargetCPU; + Result.FPCSourceDirectory:=FPCSrcDir; + fUnitToSrcCaches.Add(Result); + end else + Result:=nil; end; -{ TFPCUnitToSrcCache } +function TFPCDefinesCache.FindUnitToSrcCache(const UnitSetID: string; out + Changed: boolean; CreateIfNotExists: boolean): TFPCUnitSetCache; +var + CompilerFilename, TargetOS, TargetCPU, Options, FPCSrcDir: string; + ChangeStamp: integer; +begin + ParseUnitSetID(UnitSetID,CompilerFilename, TargetOS, TargetCPU, + Options, FPCSrcDir, ChangeStamp); + Result:=FindUnitToSrcCache(CompilerFilename, TargetOS, TargetCPU, + Options, FPCSrcDir,CreateIfNotExists); + Changed:=ChangeStamp<>Result.ChangeStamp; +end; -procedure TFPCUnitToSrcCache.SetCompilerFilename(const AValue: string); +function TFPCDefinesCache.GetUnitSetID(CompilerFilename, TargetOS, TargetCPU, + Options, FPCSrcDir: string; ChangeStamp: integer): string; +begin + if CompilerFilename='' then CompilerFilename:=GetDefaultCompilerFilename; + if TargetOS='' then TargetOS:=GetCompiledTargetOS; + if TargetCPU='' then TargetCPU:=GetCompiledTargetCPU; + Result:='CompilerFilename='+CompilerFilename+LineEnding + +'TargetOS='+TargetOS+LineEnding + +'TargetCPU='+TargetCPU+LineEnding + +'Options='+Options+LineEnding + +'FPCSrcDir='+FPCSrcDir+LineEnding + +'Stamp='+IntToStr(ChangeStamp); +end; + +procedure TFPCDefinesCache.ParseUnitSetID(ID: string; out CompilerFilename, + TargetOS, TargetCPU, Options, FPCSrcDir: string; out ChangeStamp: integer); +var + NameStartPos: PChar; + ValueStartPos: PChar; + ValueEndPos: PChar; + Value: String; +begin + CompilerFilename:=''; + TargetCPU:=''; + TargetOS:=''; + Options:=''; + FPCSrcDir:=''; + ChangeStamp:=0; + if ID='' then exit; + // read the lines with name=value + NameStartPos:=PChar(ID); + while NameStartPos^<>#0 do begin + while (NameStartPos^ in [#10,#13]) do inc(NameStartPos); + ValueStartPos:=NameStartPos; + while not (ValueStartPos^ in ['=',#10,#13,#0]) do inc(ValueStartPos); + if ValueStartPos<>'=' then exit; + inc(ValueStartPos); + ValueEndPos:=ValueStartPos; + while not (ValueEndPos^ in [#10,#13,#0]) do inc(ValueEndPos); + Value:=copy(ID,ValueStartPos-PChar(ID),ValueEndPos-ValueStartPos);; + case NameStartPos^ of + 'c','C': + if ComparePCharCaseInsensitive(NameStartPos,PChar('CompilerFilename'))=0 + then + CompilerFilename:=Value + else if ComparePCharCaseInsensitive(NameStartPos,PChar('Stamp'))=0 + then + ChangeStamp:=StrToIntDef(Value,0); + 'f','F': + if ComparePCharCaseInsensitive(NameStartPos,PChar('FPCSrcDir'))=0 + then + FPCSrcDir:=Value; + 'o','O': + if ComparePCharCaseInsensitive(NameStartPos,PChar('Options'))=0 + then + Options:=Value; + 't','T': + if ComparePCharCaseInsensitive(NameStartPos,PChar('TargetOS'))=0 + then + TargetOS:=Value + else if ComparePCharCaseInsensitive(NameStartPos,PChar('TargetCPU'))=0 + then + TargetCPU:=Value; + end; + NameStartPos:=ValueEndPos; + end; +end; + +{ TFPCUnitSetCache } + +procedure TFPCUnitSetCache.SetCompilerFilename(const AValue: string); var NewFilename: String; begin @@ -7671,14 +7782,14 @@ begin ClearConfigCache; end; -procedure TFPCUnitToSrcCache.SetCompilerOptions(const AValue: string); +procedure TFPCUnitSetCache.SetCompilerOptions(const AValue: string); begin if FCompilerOptions=AValue then exit; FCompilerOptions:=AValue; ClearConfigCache; end; -procedure TFPCUnitToSrcCache.SetFPCSourceDirectory(const AValue: string); +procedure TFPCUnitSetCache.SetFPCSourceDirectory(const AValue: string); var NewValue: String; begin @@ -7688,35 +7799,35 @@ begin ClearSourceCache; end; -procedure TFPCUnitToSrcCache.SetTargetCPU(const AValue: string); +procedure TFPCUnitSetCache.SetTargetCPU(const AValue: string); begin if FTargetCPU=AValue then exit; FTargetCPU:=AValue; ClearConfigCache; end; -procedure TFPCUnitToSrcCache.SetTargetOS(const AValue: string); +procedure TFPCUnitSetCache.SetTargetOS(const AValue: string); begin if FTargetOS=AValue then exit; FTargetOS:=AValue; ClearConfigCache; end; -procedure TFPCUnitToSrcCache.ClearConfigCache; +procedure TFPCUnitSetCache.ClearConfigCache; begin FConfigCache:=nil; FreeAndNil(fSourceRules); fFlags:=fFlags+[fuscfUnitTreeNeedsUpdate,fuscfSrcRulesNeedUpdate]; end; -procedure TFPCUnitToSrcCache.ClearSourceCache; +procedure TFPCUnitSetCache.ClearSourceCache; begin fSourceCache:=nil; Include(fFlags,fuscfUnitTreeNeedsUpdate); FreeAndNil(fSrcDuplicates); end; -procedure TFPCUnitToSrcCache.Notification(AComponent: TComponent; +procedure TFPCUnitSetCache.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); @@ -7728,7 +7839,7 @@ begin end; end; -constructor TFPCUnitToSrcCache.Create(TheOwner: TComponent); +constructor TFPCUnitSetCache.Create(TheOwner: TComponent); begin inherited Create(TheOwner); FCaches:=TheOwner as TFPCDefinesCache; @@ -7738,7 +7849,7 @@ begin fFlags:=[fuscfUnitTreeNeedsUpdate,fuscfSrcRulesNeedUpdate]; end; -destructor TFPCUnitToSrcCache.Destroy; +destructor TFPCUnitSetCache.Destroy; begin FreeAndNil(fSourceRules); FreeAndNil(fUnitToSourceTree); @@ -7746,12 +7857,12 @@ begin inherited Destroy; end; -procedure TFPCUnitToSrcCache.Clear; +procedure TFPCUnitSetCache.Clear; begin end; -function TFPCUnitToSrcCache.GetConfigCache(AutoUpdate: boolean +function TFPCUnitSetCache.GetConfigCache(AutoUpdate: boolean ): TFPCTargetConfigCache; begin if CompilerFilename='' then @@ -7768,7 +7879,7 @@ begin Result:=FConfigCache; end; -function TFPCUnitToSrcCache.GetSourceCache(AutoUpdate: boolean +function TFPCUnitSetCache.GetSourceCache(AutoUpdate: boolean ): TFPCSourceCache; begin if FPCSourceDirectory='' then @@ -7782,7 +7893,7 @@ begin Result:=fSourceCache; end; -function TFPCUnitToSrcCache.GetSourceRules(AutoUpdate: boolean +function TFPCUnitSetCache.GetSourceRules(AutoUpdate: boolean ): TFPCSourceRules; var Cfg: TFPCTargetConfigCache; @@ -7803,7 +7914,7 @@ begin Result:=fSourceRules; end; -function TFPCUnitToSrcCache.GetUnitToSourceTree(AutoUpdate: boolean +function TFPCUnitSetCache.GetUnitToSourceTree(AutoUpdate: boolean ): TStringToStringTree; var Src: TFPCSourceCache; @@ -7842,14 +7953,14 @@ begin Result:=fUnitToSourceTree; end; -function TFPCUnitToSrcCache.GetSourceDuplicates(AutoUpdate: boolean +function TFPCUnitSetCache.GetSourceDuplicates(AutoUpdate: boolean ): TStringToStringTree; begin GetUnitToSourceTree(AutoUpdate); Result:=fSrcDuplicates; end; -procedure TFPCUnitToSrcCache.IncreaseChangeStamp; +procedure TFPCUnitSetCache.IncreaseChangeStamp; begin if FChangeStamp'') and not FilenameIsAbsolute(Directory) then + RaiseDirNotAbsolute; + Cache:=GetCache(Directory,true,false); + Result:=Cache.FindUnitInUnitSet(AUnitName); +end; + function TCTDirectoryCachePool.FindDiskFilename(const Filename: string ): string; var diff --git a/components/codetools/finddeclarationtool.pas b/components/codetools/finddeclarationtool.pas index 7c1d149c47..7beb7b5791 100644 --- a/components/codetools/finddeclarationtool.pas +++ b/components/codetools/finddeclarationtool.pas @@ -790,7 +790,8 @@ type AnUnitInFilename: string): string; procedure GatherUnitAndSrcPath(var UnitPath, CompleteSrcPath: string); function SearchUnitInUnitLinks(const TheUnitName: string): string; - + function SearchUnitInUnitSet(const TheUnitName: string): string; + function FindSmartHint(const CursorPos: TCodeXYPosition): string; function BaseTypeOfNodeHasSubIdents(ANode: TCodeTreeNode): boolean; @@ -2103,6 +2104,14 @@ begin Result:=DirectoryCache.FindUnitLink(TheUnitName); end; +function TFindDeclarationTool.SearchUnitInUnitSet(const TheUnitName: string + ): string; +begin + Result:=''; + if not CheckDirectoryCache then exit; + Result:=DirectoryCache.FindUnitInUnitSet(TheUnitName); +end; + function TFindDeclarationTool.FindSmartHint(const CursorPos: TCodeXYPosition ): string; var