paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2026-01-04 06:20:29 +01:00
Code Issues Packages Projects Releases Wiki Activity

codetools: ppu: added heuristic to create FPC groups

Browse Source 
git-svn-id: trunk@15665 -
This commit is contained in:
mattias 2008-07-03 14:57:57 +00:00
parent 5d088a19ed
commit 7e45858274
5 changed files with 108 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
components/codetools/codetoolmanager.pas
View File

@ -286,7 +286,7 @@ type
function GetUnitLinksForDirectory(const Directory: string;
UseCache: boolean = false): string;
function GetFPCUnitPathForDirectory(const Directory: string;
UseCache: boolean = false): string;
UseCache: boolean = false): string;// unit paths reported by FPC
procedure GetFPCVersionForDirectory(const Directory: string;
out FPCVersion, FPCRelease, FPCPatch: integer);

2
components/codetools/directorycacher.pas
View File

@ -48,7 +48,7 @@ type
ctdcsIncludePath,
ctdcsCompleteSrcPath, // including unit path, src path and compiled src paths
ctdcsUnitLinks,
ctdcsFPCUnitPath
ctdcsFPCUnitPath // unit paths reported by FPC
);
TCTDirCacheStringRecord = record

22
components/codetools/examples/ppudependencies.lpr
View File

@ -28,8 +28,10 @@ program PPUDependencies;
{$mode objfpc}{$H+}
uses
Classes, SysUtils, PPUParser, FileProcs, PPUGraph;
Classes, SysUtils, PPUParser, FileProcs, PPUGraph, CodeToolManager;
const
ConfigFilename = 'codetools.config';
var
Filename: String;
Groups: TPPUGroups;
@ -40,19 +42,27 @@ var
begin
if (Paramcount<1) then begin
writeln('Usage:');
writeln(' ',ParamStr(0),' <ppu filename1> ...');
writeln(' ',ParamStr(0),' [fpc] <ppu filename1> ...');
writeln(' The "fpc" parameter auto generates groups for all fpc units.');
Halt;
end;
CodeToolBoss.SimpleInit(ConfigFilename);
Groups:=TPPUGroups.Create;
MissingUnit:=TStringList.Create;
try
Group:=Groups.AddGroup('Default');
for i:=1 to Paramcount do begin
Filename:=CleanAndExpandFilename(ParamStr(i));
debugln(Filename);
Member:=Group.AddMember(ExtractFileNameOnly(Filename));
Member.PPUFilename:=Filename;
Filename:=ParamStr(i);
if Filename='fpc' then
Groups.AddFPCGroupsForCurrentCompiler(CleanAndExpandDirectory(GetCurrentDir))
else begin
Filename:=CleanAndExpandFilename(Filename);
debugln(Filename);
Member:=Group.AddMember(ExtractFileNameOnly(Filename));
Member.PPUFilename:=Filename;
end;
end;
Groups.UpdateDependencies;

2
components/codetools/fileprocs.pas
View File

