paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-12 05:55:54 +02:00
Code Issues Packages Projects Releases Wiki Activity

codetools: started unitsets

Browse Source 
git-svn-id: trunk@26656 -
This commit is contained in:
mattias 2010-07-14 23:01:12 +00:00
parent 1004c7bb6c
commit 7728cf1e4e
4 changed files with 246 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
components/codetools/codetoolmanager.pas
View File

@ -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;

179
components/codetools/definetemplates.pas
View File

@ -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<High(FChangeStamp) then
inc(FChangeStamp)
@ -7857,6 +7968,12 @@ begin
FChangeStamp:=Low(FChangeStamp);
end;
function TFPCUnitSetCache.GetUnitSetID: string;
begin
Result:=Caches.GetUnitSetID(CompilerFilename,CompilerOptions,
TargetOS,TargetCPU,FPCSourceDirectory,ChangeStamp);
end;
initialization
InitDefaultFPCSourceRules;

58
components/codetools/directorycacher.pas
View File

@ -56,6 +56,7 @@ type
ctdcsIncludePath,
ctdcsCompleteSrcPath, // including unit path, src path and compiled src paths
ctdcsUnitLinks,
ctdcsUnitSet,
ctdcsFPCUnitPath // unit paths reported by FPC
);
@ -82,6 +83,16 @@ const
ctdusUnitFileCaseInsensitive];
type
{ TUnitNameLink }
TUnitNameLink = class
public
Unit_Name: string;
Filename: string;
function CalcMemSize: PtrUInt;
end;
TCTDirCacheUnitSrcRecord = record
Files: TStringToStringTree;
ConfigTimeStamp: Cardinal;
@ -134,6 +145,7 @@ type
procedure Reference;
procedure Release;
function FindUnitLink(const AUnitName: string): string;
function FindUnitInUnitSet(const AUnitName: string): string;
function FindFile(const ShortFilename: string;
const FileCase: TCTSearchFileCase): string;
function FindUnitSource(const AUnitName: string; AnyCase: boolean): string;
@ -157,6 +169,7 @@ type
const AStringType: TCTDirCacheString
): string of object;
TCTDirCacheFindVirtualFile = function(const Filename: string): string of object;
TCTGetUnitFromSet = function(const UnitSet, AnUnitName: string): string of object;
TCTDirectoryCachePool = class
private
@ -165,6 +178,7 @@ type
FDirectories: TAVLTree;// tree of TCTDirectoryCache
FOnFindVirtualFile: TCTDirCacheFindVirtualFile;
FOnGetString: TCTDirCacheGetString;
FOnGetUnitFromSet: TCTGetUnitFromSet;
procedure DoRemove(ACache: TCTDirectoryCache);
procedure OnFileStateCacheChangeTimeStamp(Sender: TObject);
public
@ -179,6 +193,7 @@ type
procedure IncreaseFileTimeStamp;
procedure IncreaseConfigTimeStamp;
function FindUnitInUnitLinks(const Directory, AUnitName: string): string;
function FindUnitInUnitSet(const Directory, AUnitName: string): string;
function FindDiskFilename(const Filename: string): string;
function FindUnitInDirectory(const Directory, AUnitName: string;
AnyCase: boolean = false): string;
@ -195,6 +210,8 @@ type
property OnGetString: TCTDirCacheGetString read FOnGetString write FOnGetString;
property OnFindVirtualFile: TCTDirCacheFindVirtualFile read FOnFindVirtualFile
write FOnFindVirtualFile;
property OnGetUnitFromSet: TCTGetUnitFromSet read FOnGetUnitFromSet
write FOnGetUnitFromSet;
end;
function CompareCTDirectoryCaches(Data1, Data2: Pointer): integer;
@ -204,21 +221,11 @@ function ComparePCharFirstCaseInsThenCase(Data1, Data2: Pointer): integer;
function ComparePCharCaseInsensitive(Data1, Data2: Pointer): integer;
function ComparePCharCaseSensitive(Data1, Data2: Pointer): integer;
type
{ TUnitNameLink }
TUnitNameLink = class
public
Unit_Name: string;
Filename: string;
function CalcMemSize: PtrUInt;
end;
// unit links
function SearchUnitInUnitLinks(const UnitLinks, TheUnitName: string;
var UnitLinkStart, UnitLinkEnd: integer; out Filename: string): boolean;
function CreateUnitLinksTree(const UnitLinks: string): TAVLTree;
function CompareUnitLinkNodes(NodeData1, NodeData2: pointer): integer;
function CreateUnitLinksTree(const UnitLinks: string): TAVLTree; // tree of TUnitNameLink
function CompareUnitLinkNodes(NodeData1, NodeData2: Pointer): integer;
function CompareUnitNameWithUnitLinkNode(AUnitName: Pointer;
NodeData: pointer): integer;
@ -708,6 +715,14 @@ begin
Result:='';
end;
function TCTDirectoryCache.FindUnitInUnitSet(const AUnitName: string): string;
var
UnitSet: string;
begin
UnitSet:=Strings[ctdcsUnitSet];
Result:=Pool.OnGetUnitFromSet(UnitSet,AUnitName);
end;
function TCTDirectoryCache.FindFile(const ShortFilename: string;
const FileCase: TCTSearchFileCase): string;
@ -1203,6 +1218,23 @@ begin
Result:=Cache.FindUnitLink(AUnitName);
end;
function TCTDirectoryCachePool.FindUnitInUnitSet(const Directory,
AUnitName: string): string;
procedure RaiseDirNotAbsolute;
begin
raise Exception.Create('TCTDirectoryCachePool.FindUnitInUnitSet not absolute Directory="'+Directory+'"');
end;
var
Cache: TCTDirectoryCache;
begin
if (Directory<>'') and not FilenameIsAbsolute(Directory) then
RaiseDirNotAbsolute;
Cache:=GetCache(Directory,true,false);
Result:=Cache.FindUnitInUnitSet(AUnitName);
end;
function TCTDirectoryCachePool.FindDiskFilename(const Filename: string
): string;
var

11
components/codetools/finddeclarationtool.pas
View File

@ -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