paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-29 09:50:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

codetools: implemented TCodeToolManager.DirectoryCachePoolGetUnitFromSet

Browse Source 
git-svn-id: trunk@26728 -
This commit is contained in:
mattias 2010-07-18 21:07:44 +00:00
parent 2f1d1e7d1e
commit 76a66d83d4
3 changed files with 56 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
components/codetools/codetoolmanager.pas
View File

@ -946,10 +946,8 @@ begin
UnitSetCache:=FPCDefinesCache.FindUnitToSrcCache(Config.FPCPath,
Config.TargetOS,Config.TargetProcessor,Config.FPCOptions,Config.FPCSrcDir,
true);
// parse compiler settings
UnitSetCache.GetConfigCache(true);
// parse fpc sources
UnitSetCache.GetSourceCache(true);
// parse compiler settings, fpc sources
UnitSetCache.Init;
// create template for FPC settings
FPCDefines:=CreateFPCTemplate(UnitSetCache,nil);
@ -5310,11 +5308,19 @@ function TCodeToolManager.DirectoryCachePoolGetUnitFromSet(const UnitSet,
var
Changed: boolean;
UnitSetCache: TFPCUnitSetCache;
Tree: TStringToStringTree;
begin
UnitSetCache:=FPCDefinesCache.FindUnitToSrcCache(UnitSet,Changed,true);
Tree:=UnitSetCache.GetUnitToSourceTree(false);
Result:=Tree[AnUnitName];
UnitSetCache:=FPCDefinesCache.FindUnitToSrcCache(UnitSet,Changed,false);
if UnitSetCache=nil then begin
debugln(['TCodeToolManager.DirectoryCachePoolGetUnitFromSet invalid UnitSet="',dbgstr(UnitSet),'"']);
Result:='';
exit;
end;
if Changed then begin
debugln(['TCodeToolManager.DirectoryCachePoolGetUnitFromSet outdated UnitSet="',dbgstr(UnitSet),'"']);
Result:='';
exit;
end;
Result:=UnitSetCache.GetUnitSrcFile(AnUnitName);
end;
procedure TCodeToolManager.OnToolSetWriteLock(Lock: boolean);

50
components/codetools/definetemplates.pas
View File

@ -816,6 +816,7 @@ type
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure Clear;
procedure Init;
property Caches: TFPCDefinesCache read FCaches;
property CompilerFilename: string read FCompilerFilename write SetCompilerFilename;
property CompilerOptions: string read FCompilerOptions write SetCompilerOptions;
@ -827,6 +828,7 @@ type
function GetSourceRules(AutoUpdate: boolean): TFPCSourceRules;
function GetUnitToSourceTree(AutoUpdate: boolean): TStringToStringTree; // lowercase unit name to file name (maybe relative)
function GetSourceDuplicates(AutoUpdate: boolean): TStringToStringTree; // lower case unit to semicolon separated list of files
function GetUnitSrcFile(const AUnitName: string): string;
property ChangeStamp: integer read FChangeStamp;
procedure IncreaseChangeStamp;
function GetUnitSetID: string;
@ -8160,8 +8162,15 @@ begin
Options, FPCSrcDir, ChangeStamp);
debugln(['TFPCDefinesCache.FindUnitToSrcCache UnitSetID="',dbgstr(UnitSetID),'" CompilerFilename="',CompilerFilename,'" TargetOS="',TargetOS,'" TargetCPU="',TargetCPU,'" Options="',Options,'" FPCSrcDir="',FPCSrcDir,'" ChangeStamp=',ChangeStamp,' exists=',FindUnitToSrcCache(CompilerFilename, TargetOS, TargetCPU,Options, FPCSrcDir,false)<>nil]);
Result:=FindUnitToSrcCache(CompilerFilename, TargetOS, TargetCPU,
Options, FPCSrcDir,CreateIfNotExists);
Changed:=ChangeStamp<>Result.ChangeStamp;
Options, FPCSrcDir, false);
if Result<>nil then begin
Changed:=ChangeStamp<>Result.ChangeStamp;
end else if CreateIfNotExists then begin
Changed:=true;
Result:=FindUnitToSrcCache(CompilerFilename, TargetOS, TargetCPU,
Options, FPCSrcDir, true);
end else
Changed:=false;
end;
function TFPCDefinesCache.GetUnitSetID(CompilerFilename, TargetOS, TargetCPU,
@ -8220,15 +8229,16 @@ begin
case NameStartPos^ of
'c','C':
if NameFits(PChar('CompilerFilename')) then
CompilerFilename:=Value
else if NameFits(PChar('Stamp')) then
ChangeStamp:=StrToIntDef(Value,0);
CompilerFilename:=Value;
'f','F':
if NameFits(PChar('FPCSrcDir')) then
FPCSrcDir:=Value;
'o','O':
if NameFits(PChar('Options')) then
Options:=Value;
's','S':
if NameFits(PChar('Stamp')) then
ChangeStamp:=StrToIntDef(Value,0);
't','T':
if NameFits(PChar('TargetOS')) then
TargetOS:=Value
@ -8285,7 +8295,6 @@ end;
procedure TFPCUnitSetCache.ClearConfigCache;
begin
FConfigCache:=nil;
FreeAndNil(fSourceRules);
fFlags:=fFlags+[fuscfUnitTreeNeedsUpdate,fuscfSrcRulesNeedUpdate];
end;
@ -8293,7 +8302,6 @@ procedure TFPCUnitSetCache.ClearSourceCache;
begin
fSourceCache:=nil;
Include(fFlags,fuscfUnitTreeNeedsUpdate);
FreeAndNil(fSrcDuplicates);
end;
procedure TFPCUnitSetCache.Notification(AComponent: TComponent;
@ -8331,6 +8339,11 @@ begin
end;
procedure TFPCUnitSetCache.Init;
begin
GetUnitToSourceTree(True);
end;
function TFPCUnitSetCache.GetConfigCache(AutoUpdate: boolean
): TFPCTargetConfigCache;
begin
@ -8370,15 +8383,17 @@ var
begin
Cfg:=GetConfigCache(AutoUpdate);
if (fuscfSrcRulesNeedUpdate in fFlags)
or (Cfg.ChangeStamp<>fRulesStampOfConfig) then begin
or (fRulesStampOfConfig<>Cfg.ChangeStamp) then begin
Exclude(fFlags,fuscfSrcRulesNeedUpdate);
NewRules:=DefaultFPCSourceRules.Clone;
try
AdjustFPCSrcRulesForPPUPaths(Cfg.Units,NewRules);
debugln(['TFPCUnitSetCache.GetSourceRules ',DbgSName(fSourceRules),' ',DbgSName(NewRules)]);
fSourceRules.Assign(NewRules); // increases ChangeStamp if something changed
fRulesStampOfConfig:=Cfg.ChangeStamp;
finally
NewRules.Free;
end;
fRulesStampOfConfig:=Cfg.ChangeStamp;
end;
Result:=fSourceRules;
end;
@ -8391,12 +8406,14 @@ var
NewUnitToSourceTree: TStringToStringTree;
NewSrcDuplicates: TStringToStringTree;
begin
debugln(['TFPCUnitSetCache.GetUnitToSourceTree START ChangeStamp=',ChangeStamp]);
Src:=GetSourceCache(AutoUpdate);
SrcRules:=GetSourceRules(AutoUpdate);
if (fuscfUnitTreeNeedsUpdate in fFlags)
or (fUnitStampOfFiles<>Src.ChangeStamp)
or (fUnitStampOfRules<>SrcRules.ChangeStamp) then begin
Exclude(fFlags,fuscfUnitTreeNeedsUpdate);
NewSrcDuplicates:=nil;
NewUnitToSourceTree:=nil;
try
@ -8413,12 +8430,14 @@ begin
fSrcDuplicates.Assign(NewSrcDuplicates);
IncreaseChangeStamp;
end;
fUnitStampOfFiles:=Src.ChangeStamp;
fUnitStampOfRules:=SrcRules.ChangeStamp;
finally
NewUnitToSourceTree.Free;
NewSrcDuplicates.Free;
end;
Exclude(fFlags,fuscfUnitTreeNeedsUpdate);
end;
debugln(['TFPCUnitSetCache.GetUnitToSourceTree END ChangeStamp=',ChangeStamp]);
Result:=fUnitToSourceTree;
end;
@ -8429,6 +8448,17 @@ begin
Result:=fSrcDuplicates;
end;
function TFPCUnitSetCache.GetUnitSrcFile(const AUnitName: string): string;
var
Tree: TStringToStringTree;
begin
Tree:=GetUnitToSourceTree(false);
if Tree=nil then
Result:=''
else
Result:=FPCSourceDirectory+Tree[LowerCase(AUnitName)];
end;
procedure TFPCUnitSetCache.IncreaseChangeStamp;
begin
if FChangeStamp<High(FChangeStamp) then

4
components/codetools/directorycacher.pas
View File

@ -720,9 +720,9 @@ var
UnitSet: string;
begin
UnitSet:=Strings[ctdcsUnitSet];
debugln(['TCTDirectoryCache.FindUnitInUnitSet Directory="',Directory,'" UnitSet="',UnitSet,'" AUnitName="',AUnitName,'"']);
//debugln(['TCTDirectoryCache.FindUnitInUnitSet Directory="',Directory,'" UnitSet="',UnitSet,'" AUnitName="',AUnitName,'"']);
Result:=Pool.OnGetUnitFromSet(UnitSet,AUnitName);
debugln(['TCTDirectoryCache.FindUnitInUnitSet Directory="',Directory,'" UnitSet="',UnitSet,'" AUnitName="',AUnitName,'" Result="',Result,'"']);
debugln(['TCTDirectoryCache.FindUnitInUnitSet Directory="',Directory,'" UnitSet="',dbgstr(UnitSet),'" AUnitName="',AUnitName,'" Result="',Result,'"']);
end;
function TCTDirectoryCache.FindFile(const ShortFilename: string;