paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-01 16:19:37 +01:00
Code Issues Packages Projects Releases Wiki Activity

added codetools cache for unit search

Browse Source 
git-svn-id: trunk@8951 -
This commit is contained in:
mattias 2006-03-17 23:44:24 +00:00
parent 0dd09a9638
commit 663d9d28c4
8 changed files with 678 additions and 490 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

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

3
components/codetools/allcodetoolunits.pp
View File

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

28
components/codetools/codetoolmanager.pas
View File

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

2
components/codetools/definetemplates.pas
View File

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

556
components/codetools/directorycache.pas → components/codetools/directorycacher.pas
View File

@ -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 m<FListing.NameCount do begin
CurFilename:=@FListing.Names[FListing.NameStarts[m]];
CurFilenameLen:=strlen(CurFilename);
function GetUnitSourceCacheValue(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;
// check if the filename prefix is the unitname
// if not, then all filenames are not compatible as well
if CurFilenameLen<length(UnitName) then break;
if strlicomp(CurFilename,PChar(Unitname),length(UnitName))<>0 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;

219
components/codetools/fileprocs.pas
View File

@ -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<FilenameLen) and (Filename[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 p<l do begin
Result:=ord(Filename[StartPos+p])-ord(NameOnly[p]);
if Result<>0 then exit;
inc(p);
end;
end else begin
while p<l do begin
Result:=ord(FPUpChars[Filename[StartPos+p]])-ord(FPUpChars[NameOnly[p]]);
if Result<>0 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 (i<ExtLen) and (p^=Filename[StartPos+i]) do begin
inc(i);
inc(p);
end;
end else begin
while (i<ExtLen) and (FPUpChars[p^]=FPUpChars[Filename[StartPos+i]]) do
begin
inc(i);
inc(p);
end;
end;
if i=ExtLen then exit(true);
end;
Result:=false;
end;
function SearchPascalUnitInDir(const AnUnitName, BaseDirectory: string;
SearchCase: TCTSearchFileCase): string;
@ -933,7 +1017,9 @@ function SearchPascalUnitInDir(const AnUnitName, BaseDirectory: string;
var
Base: String;
FileInfo: TSearchRec;
CurExt: String;
LowerCaseUnitname: String;
UpperCaseUnitname: String;
CurUnitName: String;
begin
Base:=AppendPathDelim(BaseDirectory);
Base:=TrimFilename(Base);
@ -941,6 +1027,15 @@ begin
Result:='';
if SearchCase=ctsfcAllCase then
Base:=FindDiskFilename(Base);
if SearchCase in [ctsfcDefault,ctsfcLoUpCase] then begin
LowerCaseUnitname:=lowercase(AnUnitName);
UpperCaseUnitname:=uppercase(AnUnitName);
end else begin
LowerCaseUnitname:='';
UpperCaseUnitname:='';
end;
if SysUtils.FindFirst(Base+FileMask,faAnyFile,FileInfo)=0 then
begin
repeat
@ -949,25 +1044,31 @@ begin
then
continue;
if not FilenameIsPascalUnit(FileInfo.Name,false) then continue;
CurExt:=ExtractFileExt(FileInfo.Name);
case SearchCase of
ctsfcDefault,ctsfcLoUpCase:
begin
if (AnUnitName+lowercase(CurExt)=FileInfo.Name)
or (lowercase(AnUnitName+CurExt)=FileInfo.Name)
or (uppercase(AnUnitName+CurExt)=FileInfo.Name)
then begin
if (CompareFilenameOnly(PChar(FileInfo.Name),length(FileInfo.Name),
PChar(AnUnitName),length(AnUnitName),false)=0)
then begin
CurUnitName:=ExtractFilePath(FileInfo.Name);
if CurUnitName=AnUnitName then begin
Result:=FileInfo.Name;
break;
end else if ((LowerCaseUnitname=CurUnitName)
or (UpperCaseUnitname=CurUnitName)) then begin
Result:=FileInfo.Name;
if AnUnitName+CurExt=FileInfo.Name then break;
end;
end;
ctsfcAllCase:
begin
if CompareText(AnUnitName+CurExt,FileInfo.Name)=0 then begin
Result:=FileInfo.Name;
if AnUnitName+CurExt=FileInfo.Name then break;
end;
if (CompareFilenameOnly(PChar(FileInfo.Name),length(FileInfo.Name),
PChar(AnUnitName),length(AnUnitName),true)=0)
then begin
Result:=FileInfo.Name;
CurUnitName:=ExtractFilePath(FileInfo.Name);
if CurUnitName=AnUnitName then
break;
end;
else
RaiseNotImplemented;
end;
@ -1006,6 +1107,94 @@ begin
Result:='';
end;
function SearchPascalFileInDir(const ShortFilename, BaseDirectory: string;
SearchCase: TCTSearchFileCase): string;
procedure RaiseNotImplemented;
begin
raise Exception.Create('not implemented');
end;
var
Base: String;
FileInfo: TSearchRec;
LowerCaseFilename: string;
UpperCaseFilename: string;
begin
Base:=AppendPathDelim(BaseDirectory);
Base:=TrimFilename(Base);
// search file
Result:='';
if SearchCase=ctsfcAllCase then
Base:=FindDiskFilename(Base);
if SearchCase in [ctsfcDefault,ctsfcLoUpCase] then begin
LowerCaseFilename:=lowercase(ShortFilename);
UpperCaseFilename:=uppercase(ShortFilename);
end else begin
LowerCaseFilename:='';
UpperCaseFilename:='';
end;
if SysUtils.FindFirst(Base+FileMask,faAnyFile,FileInfo)=0 then
begin
repeat
// check if special file
if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='')
then
continue;
case SearchCase of
ctsfcDefault,ctsfcLoUpCase:
if (ShortFilename=FileInfo.Name) then begin
Result:=FileInfo.Name;
break;
end else if (LowerCaseFilename=FileInfo.Name)
or (UpperCaseFilename=FileInfo.Name)
then
Result:=FileInfo.Name;
ctsfcAllCase:
if CompareText(ShortFilename,FileInfo.Name)=0 then begin
Result:=FileInfo.Name;
if ShortFilename=FileInfo.Name then break;
end;
else
RaiseNotImplemented;
end;
until SysUtils.FindNext(FileInfo)<>0;
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 CmpPos<EndPos then begin
if CmpPos=APathLen then begin
Result:=@SearchPath[StartPos];
exit;
end;

355
components/codetools/finddeclarationtool.pas
View File

@ -82,7 +82,7 @@ uses
MemCheck,
{$ENDIF}
Classes, SysUtils, CodeToolsStrConsts, CodeTree, CodeAtom, CustomCodeTool,
KeywordFuncLists, BasicCodeTools, LinkScanner, CodeCache, DirectoryCache,
KeywordFuncLists, BasicCodeTools, LinkScanner, CodeCache, DirectoryCacher,
AVL_Tree, PascalParserTool,
PascalReaderTool, FileProcs, DefineTemplates, FindDeclarationCache;
@ -517,7 +517,7 @@ type
TFindDeclarationTool = class(TPascalReaderTool)
private
FAdjustTopLineDueToComment: boolean;
FDirectoryValues: TCTDirectoryCache;
FDirectoryCache: TCTDirectoryCache;
FInterfaceIdentifierCache: TInterfaceIdentifierCache;
FOnFindUsedUnit: TOnFindUsedUnit;
FOnGetCodeToolForBuffer: TOnGetCodeToolForBuffer;
@ -747,7 +747,7 @@ type
read FOnGetSrcPathForCompiledUnit write fOnGetSrcPathForCompiledUnit;
property AdjustTopLineDueToComment: boolean
read FAdjustTopLineDueToComment write FAdjustTopLineDueToComment;
property DirectoryValues: TCTDirectoryCache read FDirectoryValues;
property DirectoryCache: TCTDirectoryCache read FDirectoryCache;
end;
function ExprTypeToString(const ExprType: TExpressionType): string;
@ -1589,163 +1589,14 @@ end;
function TFindDeclarationTool.FindUnitSource(const AnUnitName,
AnUnitInFilename: string; ExceptionOnNotFound: boolean): TCodeBuffer;
var
CurDir, CompiledSrcExt: string;
function LoadFile(const AFilename: string;
out NewCode: TCodeBuffer): boolean;
begin
{$IFDEF ShowTriedFiles}
DebugLn('TFindDeclarationTool.FindUnitSource.LoadFile ',AFilename);
{$ENDIF}
NewCode:=TCodeBuffer(Scanner.OnLoadSource(
Self,ExpandFilename(TrimFilename(AFilename)),true));
Result:=NewCode<>nil;
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;

3
components/codetools/stdcodetools.pas
View File

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