paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-22 15:19:35 +02:00
Code Issues Packages Projects Releases Wiki Activity

codetools: started collecting FPC units from set

Browse Source 
git-svn-id: trunk@26738 -
This commit is contained in:
mattias 2010-07-19 15:59:57 +00:00
parent 0d135358b4
commit 9a69db4955
6 changed files with 109 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
components/codetools/codetoolmanager.pas
View File

@ -158,6 +158,8 @@ type
function DirectoryCachePoolFindVirtualFile(const Filename: string): string;
function DirectoryCachePoolGetUnitFromSet(const UnitSet, AnUnitName: string
): string;
procedure DirectoryCachePoolIterateFPCUnitsFromSet(const UnitSet: string;
const Iterate: TCTOnIterateFile);
public
DefinePool: TDefinePool; // definition templates (rules)
DefineTree: TDefineTree; // cache for defines (e.g. initial compiler values)
@ -835,6 +837,7 @@ begin
DirectoryCachePool.OnGetString:=@DirectoryCachePoolGetString;
DirectoryCachePool.OnFindVirtualFile:=@DirectoryCachePoolFindVirtualFile;
DirectoryCachePool.OnGetUnitFromSet:=@DirectoryCachePoolGetUnitFromSet;
DirectoryCachePool.OnIterateFPCUnitsFromSet:=@DirectoryCachePoolIterateFPCUnitsFromSet;
DefineTree.DirectoryCachePool:=DirectoryCachePool;
FPCDefinesCache:=TFPCDefinesCache.Create(nil);
FAddInheritedCodeToOverrideMethod:=true;
@ -943,7 +946,7 @@ begin
if FPCDefinesCache.TestFilename='' then
FPCDefinesCache.TestFilename:=GetTempFilename('fpctest.pas','');
UnitSetCache:=FPCDefinesCache.FindUnitToSrcCache(Config.FPCPath,
UnitSetCache:=FPCDefinesCache.FindUnitSet(Config.FPCPath,
Config.TargetOS,Config.TargetProcessor,Config.FPCOptions,Config.FPCSrcDir,
true);
// parse compiler settings, fpc sources
@ -5308,7 +5311,7 @@ var
Changed: boolean;
UnitSetCache: TFPCUnitSetCache;
begin
UnitSetCache:=FPCDefinesCache.FindUnitToSrcCache(UnitSet,Changed,false);
UnitSetCache:=FPCDefinesCache.FindUnitSetWithID(UnitSet,Changed,false);
if UnitSetCache=nil then begin
debugln(['TCodeToolManager.DirectoryCachePoolGetUnitFromSet invalid UnitSet="',dbgstr(UnitSet),'"']);
Result:='';
@ -5322,6 +5325,34 @@ begin
Result:=UnitSetCache.GetUnitSrcFile(AnUnitName);
end;
procedure TCodeToolManager.DirectoryCachePoolIterateFPCUnitsFromSet(
const UnitSet: string; const Iterate: TCTOnIterateFile);
var
Changed: boolean;
UnitSetCache: TFPCUnitSetCache;
aConfigCache: TFPCTargetConfigCache;
Node: TAVLTreeNode;
Item: PStringToStringTreeItem;
begin
UnitSetCache:=FPCDefinesCache.FindUnitSetWithID(UnitSet,Changed,false);
if UnitSetCache=nil then begin
debugln(['TCodeToolManager.DirectoryCachePoolIterateFPCUnitsFromSet invalid UnitSet="',dbgstr(UnitSet),'"']);
exit;
end;
if Changed then begin
debugln(['TCodeToolManager.DirectoryCachePoolIterateFPCUnitsFromSet outdated UnitSet="',dbgstr(UnitSet),'"']);
exit;
end;
aConfigCache:=UnitSetCache.GetConfigCache(false);
if (aConfigCache=nil) or (aConfigCache.Units=nil) then exit;
Node:=aConfigCache.Units.Tree.FindLowest;
while Node<>nil do begin
Item:=PStringToStringTreeItem(Node.Data);
Iterate(Item^.Value);
Node:=aConfigCache.Units.Tree.FindSuccessor(Node);
end;
end;
procedure TCodeToolManager.OnToolSetWriteLock(Lock: boolean);
begin
if Lock then ActivateWriteLock else DeactivateWriteLock;

12
components/codetools/definetemplates.pas
View File

@ -859,10 +859,10 @@ type
property SourceCaches: TFPCSourceCaches read FSourceCaches write SetSourceCaches;
property ConfigCaches: TFPCTargetConfigCaches read FConfigCaches write SetConfigCaches;
property TestFilename: string read FTestFilename write FTestFilename; // an empty file to test the compiler, will be auto created
function FindUnitToSrcCache(const CompilerFilename, TargetOS, TargetCPU,
function FindUnitSet(const CompilerFilename, TargetOS, TargetCPU,
Options, FPCSrcDir: string;
CreateIfNotExists: boolean): TFPCUnitSetCache;
function FindUnitToSrcCache(const UnitSetID: string; out Changed: boolean;
function FindUnitSetWithID(const UnitSetID: string; out Changed: boolean;
CreateIfNotExists: boolean): TFPCUnitSetCache;
function GetUnitSetID(CompilerFilename, TargetOS, TargetCPU, Options,
FPCSrcDir: string; ChangeStamp: integer): string;
@ -8139,7 +8139,7 @@ begin
Result:=false;
end;
function TFPCDefinesCache.FindUnitToSrcCache(const CompilerFilename, TargetOS,
function TFPCDefinesCache.FindUnitSet(const CompilerFilename, TargetOS,
TargetCPU, Options, FPCSrcDir: string; CreateIfNotExists: boolean
): TFPCUnitSetCache;
var
@ -8167,7 +8167,7 @@ begin
Result:=nil;
end;
function TFPCDefinesCache.FindUnitToSrcCache(const UnitSetID: string; out
function TFPCDefinesCache.FindUnitSetWithID(const UnitSetID: string; out
Changed: boolean; CreateIfNotExists: boolean): TFPCUnitSetCache;
var
CompilerFilename, TargetOS, TargetCPU, Options, FPCSrcDir: string;
@ -8176,13 +8176,13 @@ begin
ParseUnitSetID(UnitSetID,CompilerFilename, TargetOS, TargetCPU,
Options, FPCSrcDir, ChangeStamp);
//debugln(['TFPCDefinesCache.FindUnitToSrcCache UnitSetID="',dbgstr(UnitSetID),'" CompilerFilename="',CompilerFilename,'" TargetOS="',TargetOS,'" TargetCPU="',TargetCPU,'" Options="',Options,'" FPCSrcDir="',FPCSrcDir,'" ChangeStamp=',ChangeStamp,' exists=',FindUnitToSrcCache(CompilerFilename, TargetOS, TargetCPU,Options, FPCSrcDir,false)<>nil]);
Result:=FindUnitToSrcCache(CompilerFilename, TargetOS, TargetCPU,
Result:=FindUnitSet(CompilerFilename, TargetOS, TargetCPU,
Options, FPCSrcDir, false);
if Result<>nil then begin
Changed:=ChangeStamp<>Result.ChangeStamp;
end else if CreateIfNotExists then begin
Changed:=true;
Result:=FindUnitToSrcCache(CompilerFilename, TargetOS, TargetCPU,
Result:=FindUnitSet(CompilerFilename, TargetOS, TargetCPU,
Options, FPCSrcDir, true);
end else
Changed:=false;

35
components/codetools/directorycacher.pas
View File

@ -113,6 +113,7 @@ type
function CalcMemSize: PtrUInt;
end;
TCTOnIterateFile = procedure(const Filename: string) of object;
TCTDirectoryCachePool = class;
@ -155,6 +156,7 @@ type
AnyCase: boolean): string;
function FindCompiledUnitInCompletePath(var ShortFilename: string;
AnyCase: boolean): string;
procedure IterateFPCUnitsInSet(const Iterate: TCTOnIterateFile);
procedure WriteListing;
public
property Directory: string read FDirectory;
@ -170,6 +172,8 @@ type
): string of object;
TCTDirCacheFindVirtualFile = function(const Filename: string): string of object;
TCTGetUnitFromSet = function(const UnitSet, AnUnitName: string): string of object;
TCTIterateFPCUnitsFromSet = procedure(const UnitSet: string;
const Iterate: TCTOnIterateFile) of object;
TCTDirectoryCachePool = class
private
@ -179,6 +183,7 @@ type
FOnFindVirtualFile: TCTDirCacheFindVirtualFile;
FOnGetString: TCTDirCacheGetString;
FOnGetUnitFromSet: TCTGetUnitFromSet;
FOnIterateFPCUnitsFromSet: TCTIterateFPCUnitsFromSet;
procedure DoRemove(ACache: TCTDirectoryCache);
procedure OnFileStateCacheChangeTimeStamp(Sender: TObject);
public
@ -194,6 +199,8 @@ type
procedure IncreaseConfigTimeStamp;
function FindUnitInUnitLinks(const Directory, AUnitName: string): string;
function FindUnitInUnitSet(const Directory, AUnitName: string): string;
procedure IterateFPCUnitsInSet(const Directory: string;
const Iterate: TCTOnIterateFile);
function FindDiskFilename(const Filename: string): string;
function FindUnitInDirectory(const Directory, AUnitName: string;
AnyCase: boolean = false): string;
@ -212,6 +219,8 @@ type
write FOnFindVirtualFile;
property OnGetUnitFromSet: TCTGetUnitFromSet read FOnGetUnitFromSet
write FOnGetUnitFromSet;
property OnIterateFPCUnitsFromSet: TCTIterateFPCUnitsFromSet
read FOnIterateFPCUnitsFromSet write FOnIterateFPCUnitsFromSet;
end;
function CompareCTDirectoryCaches(Data1, Data2: Pointer): integer;
@ -1089,6 +1098,15 @@ begin
end;
end;
procedure TCTDirectoryCache.IterateFPCUnitsInSet(const Iterate: TCTOnIterateFile
);
var
UnitSet: string;
begin
UnitSet:=Strings[ctdcsUnitSet];
Pool.OnIterateFPCUnitsFromSet(UnitSet,Iterate);
end;
procedure TCTDirectoryCache.WriteListing;
var
i: Integer;
@ -1241,6 +1259,23 @@ begin
Result:=Cache.FindUnitInUnitSet(AUnitName);
end;
procedure TCTDirectoryCachePool.IterateFPCUnitsInSet(const Directory: string;
const Iterate: TCTOnIterateFile);
procedure RaiseDirNotAbsolute;
begin
raise Exception.Create('TCTDirectoryCachePool.IterateFPCUnitsInSet not absolute Directory="'+Directory+'"');
end;
var
Cache: TCTDirectoryCache;
begin
if (Directory<>'') and not FilenameIsAbsolute(Directory) then
RaiseDirNotAbsolute;
Cache:=GetCache(Directory,true,false);
Cache.IterateFPCUnitsInSet(Iterate);
end;
function TCTDirectoryCachePool.FindDiskFilename(const Filename: string
): string;
var

11
components/codetools/examples/identifiercompletion.lpi
View File

@ -1,7 +1,7 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="7"/>
<Version Value="8"/>
<General>
<Flags>
<LRSInOutputDirectory Value="False"/>
@ -11,7 +11,7 @@
<TargetFileExt Value=""/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
<StringTable Comments="" CompanyName="" FileDescription="" FileVersion="0.0.0.0" InternalName="" LegalCopyright="" LegalTrademarks="" OriginalFilename="" ProductName="" ProductVersion=""/>
</VersionInfo>
<PublishOptions>
<Version Value="2"/>
@ -44,7 +44,12 @@
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="8"/>
<Version Value="9"/>
<Parsing>
<SyntaxOptions>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>

45
components/codetools/examples/identifiercompletion.lpr
View File

@ -34,12 +34,12 @@ uses
const
ConfigFilename = 'codetools.config';
var
Options: TCodeToolsOptions;
Filename: string;
Code: TCodeBuffer;
X: Integer;
Y: Integer;
//Tool: TCodeTool;
Cnt: longint;
i: Integer;
begin
if (ParamCount>=1) and (Paramcount<3) then begin
writeln('Usage:');
@ -47,48 +47,21 @@ begin
writeln(' ',ParamStr(0),' <filename> <X> <Y>');
end;
// setup the Options
Options:=TCodeToolsOptions.Create;
// To not parse the FPC sources every time, the options are saved to a file.
writeln('Config=',ConfigFilename);
if FileExists(ConfigFilename) then begin
Options.LoadFromFile(ConfigFilename);
end else begin
Options.InitWithEnvironmentVariables;
if Options.FPCPath='' then
Options.FPCPath:='/usr/bin/ppc386';
if Options.FPCSrcDir='' then
Options.FPCSrcDir:=ExpandFileName('~/freepascal/fpc');
if Options.LazarusSrcDir='' then
Options.LazarusSrcDir:=ExpandFileName('~/pascal/lazarus');
end;
CodeToolBoss.SimpleInit(ConfigFilename);
// optional: ProjectDir and TestPascalFile exists only to easily test some
// things.
Options.ProjectDir:=GetCurrentDir+'/scanexamples/';
Options.TestPascalFile:=Options.ProjectDir+'identcomplexample.pas';
Filename:=TrimFilename(SetDirSeparators(GetCurrentDir+'/scanexamples/identcomplexample.pas'));
X:=20;
Y:=10;
Y:=11;
// init the codetools
if not Options.UnitLinkListValid then
writeln('Scanning FPC sources may take a while ...');
CodeToolBoss.Init(Options);
// save the options and the FPC unit links results.
Options.SaveToFile(ConfigFilename);
writeln('FPCSrcDir=',Options.FPCSrcDir);
writeln('FPC=',Options.FPCPath);
if (ParamCount>=3) then begin
Options.TestPascalFile:=ExpandFileName(ParamStr(1));
Filename:=ExpandFileName(ParamStr(1));
X:=StrToInt(ParamStr(2));
Y:=StrToInt(ParamStr(3));
end;
// load the file
Filename:=Options.TestPascalFile;
Code:=CodeToolBoss.LoadFile(Filename,false,false);
if Code=nil then
raise Exception.Create('loading failed '+Filename);
@ -100,7 +73,11 @@ begin
writeln('GatherIdentifiers ',Code.Filename,'(X=',X,',Y=',Y,')');
if CodeToolBoss.GatherIdentifiers(Code,X,Y) then
begin
writeln('Identifiers found: Count=',CodeToolBoss.IdentifierList.Count);
writeln('Identifiers found: Count=',CodeToolBoss.IdentifierList.Count,' FilteredCount=',CodeToolBoss.IdentifierList.GetFilteredCount);
Cnt:=CodeToolBoss.IdentifierList.GetFilteredCount;
if Cnt>10 then Cnt:=10;
for i:=0 to Cnt-1 do
writeln(i,'/',CodeToolBoss.IdentifierList.GetFilteredCount,': ',CodeToolBoss.IdentifierList.FilteredItems[i].AsString);
end else begin
raise Exception.Create('GatherIdentifiers failed');
end;

16
components/codetools/identcompletiontool.pas
View File

@ -1397,6 +1397,13 @@ procedure TIdentCompletionTool.GatherUnitnames(CleanPos: integer;
var
TreeOfUnitFiles: TAVLTree;
{$IFDEF EnableFPCCache}
procedure GatherUnitsFromSet;
begin
// collect all unit files in fpc unit paths
//DirectoryCache.IterateFPCUnitsInSet();
end;
{$ELSE}
procedure GatherUnitsFromUnitLinks;
var
UnitLinks: string;
@ -1426,6 +1433,7 @@ var
inc(UnitLinkStart);
end;
end;
{$ENDIF}
var
UnitPath, SrcPath: string;
@ -1446,12 +1454,20 @@ begin
try
// search in unitpath
UnitExt:='pp;pas;ppu';
if Scanner.CompilerMode=cmMacPas then
UnitExt:=UnitExt+';p';
GatherUnitFiles(BaseDir,UnitPath,UnitExt,false,true,TreeOfUnitFiles);
// search in srcpath
SrcExt:='pp;pas';
if Scanner.CompilerMode=cmMacPas then
SrcExt:=SrcExt+';p';
GatherUnitFiles(BaseDir,SrcPath,SrcExt,false,true,TreeOfUnitFiles);
// add unitlinks
{$IFDEF EnableFPCCache}
GatherUnitsFromSet;
{$ELSE}
GatherUnitsFromUnitLinks;
{$ENDIF}
// create list
CurSourceName:=GetSourceName;
ANode:=TreeOfUnitFiles.FindLowest;