From 663d9d28c41df2893f702b68d2f4e96eb05cc821 Mon Sep 17 00:00:00 2001 From: mattias Date: Fri, 17 Mar 2006 23:44:24 +0000 Subject: [PATCH] added codetools cache for unit search git-svn-id: trunk@8951 - --- .gitattributes | 2 +- components/codetools/allcodetoolunits.pp | 3 +- components/codetools/codetoolmanager.pas | 28 +- components/codetools/definetemplates.pas | 2 +- ...directorycache.pas => directorycacher.pas} | 556 +++++++++++++----- components/codetools/fileprocs.pas | 219 ++++++- components/codetools/finddeclarationtool.pas | 355 ++--------- components/codetools/stdcodetools.pas | 3 +- 8 files changed, 678 insertions(+), 490 deletions(-) rename components/codetools/{directorycache.pas => directorycacher.pas} (58%) diff --git a/.gitattributes b/.gitattributes index 095965303c..5dc1008447 100644 --- a/.gitattributes +++ b/.gitattributes @@ -58,7 +58,7 @@ components/codetools/codetoolsstructs.pas svneol=native#text/pascal components/codetools/codetree.pas svneol=native#text/pascal components/codetools/customcodetool.pas svneol=native#text/pascal components/codetools/definetemplates.pas svneol=native#text/pascal -components/codetools/directorycache.pas svneol=native#text/plain +components/codetools/directorycacher.pas svneol=native#text/plain components/codetools/eventcodetool.pas svneol=native#text/pascal components/codetools/examples/finddeclaration.lpi svneol=native#text/plain components/codetools/examples/finddeclaration.lpr svneol=native#text/plain diff --git a/components/codetools/allcodetoolunits.pp b/components/codetools/allcodetoolunits.pp index 1e7a35475f..927b973c27 100644 --- a/components/codetools/allcodetoolunits.pp +++ b/components/codetools/allcodetoolunits.pp @@ -19,7 +19,8 @@ uses FindDeclarationTool, StdCodeTools, MethodJumpTool, EventCodeTool, CodeCompletionTool, LinkScanner, FindDeclarationCache, BasicCodeTools, CodeTree, CodeAtom, SourceChanger, CodeToolMemManager, CodeCache, - KeywordFuncLists, SourceLog, ExprEval, DefineTemplates, FileProcs, CodeToolsStrConsts, + KeywordFuncLists, SourceLog, ExprEval, DefineTemplates, FileProcs, + CodeToolsStrConsts, DirectoryCacher, MultiKeyWordListTool, ResourceCodeTool, CodeToolsStructs, // fast xml units, changes not merged in current fpc Laz_DOM, Laz_XMLCfg, Laz_XMLRead, Laz_XMLWrite, Laz_XMLStreaming; diff --git a/components/codetools/codetoolmanager.pas b/components/codetools/codetoolmanager.pas index d54c02c680..ad50e36ebd 100644 --- a/components/codetools/codetoolmanager.pas +++ b/components/codetools/codetoolmanager.pas @@ -43,7 +43,7 @@ uses Classes, SysUtils, FileProcs, BasicCodeTools, CodeToolsStrConsts, EventCodeTool, CodeTree, CodeAtom, SourceChanger, DefineTemplates, CodeCache, ExprEval, LinkScanner, KeywordFuncLists, TypInfo, - DirectoryCache, AVL_Tree, LFMTrees, PascalParserTool, CodeToolsConfig, + DirectoryCacher, AVL_Tree, LFMTrees, PascalParserTool, CodeToolsConfig, CustomCodeTool, FindDeclarationTool, IdentCompletionTool, StdCodeTools, ResourceCodeTool, CodeToolsStructs, CodeTemplatesTool, ExtractProcTool; @@ -64,6 +64,8 @@ type TOnFindDefineProperty = procedure(Sender: TObject; const PersistentClassName, AncestorClassName, Identifier: string; var IsDefined: boolean) of object; + + ECodeToolManagerError = class(Exception); { TCodeToolManager } @@ -136,6 +138,7 @@ type function GetOwnerForCodeTreeNode(ANode: TCodeTreeNode): TObject; function DirectoryCachePoolGetString(const ADirectory: string; const AStringType: TCTDirCacheString): string; + function DirectoryCachePoolFindVirtualFile(const Filename: string): string; public DefinePool: TDefinePool; // definition templates (rules) DefineTree: TDefineTree; // cache for defines (e.g. initial compiler values) @@ -616,6 +619,7 @@ begin GlobalValues:=TExpressionEvaluator.Create; DirectoryCachePool:=TCTDirectoryCachePool.Create; DirectoryCachePool.OnGetString:=@DirectoryCachePoolGetString; + DirectoryCachePool.OnFindVirtualFile:=@DirectoryCachePoolFindVirtualFile; FAddInheritedCodeToOverrideMethod:=true; FAdjustTopLineDueToComment:=true; FCatchExceptions:=true; @@ -1017,8 +1021,12 @@ begin // make it absolute, so the user need less string concatenations if FilenameIsAbsolute(Directory) then Result:=CreateAbsoluteSearchPath(Result,Directory); + if (System.Pos('debugger',Result)>0) and (System.Pos('ide',Directory)>0) then + DebugLn('TCodeToolManager.GetCompleteSrcPathForDirectory ABSOLUTE Directory="',Directory,'" Result="',Result,'"'); // trim the paths, remove doubles and empty paths Result:=MinimizeSearchPath(Result); + if (System.Pos('debugger',Result)>0) and (System.Pos('ide',Directory)>0) then + DebugLn('TCodeToolManager.GetCompleteSrcPathForDirectory END Directory="',Directory,'" Result="',Result,'"'); end; end; @@ -1330,6 +1338,9 @@ begin end else if (AnException is ESourceChangeCacheError) then begin // SourceChangeCache error fErrorCode:=nil; + end else if (AnException is ECodeToolManagerError) then begin + // CodeToolManager error + fErrorCode:=nil; end else begin // unknown exception DumpExceptionBackTrace; @@ -3591,7 +3602,7 @@ begin CreateScanner(Code); if Code.Scanner=nil then begin if ExceptionOnError then - raise Exception.CreateFmt(ctsNoScannerFound,[Code.Filename]); + raise ECodeToolManagerError.CreateFmt(ctsNoScannerFound,[Code.Filename]); exit; end; Result:=TCodeTool.Create; @@ -3728,6 +3739,19 @@ begin end; end; +function TCodeToolManager.DirectoryCachePoolFindVirtualFile( + const Filename: string): string; +var + Code: TCodeBuffer; +begin + Result:=''; + if (Filename='') or (System.Pos(PathDelim,Filename)>0) then + exit; + Code:=FindFile(Filename); + if Code<>nil then + Result:=Code.Filename; +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 cc07991f2a..140dc94ff1 100644 --- a/components/codetools/definetemplates.pas +++ b/components/codetools/definetemplates.pas @@ -54,7 +54,7 @@ unit DefineTemplates; interface uses - Classes, SysUtils, CodeToolsStrConsts, ExprEval, DirectoryCache, + Classes, SysUtils, CodeToolsStrConsts, ExprEval, DirectoryCacher, Laz_XMLCfg, AVL_Tree, Process, KeywordFuncLists, FileProcs; diff --git a/components/codetools/directorycache.pas b/components/codetools/directorycacher.pas similarity index 58% rename from components/codetools/directorycache.pas rename to components/codetools/directorycacher.pas index 0e944763f2..28db43844e 100644 --- a/components/codetools/directorycache.pas +++ b/components/codetools/directorycacher.pas @@ -28,7 +28,7 @@ the same files. } -unit DirectoryCache; +unit DirectoryCacher; {$mode objfpc}{$H+} @@ -56,12 +56,23 @@ type end; TCTDirectoryUnitSources = ( - ctdusUnitNormal, - ctdusUnitCaseInsensitive, - ctdusInFilenameNormal, - ctdusInFilenameCaseInsenstive + ctdusUnitNormal, // e.g. unitname -> filename + ctdusUnitCaseInsensitive, // unitname case insensitive -> filename + ctdusInFilenameNormal, // unit 'in' filename -> filename + ctdusInFilenameCaseInsenstive, // unit 'in' filename case insensitive -> filename + ctdusUnitFileNormal, // unitname.ext -> filename + ctdusUnitFileCaseInsensitive // unitname.ext case insensitive -> filename ); +const + ctdusCaseSensitive = [ctdusUnitNormal, + ctdusInFilenameNormal, + ctdusUnitFileNormal]; + ctdusCaseInsensitive = [ctdusUnitCaseInsensitive, + ctdusInFilenameCaseInsenstive, + ctdusUnitFileCaseInsensitive]; + +type TCTDirCacheUnitSrcRecord = record Files: TStringToStringTree; TimeStamp: cardinal; @@ -73,7 +84,8 @@ type public TimeStamp: cardinal; Names: PChar; // all filenames separated with #0 - NameCount: integer; + NameCount: integer; // number of filenames + NamesLength: PtrInt; // length of Names in bytes NameStarts: PInteger; // offsets in 'Names' destructor Destroy; override; procedure Clear; @@ -99,6 +111,10 @@ type const AValue: string); procedure ClearUnitLinks; procedure UpdateListing; + function GetUnitSourceCacheValue(const UnitSrc: TCTDirectoryUnitSources; + const Search: string; var Filename: string): boolean; + procedure AddToCache(const UnitSrc: TCTDirectoryUnitSources; + const Search, Filename: string); public constructor Create(const TheDirectory: string; ThePool: TCTDirectoryCachePool); @@ -108,8 +124,14 @@ type function FindUnitLink(const UnitName: string): string; function FindFile(const ShortFilename: string; const FileCase: TCTSearchFileCase): string; - function FindUnitSource(var UnitName, InFilename: string; - AnyCase: boolean): string; + function FindUnitSource(const UnitName: string; AnyCase: boolean): string; + function FindUnitSourceInCleanSearchPath(const Unitname, + SearchPath: string; AnyCase: boolean): string; + function FindUnitSourceInCompletePath(var UnitName, InFilename: string; + AnyCase: boolean): string; + function FindCompiledUnitInCompletePath(var ShortFilename: string; + AnyCase: boolean): string; + procedure WriteListing; public property Directory: string read FDirectory; property RefCount: integer read FRefCount; @@ -122,9 +144,11 @@ type TCTDirCacheGetString = function(const ADirectory: string; const AStringType: TCTDirCacheString ): string of object; + TCTDirCacheFindVirtualFile = function(const Filename: string): string of object; TCTDirectoryCachePool = class private + FOnFindVirtualFile: TCTDirCacheFindVirtualFile; FOnGetString: TCTDirCacheGetString; FTimeStamp: cardinal; FDirectories: TAVLTree; @@ -140,8 +164,15 @@ type UseCache: boolean = true): string; procedure IncreaseTimeStamp; function FindUnitInUnitLinks(const Directory, UnitName: string): string; + function FindDiskFilename(const Filename: string): string; + function FindUnitInDirectory(const Directory, UnitName: string; + AnyCase: boolean = false): string; + function FindVirtualFile(const Filename: string): string; + function FindVirtualUnit(const UnitName: string): string; property TimeStamp: cardinal read FTimeStamp; property OnGetString: TCTDirCacheGetString read FOnGetString write FOnGetString; + property OnFindVirtualFile: TCTDirCacheFindVirtualFile read FOnFindVirtualFile + write FOnFindVirtualFile; end; function CompareCTDirectoryCaches(Data1, Data2: Pointer): integer; @@ -377,63 +408,111 @@ begin FListing:=TCTDirectoryListing.Create; FListing.Clear; FListing.TimeStamp:=Pool.TimeStamp; + if Directory='' then exit;// virtual directory // read the directory WorkingListing:=nil; WorkingListingCapacity:=0; WorkingListingCount:=0; - if SysUtils.FindFirst(Directory+FileMask,faAnyFile,FileInfo)=0 then begin - repeat - // check if special file - if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='') - then - continue; - // add file - if WorkingListingCount=WorkingListingCapacity then begin - // grow WorkingListing - if WorkingListingCapacity>0 then - NewCapacity:=WorkingListingCapacity*2 - else - NewCapacity:=8; - ReAllocMem(WorkingListing,SizeOf(Pointer)*NewCapacity); - FillChar(WorkingListing[WorkingListingCount], - SizeOf(Pointer)*(NewCapacity-WorkingListingCapacity),0); - WorkingListingCapacity:=NewCapacity; - end; - WorkingListing[WorkingListingCount]:=FileInfo.Name; - inc(WorkingListingCount); - until SysUtils.FindNext(FileInfo)<>0; - end; - SysUtils.FindClose(FileInfo); - - if WorkingListingCount=0 then exit; - - // sort the files - MergeSort(PPointer(WorkingListing),WorkingListingCount, - @ComparePCharFirstCaseInsThenCase); - - // create listing - TotalLen:=0; - for i:=0 to WorkingListingCount-1 do - inc(TotalLen,length(WorkingListing[i])+1); - GetMem(FListing.Names,TotalLen); - FListing.NameCount:=WorkingListingCount; - p:=0; - for i:=0 to WorkingListingCount-1 do begin - CurFilenameLen:=length(WorkingListing[i]); - if CurFilenameLen>0 then begin - System.Move(WorkingListing[i][1],FListing.Names[p],CurFilenameLen); - inc(p,CurFilenameLen); + try + if SysUtils.FindFirst(Directory+FileMask,faAnyFile,FileInfo)=0 then begin + repeat + // check if special file + if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='') + then + continue; + // add file + if WorkingListingCount=WorkingListingCapacity then begin + // grow WorkingListing + if WorkingListingCapacity>0 then + NewCapacity:=WorkingListingCapacity*2 + else + NewCapacity:=8; + ReAllocMem(WorkingListing,SizeOf(Pointer)*NewCapacity); + FillChar(WorkingListing[WorkingListingCount], + SizeOf(Pointer)*(NewCapacity-WorkingListingCapacity),0); + WorkingListingCapacity:=NewCapacity; + end; + WorkingListing[WorkingListingCount]:=FileInfo.Name; + inc(WorkingListingCount); + until SysUtils.FindNext(FileInfo)<>0; end; - FListing.Names[p]:=#0; - inc(p); + SysUtils.FindClose(FileInfo); + + if WorkingListingCount=0 then exit; + + // sort the files + MergeSort(PPointer(WorkingListing),WorkingListingCount, + @ComparePCharFirstCaseInsThenCase); + + // create listing + TotalLen:=0; + for i:=0 to WorkingListingCount-1 do + inc(TotalLen,length(WorkingListing[i])+1); + GetMem(FListing.Names,TotalLen); + FListing.NamesLength:=TotalLen; + FListing.NameCount:=WorkingListingCount; + GetMem(FListing.NameStarts,SizeOf(PChar)*WorkingListingCount); + p:=0; + for i:=0 to WorkingListingCount-1 do begin + CurFilenameLen:=length(WorkingListing[i]); + if CurFilenameLen>0 then begin + FListing.NameStarts[i]:=p; + System.Move(WorkingListing[i][1],FListing.Names[p],CurFilenameLen); + inc(p,CurFilenameLen); + end; + FListing.Names[p]:=#0; + inc(p); + end; + finally + for i:=0 to WorkingListingCount-1 do + WorkingListing[i]:=''; + ReAllocMem(WorkingListing,0); end; end; +function TCTDirectoryCache.GetUnitSourceCacheValue( + const UnitSrc: TCTDirectoryUnitSources; const Search: string; + var Filename: string): boolean; +var + Files: TStringToStringTree; +begin + Files:=FUnitSources[UnitSrc].Files; + if (FUnitSources[UnitSrc].TimeStamp<>Pool.TimeStamp) then begin + // cache is invalid -> clear to make it valid + if Files<>nil then + Files.Clear; + FUnitSources[UnitSrc].TimeStamp:=Pool.TimeStamp; + Result:=false; + end else begin + // cache is valid + if Files<>nil then begin + Result:=Files.GetString(Search,Filename); + end else begin + Result:=false; + end; + end; +end; + +procedure TCTDirectoryCache.AddToCache(const UnitSrc: TCTDirectoryUnitSources; + const Search, Filename: string); +var + Files: TStringToStringTree; +begin + Files:=FUnitSources[UnitSrc].Files; + if Files=nil then begin + Files:=TStringToStringTree.Create(UnitSrc in ctdusCaseSensitive); + FUnitSources[UnitSrc].Files:=Files; + end; + Files[Search]:=Filename; +end; + constructor TCTDirectoryCache.Create(const TheDirectory: string; ThePool: TCTDirectoryCachePool); begin FDirectory:=AppendPathDelim(TrimFilename(TheDirectory)); + if (FDirectory<>'') and not FilenameIsAbsolute(FDirectory) then + raise Exception.Create('directory not absolute'); FPool:=ThePool; FRefCount:=1; end; @@ -515,82 +594,158 @@ var cmp: LongInt; CurFilename: PChar; begin - if ShortFilename='' then exit(''); - UpdateListing; Result:=''; - if (FListing.Names=nil) then exit; - l:=0; - r:=FListing.NameCount-1; - while r>=l do begin - m:=(l+r) shr 1; - CurFilename:=@FListing.Names[FListing.NameStarts[m]]; - case FileCase of - ctsfcDefault: - {$IFDEF CaseInsensitiveFilenames} - cmp:=stricomp(PChar(ShortFilename),CurFilename); - {$ELSE} - cmp:=strcomp(PChar(ShortFilename),CurFilename); - {$ENDIF} - ctsfcAllCase,ctsfcLoUpCase: - cmp:=stricomp(PChar(ShortFilename),CurFilename); - else RaiseDontKnow; - end; - if cmp>0 then - l:=m - else if cmp<0 then - r:=m - else begin - Result:=CurFilename; - exit; + if ShortFilename='' then exit; + if Directory<>'' then begin + UpdateListing; + if (FListing.Names=nil) then exit; + l:=0; + r:=FListing.NameCount-1; + while r>=l do begin + m:=(l+r) shr 1; + CurFilename:=@FListing.Names[FListing.NameStarts[m]]; + case FileCase of + ctsfcDefault: + {$IFDEF CaseInsensitiveFilenames} + cmp:=stricomp(PChar(ShortFilename),CurFilename); + {$ELSE} + cmp:=strcomp(PChar(ShortFilename),CurFilename); + {$ENDIF} + ctsfcAllCase,ctsfcLoUpCase: + cmp:=stricomp(PChar(ShortFilename),CurFilename); + else RaiseDontKnow; + end; + if cmp>0 then + l:=m+1 + else if cmp<0 then + r:=m-1 + else begin + Result:=CurFilename; + exit; + end; end; + end else begin + // this is a virtual directory + Result:=Pool.FindVirtualFile(ShortFilename); end; end; -function TCTDirectoryCache.FindUnitSource(var UnitName, InFilename: string; +function TCTDirectoryCache.FindUnitSource(const UnitName: string; AnyCase: boolean): string; var - UnitSrc: TCTDirectoryUnitSources; + l: Integer; + r: Integer; + m: Integer; + cmp: LongInt; + CurFilename: PChar; + CurFilenameLen: LongInt; +begin + Result:=''; + //DebugLn('TCTDirectoryCache.FindUnitSource UnitName="',Unitname,'" AnyCase=',dbgs(AnyCase),' Directory=',Directory); + if UnitName='' then exit; + if Directory<>'' then begin + UpdateListing; + if (FListing.Names=nil) then exit; + l:=0; + r:=FListing.NameCount-1; + while r>=l do begin + m:=(l+r) shr 1; + CurFilename:=@FListing.Names[FListing.NameStarts[m]]; + cmp:=stricomp(PChar(UnitName),CurFilename); + if cmp>0 then + l:=m+1 + else if cmp<0 then + r:=m-1 + else + break; + end; + // now all files above m are higher than the Unitname + // -> check that m is equal or above + if (m>0) and (Cmp>0) then + inc(m); + // now all files below m are lower than the Unitname + // -> now find a filename with correct case and extension + while mPool.TimeStamp) then begin - // cache is invalid -> clear to make it valid - if Files<>nil then - Files.Clear; - FUnitSources[UnitSrc].TimeStamp:=Pool.TimeStamp; - Result:=false; - end else begin - // cache is valid - if Files<>nil then begin - Result:=Files.GetString(Search,Filename); - end else begin - Result:=false; + // check if the filename prefix is the unitname + // if not, then all filenames are not compatible as well + if CurFilenameLen0 then break; + + // check if the filename fits + if (CompareFilenameOnly(CurFilename,CurFilenameLen, + PChar(UnitName),length(UnitName),false)=0) + and FilenameIsPascalUnit(CurFilename,CurFilenameLen,false) + then begin + // the unitname is ok and the extension is ok + Result:=CurFilename; + if AnyCase then begin + exit; + end else begin + // check case + if (Result=lowercase(Result)) + or (Result=uppercase(Result)) + or (ExtractFileNameOnly(Result)=UnitName) then + exit; + end; end; + inc(m); end; + end else begin + // this is a virtual directory + Result:=Pool.FindVirtualUnit(UnitName); + if Result<>'' then exit; end; - - procedure AddToCache(const Search, Filename: string); - var - Files: TStringToStringTree; - begin - Files:=FUnitSources[UnitSrc].Files; - if Files=nil then begin - Files:=TStringToStringTree.Create(not AnyCase); - FUnitSources[UnitSrc].Files:=Files; - end; - Files[Search]:=Filename; - end; - + Result:=''; +end; + +function TCTDirectoryCache.FindUnitSourceInCleanSearchPath(const Unitname, + SearchPath: string; AnyCase: boolean): string; var + p, StartPos, l: integer; + CurPath: string; + IsAbsolute: Boolean; +begin + //if (CompareText(Unitname,'UnitDependencies')=0) then + // DebugLn('TCTDirectoryCache.FindUnitSourceInCleanSearchPath UnitName="',Unitname,'" SearchPath="',SearchPath,'"'); + StartPos:=1; + l:=length(SearchPath); + while StartPos<=l do begin + p:=StartPos; + while (p<=l) and (SearchPath[p]<>';') do inc(p); + CurPath:=Trim(copy(SearchPath,StartPos,p-StartPos)); + if CurPath<>'' then begin + IsAbsolute:=FilenameIsAbsolute(CurPath); + if (not IsAbsolute) and (Directory<>'') then begin + CurPath:=Directory+CurPath; + IsAbsolute:=true; + end; + //DebugLn('TCTDirectoryCache.FindUnitSourceInCleanSearchPath CurPath="',CurPath,'"'); + if IsAbsolute then begin + CurPath:=AppendPathDelim(CurPath); + Result:=Pool.FindUnitInDirectory(CurPath,UnitName,AnyCase); + end else if (CurPath='.') and (Directory='') then begin + Result:=Pool.FindVirtualUnit(Unitname); + end; + if Result<>'' then exit; + end; + StartPos:=p+1; + end; + Result:=''; +end; + +function TCTDirectoryCache.FindUnitSourceInCompletePath( + var UnitName, InFilename: string; AnyCase: boolean): string; +var + UnitSrc: TCTDirectoryUnitSources; CurDir: String; SrcPath: string; NewUnitName: String; - SearchCase: TCTSearchFileCase; begin + Result:=''; + //DebugLn('TCTDirectoryCache.FindUnitSourceInCompletePath UnitName="',Unitname,'" InFilename="',InFilename,'"'); if InFilename<>'' then begin // uses IN parameter InFilename:=TrimFilename(SetDirSeparators(InFilename)); @@ -598,7 +753,7 @@ begin UnitSrc:=ctdusInFilenameCaseInsenstive else UnitSrc:=ctdusInFilenameNormal; - if GetUnitSourceCacheValue(InFilename,Result) then begin + if GetUnitSourceCacheValue(UnitSrc,InFilename,Result) then begin // found in cache if Result<>'' then begin // unit found @@ -610,21 +765,22 @@ begin end else begin // not found in cache -> search if FilenameIsAbsolute(InFilename) then begin + // absolute filename if AnyCase then - Result:=FindDiskFilename(InFilename) + Result:=Pool.FindDiskFilename(InFilename) else Result:=InFilename; if FileExistsCached(Result) then - InFilename:=Result + InFilename:=CreateRelativePath(Result,Directory) else Result:=''; end else begin - // file is relative to current directory - // -> search file in current directory + // 'in'-filename has no complete path + // -> search file relative to current directory CurDir:=Directory; if CurDir<>'' then begin if AnyCase then - Result:=SearchFileInDir(InFilename,CurDir,ctsfcAllCase) + Result:=Pool.FindDiskFilename(CurDir+InFilename) else Result:=TrimFilename(CurDir+InFilename); if FileExistsCached(Result) then begin @@ -633,11 +789,12 @@ begin Result:=''; end; end else begin - // virtual directory -> TODO - Result:=''; + // this is a virtual directory -> search virtual unit + InFilename:=Pool.FindVirtualFile(InFilename); + Result:=InFilename; end; end; - AddToCache(InFilename,Result); + AddToCache(UnitSrc,InFilename,Result); end; end else begin // normal unit name @@ -646,7 +803,7 @@ begin UnitSrc:=ctdusUnitCaseInsensitive else UnitSrc:=ctdusUnitNormal; - if GetUnitSourceCacheValue(UnitName,Result) then begin + if GetUnitSourceCacheValue(UnitSrc,UnitName,Result) then begin // found in cache if Result<>'' then begin // unit found @@ -654,42 +811,89 @@ begin // unit not found end; end else begin - // not found in cache -> search + // not found in cache -> search in complete source path - // search in unit, src and compiled src path SrcPath:=Strings[ctdcsCompleteSrcPath]; - if SysUtils.CompareText(UnitName,'Forms')=0 then begin - DebugLn('============================================================== '); - DebugLn('TFindDeclarationTool.FindUnitCaseInsensitive ',SrcPath); + + // search in search path + Result:=FindUnitSourceInCleanSearchPath(UnitName,SrcPath,AnyCase); + if Result='' then begin + // search in unit links + Result:=FindUnitLink(UnitName); + end; + if Result<>'' then begin + NewUnitName:=ExtractFileNameOnly(Result); + if (NewUnitName<>lowercase(NewUnitName)) + and (UnitName<>NewUnitName) then + UnitName:=NewUnitName; end; - CurDir:=Directory; - if CurDir<>'' then begin - // search in search path - if AnyCase then - SearchCase:=ctsfcAllCase - else - SearchCase:=ctsfcLoUpCase; - Result:=SearchPascalUnitInPath(UnitName,CurDir,SrcPath,';',SearchCase); - if Result='' then begin - // search in unit links - Result:=FindUnitLink(UnitName); - end; - if Result<>'' then begin - NewUnitName:=ExtractFileNameOnly(Result); - if (NewUnitName<>lowercase(NewUnitName)) - and (UnitName<>NewUnitName) then - UnitName:=NewUnitName; - end; - end else begin - // virtual directory -> TODO - Result:=''; - end; - - AddToCache(UnitName,Result); + AddToCache(UnitSrc,UnitName,Result); end; end; - //DebugLn('TFindDeclarationTool.FindUnitCaseInsensitive RESULT AnUnitName=',AnUnitName,' InFilename=',InFilename,' Result=',Result); + //DebugLn('TCTDirectoryCache.FindUnitSourceInCompletePath RESULT UnitName="',UnitName,'" InFilename="',InFilename,'" Result=',Result); +end; + +function TCTDirectoryCache.FindCompiledUnitInCompletePath( + var ShortFilename: string; AnyCase: boolean): string; +var + UnitPath: string; + NewShortFilename: String; + UnitSrc: TCTDirectoryUnitSources; + CurDir: String; + SearchCase: TCTSearchFileCase; +begin + Result:=''; + if AnyCase then + UnitSrc:=ctdusUnitFileCaseInsensitive + else + UnitSrc:=ctdusUnitFileNormal; + if GetUnitSourceCacheValue(UnitSrc,ShortFilename,Result) then begin + // found in cache + if Result<>'' then begin + // unit found + end else begin + // unit not found + end; + end else begin + // not found in cache -> search + + // search in unit, src and compiled src path + UnitPath:=Strings[ctdcsUnitPath]; + + CurDir:=Directory; + if CurDir<>'' then begin + // search in search path + if AnyCase then + SearchCase:=ctsfcAllCase + else + SearchCase:=ctsfcLoUpCase; + Result:=SearchPascalFileInPath(ShortFilename,CurDir,UnitPath,';',SearchCase); + if Result<>'' then begin + NewShortFilename:=ExtractFileName(Result); + if (NewShortFilename<>lowercase(NewShortFilename)) + and (ShortFilename<>NewShortFilename) then + ShortFilename:=NewShortFilename; + end; + end else begin + // virtual directory -> TODO + Result:=''; + end; + + AddToCache(UnitSrc,ShortFilename,Result); + end; +end; + +procedure TCTDirectoryCache.WriteListing; +var + i: Integer; + Filename: PChar; +begin + writeln('TCTDirectoryCache.WriteListing Count=',FListing.NameCount,' TextLen=',FListing.NamesLength); + for i:=0 to FListing.NameCount-1 do begin + Filename:=@FListing.Names[FListing.NameStarts[i]]; + writeln(i,' "',Filename,'"'); + end; end; { TCTDirectoryCachePool } @@ -783,6 +987,53 @@ begin Result:=Cache.FindUnitLink(UnitName); end; +function TCTDirectoryCachePool.FindDiskFilename(const Filename: string + ): string; +var + ADirectory: String; + Cache: TCTDirectoryCache; + ShortFilename: String; +begin + Result:=TrimFilename(Filename); + ADirectory:=ExtractFilePath(Result); + Cache:=GetCache(ADirectory,true,false); + ShortFilename:=ExtractFileName(Result); + Result:=Cache.FindFile(ShortFilename,ctsfcAllCase); + if Result='' then exit; + Result:=Cache.Directory+Result; +end; + +function TCTDirectoryCachePool.FindUnitInDirectory(const Directory, + UnitName: string; AnyCase: boolean): string; +var + Cache: TCTDirectoryCache; +begin + Cache:=GetCache(Directory,true,false); + Result:=Cache.FindUnitSource(UnitName,AnyCase); + if Result='' then exit; + Result:=Cache.Directory+Result; +end; + +function TCTDirectoryCachePool.FindVirtualFile(const Filename: string): string; +begin + if Assigned(OnFindVirtualFile) then + Result:=OnFindVirtualFile(Filename) + else + Result:=''; +end; + +function TCTDirectoryCachePool.FindVirtualUnit(const UnitName: string): string; +var + e: TCTPascalExtType; +begin + for e:=Low(CTPascalExtension) to High(CTPascalExtension) do begin + if CTPascalExtension[e]='' then continue; + Result:=FindVirtualFile(UnitName+CTPascalExtension[e]); + if Result<>'' then exit; + end; + Result:=''; +end; + { TCTDirectoryListing } destructor TCTDirectoryListing.Destroy; @@ -796,6 +1047,7 @@ begin if NameStarts<>nil then begin FreeMem(NameStarts); NameStarts:=nil; + NamesLength:=0; FreeMem(Names); Names:=nil; NameCount:=0; diff --git a/components/codetools/fileprocs.pas b/components/codetools/fileprocs.pas index 661dea65b6..29aa36cd92 100644 --- a/components/codetools/fileprocs.pas +++ b/components/codetools/fileprocs.pas @@ -63,7 +63,7 @@ type function CompareFilenames(const Filename1, Filename2: string): integer; function CompareFileExt(const Filename, Ext: string; - CaseSensitive: boolean): integer; + CaseSensitive: boolean): integer; function DirPathExists(DirectoryName: string): boolean; function DirectoryIsWritable(const DirectoryName: string): boolean; function ExtractFileNameOnly(const AFilename: string): string; @@ -97,14 +97,25 @@ function GetFilenameOnDisk(const AFilename: string): string; function FindDiskFilename(const Filename: string): string; function CompareAnsiStringFilenames(Data1, data2: Pointer): integer; +function CompareFilenameOnly(Filename: PChar; FilenameLen: integer; + NameOnly: PChar; NameOnlyLen: integer; CaseSensitive: boolean): integer; +// searching .pas, .pp, .p function FilenameIsPascalUnit(const Filename: string; CaseSensitive: boolean = false): boolean; +function FilenameIsPascalUnit(Filename: PChar; FilenameLen: integer; + CaseSensitive: boolean = false): boolean; function SearchPascalUnitInDir(const AnUnitName, BaseDirectory: string; SearchCase: TCTSearchFileCase): string; function SearchPascalUnitInPath(const AnUnitName, BasePath, SearchPath, Delimiter: string; SearchCase: TCTSearchFileCase): string; +// searching .ppu +function SearchPascalFileInDir(const ShortFilename, BaseDirectory: string; + SearchCase: TCTSearchFileCase): string; +function SearchPascalFileInPath(const ShortFilename, BasePath, SearchPath, + Delimiter: string; SearchCase: TCTSearchFileCase): string; + function CreateAbsoluteSearchPath(const SearchPath, BaseDirectory: string): string; function CreateRelativeSearchPath(const SearchPath, BaseDirectory: string): string; function MinimizeSearchPath(const SearchPath: string): string; @@ -439,6 +450,44 @@ begin Pointer(s2):=nil; end; +function CompareFilenameOnly(Filename: PChar; FilenameLen: integer; + NameOnly: PChar; NameOnlyLen: integer; CaseSensitive: boolean): integer; +// compare only the filename (without extension and path) +var + EndPos: integer; + StartPos: LongInt; + p: Integer; + l: LongInt; + FilenameOnlyLen: Integer; +begin + StartPos:=FilenameLen; + while (StartPos>0) and (Filename[StartPos-1]<>PathDelim) do dec(StartPos); + EndPos:=FilenameLen; + while (EndPos>StartPos) and (Filename[EndPos]<>'.') do dec(EndPos); + if (EndPos=StartPos) and (EndPos'.') then + EndPos:=FilenameLen; + FilenameOnlyLen:=EndPos-StartPos; + l:=FilenameOnlyLen; + if l>NameOnlyLen then + l:=NameOnlyLen; + //DebugLn('CompareFilenameOnly NameOnly="',copy(NameOnly,1,NameOnlyLen),'" FilenameOnly="',copy(Filename,StartPos,EndPos-StartPos),'"'); + p:=0; + if CaseSensitive then begin + while p0 then exit; + inc(p); + end; + end else begin + while p0 then exit; + inc(p); + end; + end; + Result:=FilenameOnlyLen-NameOnlyLen; +end; + function CompareFilenames(const Filename1, Filename2: string): integer; begin {$IFDEF CaseInsensitiveFilenames} @@ -922,6 +971,41 @@ begin Result:=false; end; +function FilenameIsPascalUnit(Filename: PChar; FilenameLen: integer; + CaseSensitive: boolean): boolean; +var + StartPos: LongInt; + ExtLen: Integer; + e: TCTPascalExtType; + i: Integer; + p: PChar; +begin + StartPos:=FilenameLen-1; + while (StartPos>=0) and (Filename[StartPos]<>'.') do dec(StartPos); + if StartPos<0 then exit(false); + ExtLen:=FilenameLen-StartPos; + for e:=Low(CTPascalExtension) to High(CTPascalExtension) do begin + if (CTPascalExtension[e]='') or (length(CTPascalExtension[e])<>ExtLen) then + continue; + i:=0; + p:=PChar(CTPascalExtension[e]); + if CaseSensitive then begin + while (i0; + end; + SysUtils.FindClose(FileInfo); + if Result<>'' then Result:=Base+Result; +end; + +function SearchPascalFileInPath(const ShortFilename, BasePath, SearchPath, + Delimiter: string; SearchCase: TCTSearchFileCase): string; +var + p, StartPos, l: integer; + CurPath, Base: string; +begin + Base:=ExpandFilename(AppendPathDelim(BasePath)); + // search in current directory + Result:=SearchPascalUnitInDir(ShortFilename,Base,SearchCase); + if Result<>'' then exit; + // search in search path + StartPos:=1; + l:=length(SearchPath); + while StartPos<=l do begin + p:=StartPos; + while (p<=l) and (pos(SearchPath[p],Delimiter)<1) do inc(p); + CurPath:=Trim(copy(SearchPath,StartPos,p-StartPos)); + if CurPath<>'' then begin + if not FilenameIsAbsolute(CurPath) then + CurPath:=Base+CurPath; + CurPath:=ExpandFilename(AppendPathDelim(CurPath)); + Result:=SearchPascalUnitInDir(ShortFilename,CurPath,SearchCase); + if Result<>'' then exit; + end; + StartPos:=p+1; + end; + Result:=''; +end; + function CreateAbsoluteSearchPath(const SearchPath, BaseDirectory: string ): string; var @@ -1156,7 +1345,7 @@ begin break; inc(CmpPos); end; - if CmpPosnil; - end; - - function SearchUnitFileInDir(const ADir, AnUnitName: string; - SearchSource: boolean): TCodeBuffer; - var APath: string; - begin - APath:=ADir; - if (APath<>'') and (APath[length(APath)]<>PathDelim) then - APath:=APath+PathDelim; - // search as FPC: first lowercase, then keeping case, then uppercase - if SearchSource then begin - if LoadFile(ADir+AnUnitName+'.pp',Result) then exit; - if LoadFile(ADir+AnUnitName+'.pas',Result) then exit; - if LoadFile(ADir+AnUnitName+'.p',Result) then exit; - {$IFNDEF win32} - if LoadFile(ADir+lowercase(AnUnitName)+'.pp',Result) then exit; - if LoadFile(ADir+lowercase(AnUnitName)+'.pas',Result) then exit; - if LoadFile(ADir+lowercase(AnUnitName)+'.p',Result) then exit; - if LoadFile(ADir+UpperCaseStr(AnUnitName)+'.pp',Result) then exit; - if LoadFile(ADir+UpperCaseStr(AnUnitName)+'.pas',Result) then exit; - if LoadFile(ADir+UpperCaseStr(AnUnitName)+'.p',Result) then exit; - {$ENDIF} - end else begin - if LoadFile(ADir+AnUnitName+CompiledSrcExt,Result) then exit; - {$IFNDEF win32} - if LoadFile(ADir+lowercase(AnUnitName)+CompiledSrcExt,Result) then exit; - if LoadFile(ADir+UpperCaseStr(AnUnitName)+CompiledSrcExt,Result) then exit; - {$ENDIF} - end; - Result:=nil; - end; - - function SearchUnitFileInPath(const APath, TheUnitName: string; - SearchSource: boolean): TCodeBuffer; - var PathStart, PathEnd: integer; - ADir: string; - begin - PathStart:=1; - while PathStart<=length(APath) do begin - PathEnd:=PathStart; - while (PathEnd<=length(APath)) and (APath[PathEnd]<>';') do inc(PathEnd); - if PathEnd>PathStart then begin - ADir:=copy(APath,PathStart,PathEnd-PathStart); - if (ADir<>'') and (ADir[length(ADir)]<>PathDelim) then - ADir:=ADir+PathDelim; - if not FilenameIsAbsolute(ADir) then ADir:=CurDir+ADir; - Result:=SearchUnitFileInDir(ADir,TheUnitName,SearchSource); - if Result<>nil then exit; - end; - PathStart:=PathEnd+1; - end; - Result:=nil; - end; - - function SearchUnitFileInCompiledSrcPaths(const APath, TheUnitName: string - ): TCodeBuffer; - var PathStart, PathEnd: integer; - ADir: string; - CurCompiledSrcPath: string; - begin - {$IFDEF ShowTriedFiles} - DebugLn('TFindDeclarationTool..SearchUnitFileInCompiledSrcPaths START APath="',APath,'" TheUnitName="',TheUnitName,'"'); - {$ENDIF} - if not Assigned(OnGetSrcPathForCompiledUnit) then begin - Result:=nil; - exit; - end; - - PathStart:=1; - while PathStart<=length(APath) do begin - PathEnd:=PathStart; - while (PathEnd<=length(APath)) and (APath[PathEnd]<>';') do inc(PathEnd); - if PathEnd>PathStart then begin - // extract and expand current search directory - ADir:=copy(APath,PathStart,PathEnd-PathStart); - if (ADir<>'') and (ADir[length(ADir)]<>PathDelim) then - ADir:=ADir+PathDelim; - if not FilenameIsAbsolute(ADir) then ADir:=CurDir+ADir; - // get CompiledSrcPath for current search directory - CurCompiledSrcPath:=OnGetSrcPathForCompiledUnit(Self,ADir); - if CurCompiledSrcPath<>'' then begin - // this directory is an unit output directory - // -> search the source in the current CompiledSrcPath - {$IFDEF ShowTriedFiles} - DebugLn('TFindDeclarationTool..SearchUnitFileInCompiledSrcPaths CurCompiledSrcPath="',CurCompiledSrcPath,'"'); - {$ENDIF} - Result:=SearchUnitFileInPath(CurCompiledSrcPath,TheUnitName,true); - if Result<>nil then exit; - end; - end; - PathStart:=PathEnd+1; - end; - Result:=nil; - end; - - function SearchFileInPath(const APath, RelativeFilename: string): TCodeBuffer; - var PathStart, PathEnd: integer; - ADir: string; - begin - PathStart:=1; - while PathStart<=length(APath) do begin - PathEnd:=PathStart; - while (PathEnd<=length(APath)) and (APath[PathEnd]<>';') do inc(PathEnd); - if PathEnd>PathStart then begin - ADir:=copy(APath,PathStart,PathEnd-PathStart); - if (ADir<>'') and (ADir[length(ADir)]<>PathDelim) then - ADir:=ADir+PathDelim; - if not FilenameIsAbsolute(ADir) then ADir:=CurDir+ADir; - if LoadFile(ADir+RelativeFilename,Result) then exit; - end; - PathStart:=PathEnd+1; - end; - Result:=nil; - end; - -var - UnitSrcSearchPath: string; - MainCodeIsVirtual: boolean; - CompiledResult: TCodeBuffer; - UnitSearchPath: string; - SrcPathInitialized: boolean; - WorkingUnitInFilename: String; - CurFilename: String; - - procedure InitSrcPath; - begin - if SrcPathInitialized then exit; - SrcPathInitialized:=true; - if Assigned(OnGetUnitSourceSearchPath) then begin - UnitSearchPath:=''; - UnitSrcSearchPath:=OnGetUnitSourceSearchPath(Self); - end else begin - UnitSearchPath:=Scanner.Values[ExternalMacroStart+'UnitPath']; - UnitSrcSearchPath:=Scanner.Values[ExternalMacroStart+'SrcPath']; - if UnitSearchPath<>'' then begin - if UnitSrcSearchPath<>'' then - UnitSrcSearchPath:=UnitSrcSearchPath+';'+UnitSearchPath - else - UnitSrcSearchPath:=UnitSearchPath; - end; - end; - end; - + CompiledFilename: string; + AFilename: String; + NewUnitName: String; + NewInFilename: String; + NewCompiledUnitname: String; begin {$IFDEF ShowTriedFiles} - DebugLn('TFindDeclarationTool.FindUnitSource A AnUnitName=',AnUnitName,' AnUnitInFilename=',AnUnitInFilename,' Self="',MainFilename,'"'); + DebugLn('TFindDeclarationTool.FindUnitSource A AnUnitName="',AnUnitName,'" AnUnitInFilename="',AnUnitInFilename,'" Self="',MainFilename,'"'); {$ENDIF} Result:=nil; if (AnUnitName='') or (Scanner=nil) or (Scanner.MainCode=nil) @@ -1756,112 +1607,32 @@ begin RaiseException('TFindDeclarationTool.FindUnitSource Invalid Data'); end; - SrcPathInitialized:=false; - UnitSearchPath:=''; - UnitSrcSearchPath:=''; - CompiledSrcExt:='.ppu'; - CompiledResult:=nil; - //DebugLn('>>>>>',Scanner.Values.AsString,'<<<<<'); - MainCodeIsVirtual:=TCodeBuffer(Scanner.MainCode).IsVirtual; - if not MainCodeIsVirtual then begin - CurDir:=ExtractFilePath(TCodeBuffer(Scanner.MainCode).Filename); - end else begin - CurDir:=''; - end; + NewUnitName:=AnUnitName; + NewInFilename:=AnUnitInFilename; + AFilename:=DirectoryCache.FindUnitSourceInCompletePath( + NewUnitName,NewInFilename,false); + Result:=TCodeBuffer(Scanner.OnLoadSource(Self,AFilename,true)); - // search as the compiler would search - if AnUnitInFilename<>'' then begin - // uses IN parameter - WorkingUnitInFilename:=SetDirSeparators(AnUnitInFilename); - if FilenameIsAbsolute(WorkingUnitInFilename) then begin - Result:=TCodeBuffer(Scanner.OnLoadSource(Self,WorkingUnitInFilename,true)); - end else begin - // file is relative to current unit directory - // -> search file in current directory - CurDir:=AppendPathDelim(CurDir); - if not LoadFile(CurDir+WorkingUnitInFilename,Result) then begin - Result:=nil; - end; - end; - end else begin - // normal unit name - // first search in current directory (= where the maincode is) - {$IFDEF ShowTriedFiles} - DebugLn('TFindDeclarationTool.FindUnitSource Search in current dir=',CurDir); - {$ENDIF} - Result:=SearchUnitFileInDir(CurDir,AnUnitName,true); - if Result=nil then begin - // search source in search path - {$IFDEF ShowTriedFiles} - DebugLn('TFindDeclarationTool.FindUnitSource Search in search path=',UnitSrcSearchPath); - {$ENDIF} - InitSrcPath; - Result:=SearchUnitFileInPath(UnitSrcSearchPath,AnUnitName,true); - end; - if Result=nil then begin - // search for compiled unit - - // search compiled unit in current directory - {$IFDEF ShowTriedFiles} - DebugLn('TFindDeclarationTool.FindUnitSource Search Compiled unit in current dir=',CurDir); - {$ENDIF} - if Scanner.InitialValues.IsDefined('WIN32') - and Scanner.InitialValues.IsDefined('VER1_0') then - CompiledSrcExt:='.ppw'; - CompiledResult:=SearchUnitFileInDir(CurDir,AnUnitName,false); - - // search compiled unit in unit path - if CompiledResult=nil then begin - UnitSearchPath:=Scanner.Values[ExternalMacroStart+'UnitPath']; - {$IFDEF ShowTriedFiles} - DebugLn('TFindDeclarationTool.FindUnitSource Search Compiled unit in unit path=',UnitSearchPath); - {$ENDIF} - CompiledResult:=SearchUnitFileInPath(UnitSearchPath,AnUnitName,false); - end; - - if (CompiledResult<>nil) then begin - // there is a compiled unit - if Assigned(OnGetSrcPathForCompiledUnit) - and (not CompiledResult.IsVirtual) then begin - UnitSrcSearchPath:= - OnGetSrcPathForCompiledUnit(Self,CompiledResult.Filename); - CurDir:=ExtractFilePath(CompiledResult.Filename); - // search source in search path of compiled unit - {$IFDEF ShowTriedFiles} - DebugLn('TFindDeclarationTool.FindUnitSource Search in Compiled unit search path=',UnitSrcSearchPath); - {$ENDIF} - Result:=SearchUnitFileInPath(UnitSrcSearchPath,AnUnitName,true); - end; - end; - end; - if Result=nil then begin - // search in every unit path for a CompiledSrcPath and search there - - {$IFDEF ShowTriedFiles} - DebugLn('TFindDeclarationTool.FindUnitSource Search Compiled unit in current dir=',CurDir); - {$ENDIF} - UnitSearchPath:=Scanner.Values[ExternalMacroStart+'UnitPath']; - Result:=SearchUnitFileInCompiledSrcPaths(UnitSearchPath,AnUnitName); - end; - - if Result=nil then begin - // search in FPC source directory - CurFilename:=SearchUnitInUnitLinks(AnUnitName); - if CurFilename<>'' then - LoadFile(CurFilename,Result); - end; - end; if (Result=nil) and Assigned(OnFindUsedUnit) then begin // no unit found Result:=OnFindUsedUnit(Self,AnUnitName,AnUnitInFilename); end; + if Result=nil then begin + // search .ppu + NewCompiledUnitname:=AnUnitName+'.ppu'; + CompiledFilename:=DirectoryCache.FindCompiledUnitInCompletePath( + NewCompiledUnitname,false); + end else begin + CompiledFilename:=''; + end; + if (Result=nil) and ExceptionOnNotFound then begin - if CompiledResult<>nil then begin + if CompiledFilename<>'' then begin // there is a compiled unit, only the source was not found RaiseExceptionInstance( ECodeToolUnitNotFound.Create(Self, - Format(ctsSourceNotFoundUnit, [CompiledResult.Filename]),AnUnitName)); + Format(ctsSourceNotFoundUnit, [CompiledFilename]),AnUnitName)); end else begin // nothing found RaiseExceptionInstance( @@ -1873,60 +1644,10 @@ end; function TFindDeclarationTool.FindUnitCaseInsensitive(var AnUnitName, AnUnitInFilename: string): string; -var - CurDir: String; - UnitPath, SrcPath: string; - NewUnitName: String; begin - //DebugLn('TFindDeclarationTool.FindUnitCaseInsensitive AnUnitName=',AnUnitName,' AnUnitInFilename=',AnUnitInFilename); - if AnUnitInFilename<>'' then begin - // uses IN parameter - AnUnitInFilename:=TrimFilename(SetDirSeparators(AnUnitInFilename)); - if FilenameIsAbsolute(AnUnitInFilename) then begin - Result:=FindDiskFilename(AnUnitInFilename); - if FileExists(Result) then - AnUnitInFilename:=Result - else - Result:=''; - end else begin - // file is relative to current unit directory - // -> search file in current directory - CurDir:=ExtractFilePath(MainFilename); - if CurDir<>'' then begin - Result:=SearchFileInDir(AnUnitInFilename,CurDir,ctsfcAllCase); - if FileExists(Result) then begin - AnUnitInFilename:=CreateRelativePath(Result,CurDir); - end else begin - Result:=''; - end; - end else begin - // virtual unit -> TODO - Result:=''; - end; - end; - end else begin - // normal unit name - // search in unit, src and compiled src path - GatherUnitAndSrcPath(UnitPath,SrcPath); - if SysUtils.CompareText(AnUnitName,'Forms')=0 then begin - DebugLn('============================================================== '); - DebugLn('TFindDeclarationTool.FindUnitCaseInsensitive ',UnitPath+';'+SrcPath); - end; - - Result:=SearchPascalUnitInPath(AnUnitName,CurDir,SrcPath,';',ctsfcAllCase); - if Result='' then begin - // search in unit links - Result:=SearchUnitInUnitLinks(AnUnitName); - end; - if Result<>'' then begin - NewUnitName:=ExtractFileNameOnly(Result); - if (NewUnitName<>lowercase(NewUnitName)) - and (AnUnitName<>NewUnitName) then - AnUnitName:=NewUnitName; - end; - //DebugLn('TFindDeclarationTool.FindUnitCaseInsensitive TODO search unit'); - end; - //DebugLn('TFindDeclarationTool.FindUnitCaseInsensitive RESULT AnUnitName=',AnUnitName,' AnUnitInFilename=',AnUnitInFilename,' Result=',Result); + if not CheckDirectoryCache then exit; + Result:=DirectoryCache.FindUnitSourceInCompletePath( + AnUnitName,AnUnitInFilename,true); end; procedure TFindDeclarationTool.GatherUnitAndSrcPath(var UnitPath, @@ -1935,8 +1656,8 @@ begin UnitPath:=''; CompleteSrcPath:=''; if not CheckDirectoryCache then exit; - UnitPath:=DirectoryValues.Strings[ctdcsUnitPath]; - CompleteSrcPath:=DirectoryValues.Strings[ctdcsCompleteSrcPath]; + UnitPath:=DirectoryCache.Strings[ctdcsUnitPath]; + CompleteSrcPath:=DirectoryCache.Strings[ctdcsCompleteSrcPath]; //DebugLn('TFindDeclarationTool.GatherUnitAndSrcPath UnitPath="',UnitPath,'" CompleteSrcPath="',CompleteSrcPath,'"'); end; @@ -1945,7 +1666,7 @@ function TFindDeclarationTool.SearchUnitInUnitLinks(const TheUnitName: string begin Result:=''; if not CheckDirectoryCache then exit; - Result:=DirectoryValues.FindUnitLink(TheUnitName); + Result:=DirectoryCache.FindUnitLink(TheUnitName); end; function TFindDeclarationTool.FindSmartHint(const CursorPos: TCodeXYPosition @@ -4670,7 +4391,7 @@ begin RaiseException('[TFindDeclarationTool.FindCodeToolForUsedUnit] ' +'internal error: invalid UnitNameAtom'); AnUnitName:=copy(Src,UnitNameAtom.StartPos, - UnitNameAtom.EndPos-UnitNameAtom.StartPos); + UnitNameAtom.EndPos-UnitNameAtom.StartPos); if UnitInFileAtom.StartPos>=1 then begin if (UnitInFileAtom.StartPos<1) or (UnitInFileAtom.EndPos<=UnitInFileAtom.StartPos) @@ -7262,10 +6983,10 @@ end; function TFindDeclarationTool.CheckDirectoryCache: boolean; begin - if FDirectoryValues<>nil then exit(true); + if FDirectoryCache<>nil then exit(true); if Assigned(OnGetDirectoryCache) then - FDirectoryValues:=OnGetDirectoryCache(ExtractFilePath(MainFilename)); - Result:=FDirectoryValues<>nil; + FDirectoryCache:=OnGetDirectoryCache(ExtractFilePath(MainFilename)); + Result:=FDirectoryCache<>nil; end; procedure TFindDeclarationTool.DoDeleteNodes; @@ -7348,9 +7069,9 @@ begin FDependsOnCodeTools:=nil; FDependentCodeTools.Free; FDependentCodeTools:=nil; - if FDirectoryValues<>nil then begin - FDirectoryValues.Release; - FDirectoryValues:=nil; + if FDirectoryCache<>nil then begin + FDirectoryCache.Release; + FDirectoryCache:=nil; end; inherited Destroy; end; diff --git a/components/codetools/stdcodetools.pas b/components/codetools/stdcodetools.pas index ff5b9f6b95..00eb3c4a02 100644 --- a/components/codetools/stdcodetools.pas +++ b/components/codetools/stdcodetools.pas @@ -943,7 +943,8 @@ function TStandardCodeTool.FindMissingUnits(var MissingUnits: TStrings; // find unit file NewUnitName:=OldUnitName; NewInFilename:=OldInFilename; - AFilename:=DirectoryValues.FindUnitSource(NewUnitName,NewInFilename,true); + AFilename:=DirectoryCache.FindUnitSourceInCompletePath( + NewUnitName,NewInFilename,true); s:=NewUnitName; if NewInFilename<>'' then s:=s+' in '''+NewInFilename+'''';