codetools: started unitsets

git-svn-id: trunk@26656 -

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;

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
+  TargetCPU, Options, FPCSrcDir: string; CreateIfNotExists: boolean
-    ): TFPCUnitToSrcCache;
+  ): 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;
 

components/codetools/directorycacher.pas

@@ -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
+// unit links
-
-  { TUnitNameLink }
-
-  TUnitNameLink = class
-  public
-    Unit_Name: string;
-    Filename: string;
-    function CalcMemSize: PtrUInt;
-  end;
-
 function SearchUnitInUnitLinks(const UnitLinks, TheUnitName: string;
   var UnitLinkStart, UnitLinkEnd: integer; out Filename: string): boolean;
-function CreateUnitLinksTree(const UnitLinks: string): TAVLTree;
+function CreateUnitLinksTree(const UnitLinks: string): TAVLTree; // tree of TUnitNameLink
-function CompareUnitLinkNodes(NodeData1, NodeData2: pointer): integer;
+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

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