@ -54,7 +54,7 @@ const
{$ifdef MSWindows}
{$define CaseInsensitiveFilenames}
{$endif}
type
TCTSearchFileCase = (
ctsfcDefault, // e.g. case insensitive on windows

90
components/codetools/ppugraph.pas
View File

@ -31,7 +31,10 @@ interface
uses
Classes, SysUtils, PPUParser, CodeTree, AVL_Tree, FileProcs, BasicCodeTools,
CodeGraph;
CodeGraph, CodeToolManager;
const
FPCPPUGroupPrefix = 'fpc_';
type
TPPUGroup = class;
@ -102,6 +105,10 @@ type
destructor Destroy; override;
procedure Clear;
function AddGroup(const NewName: string): TPPUGroup;
procedure AddFPCGroupsForCurrentCompiler(const BaseDirectory: string);
procedure AddFPCGroups(const FPCPPUBaseDir: string // for example: /usr/lib/fpc/2.2.3/units/i386-linux/
);
procedure AddFPCGroup(const Groupname, Directory: string);
function FindGroupWithName(const AName: string): TPPUGroup;
function FindMemberWithUnitName(const AName: string): TPPUMember;
function UpdateDependencies: boolean;
@ -480,6 +487,87 @@ begin
Result.Groups:=Self;
end;
procedure TPPUGroups.AddFPCGroupsForCurrentCompiler(const BaseDirectory: string);
var
FPCSearchPath: String;
SystemPPUFilename: String;
RTLPPUDirectory: String; // directory containing the system.ppu
FPCPPUBaseDir: String; // directory containing all FPC ppu directories
begin
FPCSearchPath:=CodeToolBoss.GetFPCUnitPathForDirectory(BaseDirectory);
// search system.ppu
SystemPPUFilename:=SearchFileInPath('system.ppu',BaseDirectory,FPCSearchPath,
';',ctsfcDefault);
if SystemPPUFilename='' then
raise Exception.Create('TPPUGroups.AddFPCGroupsForCurrentCompiler: system.ppu is not in the FPC search paths');
RTLPPUDirectory:=ExtractFilePath(SystemPPUFilename);
FPCPPUBaseDir:=ExtractFilePath(ChompPathDelim(RTLPPUDirectory));
AddFPCGroups(FPCPPUBaseDir);
end;
procedure TPPUGroups.AddFPCGroups(const FPCPPUBaseDir: string);
var
FileInfo: TSearchRec;
GroupName: String;
i: Integer;
begin
DebugLn(['TPPUGroups.AddFPCGroups ',FPCPPUBaseDir]);
if SysUtils.FindFirst(AppendPathDelim(FPCPPUBaseDir)+FileMask,faAnyFile,FileInfo)=0
then begin
repeat
// check if special file
if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='') then
continue;
if (faDirectory and FileInfo.Attr)<>0 then begin
GroupName:=FileInfo.Name;
for i:=length(GroupName) downto 1 do
if not (Groupname[i] in ['a'..'z','A'..'Z','0'..'9','_']) then
System.Delete(GroupName,i,1);
if (Groupname='') then continue;
Groupname:=FPCPPUGroupPrefix+LowerCase(Groupname);
if (not IsValidIdent(Groupname)) then continue;
AddFPCGroup(GroupName,AppendPathDelim(FPCPPUBaseDir)+FileInfo.Name);
end;
until SysUtils.FindNext(FileInfo)<>0;
end;
SysUtils.FindClose(FileInfo);
end;
procedure TPPUGroups.AddFPCGroup(const Groupname, Directory: string);
var
FileInfo: TSearchRec;
Filename: String;
UnitName: String;
Group: TPPUGroup;
Member: TPPUMember;
begin
//DebugLn(['TPPUGroups.AddFPCGroup ',Groupname,' ',Directory]);
Group:=nil;
if SysUtils.FindFirst(AppendPathDelim(Directory)+FileMask,faAnyFile,FileInfo)=0
then begin
repeat
// check if special file
if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='') then
continue;
Filename:=FileInfo.Name;
if (CompareFileExt(Filename,'ppu',false)<>0) then continue;
UnitName:=ExtractFileNameOnly(Filename);
Filename:=AppendPathDelim(Directory)+Filename;
if (UnitName='') or (not IsValidIdent(UnitName)) then begin
DebugLn(['TPPUGroups.AddFPCGroup NOTE: invalid ppu name: ',Filename]);
continue;
end;
if Group=nil then begin
DebugLn(['TPPUGroups.AddFPCGroup Creating group ',Groupname]);
Group:=AddGroup(Groupname);
end;
Member:=Group.AddMember(UnitName);
Member.PPUFilename:=Filename;
until SysUtils.FindNext(FileInfo)<>0;
end;
SysUtils.FindClose(FileInfo);
end;
function TPPUGroups.FindGroupWithName(const AName: string): TPPUGroup;
var
AVLNode: TAVLTreeNode;