paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-03 10:09:52 +01:00
Code Issues Packages Projects Releases Wiki Activity

* Added ability to create fpmake-plugins.

Browse Source 
git-svn-id: trunk@35195 -
This commit is contained in:
joost 2016-12-26 14:55:50 +00:00
parent 7d2360eb0c
commit 1660634e7a
7 changed files with 268 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

303
packages/fpmkunit/src/fpmkunit.pp
View File

@ -592,6 +592,7 @@ Type
FBeforeClean: TNotifyEvent;
FBeforeCompile: TNotifyEvent;
FCPUs: TCPUs;
FIsFPMakePlugin: Boolean;
FOSes: TOSes;
FMode: TCompilerMode;
FResourceStrings: Boolean;
@ -656,6 +657,7 @@ Type
Property UnitPath : TConditionalStrings Read FUnitPath;
Property IncludePath : TConditionalStrings Read FIncludePath;
Property XML: string Read FXML Write SetXML;
Property IsFPMakePlugin : Boolean read FIsFPMakePlugin write FIsFPMakePlugin;
// Events.
Property BeforeCompile : TNotifyEvent Read FBeforeCompile Write FBeforeCompile;
Property AfterCompile : TNotifyEvent Read FAfterCompile Write FAfterCompile;
@ -885,7 +887,7 @@ Type
Property CleanFiles : TConditionalStrings Read FCleanFiles;
Property Dependencies : TDependencies Read FDependencies;
Property Commands : TCommands Read FCommands;
Property State : TTargetState Read FTargetState;
Property State : TTargetState Read FTargetState Write FTargetState;
Property Targets : TTargets Read FTargets;
Property Sources : TSources Read FSources;
Property UnitDir : String Read FUnitDir Write FUnitDir;
@ -1332,6 +1334,46 @@ Type
{$endif NO_THREADING}
{ TfpmPlugin }
TfpmPlugin = class
protected
function GetName: string; virtual;
public
property Name: string read GetName;
procedure BeforeResolvePackagePath(ABuildEngine: TBuildEngine; APackage: TPackage; out AContinue: Boolean); virtual;
procedure ResolvePackagePath(ABuildEngine: TBuildEngine; APackage: TPackage; SearchDirectory: string; out AContinue: Boolean); virtual;
procedure AfterResolvePackagePath(ABuildEngine: TBuildEngine; APackage: TPackage; out AContinue: Boolean); virtual;
end;
TfpmPluginClass = class of TfpmPlugin;
{ TfpmPluginManager }
TfpmPluginManager = class(TfpmPlugin)
private
FPlugins: array of TfpmPlugin;
public
destructor Destroy; override;
procedure RegisterPlugin(APlugin: TfpmPluginClass);
procedure BeforeResolvePackagePath(ABuildEngine: TBuildEngine; APackage: TPackage; out AContinue: Boolean); override;
procedure ResolvePackagePath(ABuildEngine: TBuildEngine; APackage: TPackage; SearchPath: string; out AContinue: Boolean); override;
procedure AfterResolvePackagePath(ABuildEngine: TBuildEngine; APackage: TPackage; out AContinue: Boolean); override;
end;
{ TfpmResolvePackagePathsPlugin }
TfpmResolvePackagePathsPlugin = class(TfpmPlugin)
private
procedure ResolveUnitConfigFilenameForBasePath(ABuildEngine: TBuildEngine; APackage: TPackage; ABasePath: string;
out AContinue: Boolean);
public
procedure BeforeResolvePackagePath(ABuildEngine: TBuildEngine; APackage: TPackage; out AContinue: Boolean); override;
procedure ResolvePackagePath(ABuildEngine: TBuildEngine; APackage: TPackage; SearchPath: string;
out AContinue: Boolean); override;
end;
ECollectionError = Class(Exception);
EDictionaryError = Class(Exception);
EInstallerError = Class(Exception);
@ -1386,6 +1428,8 @@ Function GetImportLibraryFilename(const UnitName: string; AOS : TOS) : string;
procedure SearchFiles(AFileName, ASearchPathPrefix: string; Recursive: boolean; var List: TStrings);
function GetDefaultLibGCCDir(CPU : TCPU;OS: TOS; var ErrorMessage: string): string;
function GetPluginManager: TfpmPluginManager;
Implementation
uses typinfo, rtlconsts;
@ -1401,6 +1445,10 @@ const
ArchiveExtension = '.zip';
{$endif CREATE_TAR_FILE}
var
GPluginManager: TfpmPluginManager;
{----------------- from strutils ---------------------}
function FindPart(const HelpWilds, inputStr: string): Integer;
@ -1730,6 +1778,7 @@ Const
KeyTarget = 'Target';
KeyNoFPCCfg = 'NoFPCCfg';
KeyUseEnv = 'UseEnv';
KeyPluginUnits = 'PluginUnits';
KeyLocalUnitDir = 'LocalUnitDir';
KeyGlobalUnitDir = 'GlobalUnitDir';
KeyBaseInstallDir = 'BaseInstallDir';
@ -2696,6 +2745,162 @@ begin
end; {case}
end;
function GetPluginManager: TfpmPluginManager;
begin
if not assigned(GPluginManager) then
GPluginManager := TfpmPluginManager.Create;
Result := GPluginManager;
end;
{ TfpmResolvePackagePathsPlugin }
procedure TfpmResolvePackagePathsPlugin.ResolveUnitConfigFilenameForBasePath(
ABuildEngine: TBuildEngine; APackage: TPackage; ABasePath: string;
out AContinue: Boolean);
var
IsPackageSourceLocation: boolean;
ASubDir: string;
AnUnitConfigFilename: string;
PackageBaseDir: string;
begin
if APackage.State=tsNotFound then
// When the state is tsNotFound, the package is not part of this fpmake, and only the package-name is known.
// In this case search for the package-name.
// This is not right for packages where the package-name and directory name of the source-files are
// not the same. We don't have a better option, though.
ASubDir:=APackage.Name
else
ASubDir:=APackage.Directory;
IsPackageSourceLocation:=FileExists(IncludeTrailingPathDelimiter(IncludeTrailingPathDelimiter(ABasePath)+ASubDir)+FPMakePPFile);
if IsPackageSourceLocation then
begin
PackageBaseDir:=IncludeTrailingPathDelimiter(IncludeTrailingPathDelimiter(ABasePath)+ASubDir);
AnUnitConfigFileName:=PackageBaseDir+APackage.GetUnitConfigOutputFilename(Defaults.CPU,Defaults.OS);
PackageBaseDir:=IncludeTrailingPathDelimiter(PackageBaseDir+APackage.GetUnitsOutputDir(defaults.CPU, Defaults.OS));
end
else
begin
PackageBaseDir:=IncludeTrailingPathDelimiter(ABasePath);
AnUnitConfigFileName:=IncludeTrailingPathDelimiter(ABuildEngine.GetUnitConfigFilesInstallDir(ABasePath))+APackage.Name+FpmkExt;
PackageBaseDir:=IncludeTrailingPathDelimiter(IncludeTrailingPathDelimiter(ABasePath)+APackage.GetUnitsOutputDir(Defaults.CPU, Defaults.OS))+APackage.Name;
end;
if (PackageBaseDir<>'') and ABuildEngine.SysDirectoryExists(PackageBaseDir) then
begin
AContinue := False;
APackage.UnitDir:=PackageBaseDir;
if IsPackageSourceLocation then
// Set the state to tsNoCompile and not tsCompiled. Because packages
// in the tsCompiled state trigger a rebuild of packages that depend
// on it.
APackage.FTargetState:=tsNoCompile
else if not (APackage.FTargetState in [tsCompiled, tsNoCompile]) then
APackage.FTargetState:=tsInstalled; // als installed, afdwingen dat unitconfigfile bestaat! werkt niet - zie rtl
AnUnitConfigFilename:=APackage.Dictionary.ReplaceStrings(AnUnitConfigFilename);
if FileExists(AnUnitConfigFilename) then
APackage.UnitConfigFileName:=AnUnitConfigFilename;
end
else
AContinue := True;
end;
procedure TfpmResolvePackagePathsPlugin.BeforeResolvePackagePath(ABuildEngine: TBuildEngine;
APackage: TPackage; out AContinue: Boolean);
begin
if (APackage.State in [tsCompiled, tsNoCompile, tsInstalled]) then
ResolveUnitConfigFilenameForBasePath(ABuildEngine, APackage, ABuildEngine.StartDir, AContinue)
else
AContinue := True;
end;
procedure TfpmResolvePackagePathsPlugin.ResolvePackagePath(ABuildEngine: TBuildEngine;
APackage: TPackage; SearchPath: string; out AContinue: Boolean);
begin
ResolveUnitConfigFilenameForBasePath(ABuildEngine, APackage, SearchPath, AContinue)
end;
{ TfpmPlugin }
function TfpmPlugin.GetName: string;
begin
Result := ClassName;
end;
procedure TfpmPlugin.BeforeResolvePackagePath(ABuildEngine: TBuildEngine; APackage: TPackage;
out AContinue: Boolean);
begin
AContinue := True;
end;
procedure TfpmPlugin.ResolvePackagePath(ABuildEngine: TBuildEngine; APackage: TPackage;
SearchDirectory: string; out AContinue: Boolean);
begin
AContinue := True;
end;
procedure TfpmPlugin.AfterResolvePackagePath(ABuildEngine: TBuildEngine; APackage: TPackage;
out AContinue: Boolean);
begin
AContinue := True;
end;
{ TfpmPluginManager }
destructor TfpmPluginManager.Destroy;
var
i: Integer;
begin
for i := 0 to High(FPlugins) do
FPlugins[i].Free;
inherited Destroy;
end;
procedure TfpmPluginManager.RegisterPlugin(APlugin: TfpmPluginClass);
begin
SetLength(FPlugins, Length(FPlugins)+1);
FPlugins[high(FPlugins)] := APlugin.Create;
end;
procedure TfpmPluginManager.BeforeResolvePackagePath(ABuildEngine: TBuildEngine; APackage: TPackage;
out AContinue: Boolean);
var
i: Integer;
begin
for i := 0 to high(FPlugins) do
begin
FPlugins[i].BeforeResolvePackagePath(ABuildEngine, APackage, AContinue);
if not AContinue then
Exit;
end;
end;
procedure TfpmPluginManager.ResolvePackagePath(ABuildEngine: TBuildEngine; APackage: TPackage;
SearchPath: string; out AContinue: Boolean);
var
i: Integer;
begin
for i := 0 to high(FPlugins) do
begin
FPlugins[i].ResolvePackagePath(ABuildEngine, APackage, SearchPath, AContinue);
if not AContinue then
Exit;
end;
end;
procedure TfpmPluginManager.AfterResolvePackagePath(ABuildEngine: TBuildEngine; APackage: TPackage;
out AContinue: Boolean);
var
i: Integer;
begin
for i := 0 to high(FPlugins) do
begin
FPlugins[i].AfterResolvePackagePath(ABuildEngine, APackage, AContinue);
if not AContinue then
Exit;
end;
end;
constructor TPackageVariant.Create(ACollection: TCollection);
begin
inherited Create(ACollection);
@ -3826,6 +4031,7 @@ Var
p : TPackage;
PackageVariants : TPackageVariants;
PackageVariantsStr: string;
s: string;
begin
with AStringList do
begin
@ -3864,6 +4070,20 @@ begin
Values[KeyAddIn]:='Y'
else
Values[KeyAddIn]:='N';
s := '';
for i := 0 to FTargets.Count-1 do
begin
if FTargets.TargetItems[i].IsFPMakePlugin then
begin
if s <> '' then
s := s + ',';
s := s + FTargets.TargetItems[i].Name;
end;
end;
if s<>'' then
Values[KeyPluginUnits]:=s;
for i := 0 to FPackageVariants.Count-1 do
begin
PackageVariants := TPackageVariants(FPackageVariants.Items[i]);
@ -6025,75 +6245,29 @@ end;
procedure TBuildEngine.ResolvePackagePaths(APackage:TPackage);
procedure ResolveUnitConfigFilenameForBasePath(ABasePath: string);
var
IsPackageSourceLocation: boolean;
ASubDir: string;
AnUnitConfigFilename: string;
PackageBaseDir: string;
begin
if APackage.State=tsNotFound then
// When the state is tsNotFound, the package is not part of this fpmake, and only the package-name is known.
// In this case search for the package-name.
// This is not right for packages where the package-name and directory name of the source-files are
// not the same. We don't have a better option, though.
ASubDir:=APackage.Name
else
ASubDir:=APackage.Directory;
IsPackageSourceLocation:=FileExists(IncludeTrailingPathDelimiter(IncludeTrailingPathDelimiter(ABasePath)+ASubDir)+FPMakePPFile);
if IsPackageSourceLocation then
begin
PackageBaseDir:=IncludeTrailingPathDelimiter(IncludeTrailingPathDelimiter(ABasePath)+ASubDir);
AnUnitConfigFileName:=PackageBaseDir+APackage.GetUnitConfigOutputFilename(Defaults.CPU,Defaults.OS);
PackageBaseDir:=IncludeTrailingPathDelimiter(PackageBaseDir+APackage.GetUnitsOutputDir(defaults.CPU, Defaults.OS));
end
else
begin
PackageBaseDir:=IncludeTrailingPathDelimiter(ABasePath);
AnUnitConfigFileName:=IncludeTrailingPathDelimiter(GetUnitConfigFilesInstallDir(ABasePath))+APackage.Name+FpmkExt;
PackageBaseDir:=IncludeTrailingPathDelimiter(IncludeTrailingPathDelimiter(ABasePath)+APackage.GetUnitsOutputDir(Defaults.CPU, Defaults.OS))+APackage.Name;
end;
if (PackageBaseDir<>'') and SysDirectoryExists(PackageBaseDir) then
begin
APackage.UnitDir:=PackageBaseDir;
if IsPackageSourceLocation then
// Set the state to tsNoCompile and not tsCompiled. Because packages
// in the tsCompiled state trigger a rebuild of packages that depend
// on it.
APackage.FTargetState:=tsNoCompile
else if not (APackage.FTargetState in [tsCompiled, tsNoCompile]) then
APackage.FTargetState:=tsInstalled;
AnUnitConfigFilename:=APackage.Dictionary.ReplaceStrings(AnUnitConfigFilename);
if FileExists(AnUnitConfigFilename) then
APackage.UnitConfigFileName:=AnUnitConfigFilename;
end;
end;
var
i: Integer;
Continue: Boolean;
begin
if APackage.UnitDir='' then
begin
// Retrieve Full directory name where to find the units.
// The search order is:
// - Package in this fpmake.pp
// - SearchPath, first paths first.
if (APackage.State in [tsCompiled, tsNoCompile, tsInstalled]) then
ResolveUnitConfigFilenameForBasePath(FStartDir);
if (APackage.UnitDir='') then
GetPluginManager.BeforeResolvePackagePath(Self, APackage, Continue);
if Continue then
begin
for I := 0 to Defaults.SearchPath.Count-1 do
begin
if Defaults.SearchPath[i]<>'' then
ResolveUnitConfigFilenameForBasePath(Defaults.SearchPath[i]);
if (APackage.UnitDir<>'') then
Break
end;
for I := 0 to Defaults.SearchPath.Count-1 do
begin
if Defaults.SearchPath[i]<>'' then
GetPluginManager.ResolvePackagePath(Self, APackage, Defaults.SearchPath[i], Continue);
if not Continue then
Break
end;
if Continue then
GetPluginManager.AfterResolvePackagePath(Self, APackage, Continue);
end;
if (APackage.UnitDir='') then
APackage.UnitDir:=DirNotFound;
if APackage.UnitDir = '' then
APackage.UnitDir := DirNotFound
end;
end;
@ -8805,11 +8979,14 @@ Initialization
CustomFpmakeCommandlineOptions:=nil;
CustomFpMakeCommandlineValues:=nil;
GetPluginManager.RegisterPlugin(TfpmResolvePackagePathsPlugin);
Finalization
FreeAndNil(CustomFpMakeCommandlineValues);
FreeAndNil(CustomFpmakeCommandlineOptions);
FreeAndNil(DefInstaller);
FreeAndNil(GlobalDictionary);
FreeAndNil(Defaults);
FreeAndNil(GPluginManager);
end.

10
packages/fppkg/src/fprepos.pp
View File

@ -46,7 +46,7 @@ type
function GetBuildPathDirectory(APackage: TFPPackage): string; virtual;
function GetPrefix: string; virtual;
function GetBaseInstallDir: string; virtual;
function GetConfigFileForPackage(APackageName: string): string; virtual;
function GetConfigFileForPackage(APackage: TFPPackage): string; virtual;
function UnzipBeforeUse: Boolean; virtual;
function IsInstallationNeeded(APackage: TFPPackage): TFPInstallationNeeded; virtual;
property InstallRepositoryName: string read GetInstallRepositoryName write SetInstallRepositoryName;
@ -96,6 +96,7 @@ type
FDescription: String;
FEmail: String;
FFPMakeOptionsString: string;
FFPMakePluginUnits: string;
FKeywords: String;
FSourcePath: string;
FIsFPMakeAddIn: boolean;
@ -149,6 +150,7 @@ type
Property Email : String Read FEmail Write FEmail;
Property Checksum : Cardinal Read FChecksum Write FChecksum;
Property IsFPMakeAddIn : boolean read FIsFPMakeAddIn write FIsFPMakeAddIn;
Property FPMakePluginUnits: string read FFPMakePluginUnits write FFPMakePluginUnits;
// These properties are used to re-compile the package, when it's dependencies are changed.
Property SourcePath : string read FSourcePath write FSourcePath;
Property FPMakeOptionsString : string read FFPMakeOptionsString write FFPMakeOptionsString;
@ -303,6 +305,7 @@ const
KeyNeedLibC = 'NeedLibC';
KeyDepends = 'Depends';
KeyAddIn = 'FPMakeAddIn';
KeyPluginUnits = 'PluginUnits';
KeySourcePath = 'SourcePath';
KeyFPMakeOptions = 'FPMakeOptions';
KeyCPU = 'CPU';
@ -361,10 +364,10 @@ begin
raise Exception.Create('It is not possible to install into this repository.');
end;
function TFPCustomPackagesStructure.GetConfigFileForPackage(APackageName: string): string;
function TFPCustomPackagesStructure.GetConfigFileForPackage(APackage: TFPPackage): string;
begin
Result := IncludeTrailingPathDelimiter(GetBaseInstallDir)+
'fpmkinst'+PathDelim+GFPpkg.CompilerOptions.CompilerTarget+PathDelim+APackageName+FpmkExt;
'fpmkinst'+PathDelim+GFPpkg.CompilerOptions.CompilerTarget+PathDelim+APackage.Name+FpmkExt;
end;
function TFPCustomPackagesStructure.UnzipBeforeUse: Boolean;
@ -591,6 +594,7 @@ begin
FreeAndNil(L2);
//NeedLibC:=Upcase(Values[KeyNeedLibC])='Y';
IsFPMakeAddIn:=Upcase(Values[KeyAddIn])='Y';
FPMakePluginUnits:=Values[KeyPluginUnits];
end;
end;

8
packages/fppkg/src/pkgcommands.pp
View File

@ -389,19 +389,19 @@ var
P : TFPPackage;
InstallRepo: TFPRepository;
function GetFpmFilename: string;
function GetFpmFilename(APackage: TFPPackage): string;
var
ConfFile: string;
begin
Result := '';
if Assigned(InstallRepo.DefaultPackagesStructure) then
begin
ConfFile := InstallRepo.DefaultPackagesStructure.GetConfigFileForPackage(s);
ConfFile := InstallRepo.DefaultPackagesStructure.GetConfigFileForPackage(APackage);
if not FileExistsLog(ConfFile) then
begin
// If there is no fpm-file, search for an (obsolete, pre-2.7.x)
// fpunits.cfg-file
ConfFile := IncludeTrailingPathDelimiter(Result)+S+PathDelim+UnitConfigFileName;
ConfFile := IncludeTrailingPathDelimiter(Result)+APackage.Name+PathDelim+UnitConfigFileName;
if FileExistsLog(ConfFile) then
Result := ConfFile;
end
@ -449,7 +449,7 @@ begin
P := InstallRepo.AddPackage(S);
if Assigned(P) then
begin
UFN:=GetFpmFilename;
UFN:=GetFpmFilename(P);
if UFN<>'' then
begin
P.LoadUnitConfigFromFile(UFN);

2
packages/fppkg/src/pkgfpmake.pp
View File

@ -200,6 +200,8 @@ begin
Error(SErrMissingInstallPackage,[FPMKUnitDeps[i].package]);
if FPMKUnitDeps[i].def<>'' then
AddOption('-d'+FPMKUnitDeps[i].def);
if FPMKUnitDeps[i].PluginUnit<>'' then
AddOption('-Fa'+FPMKUnitDeps[i].PluginUnit);
end
else
begin

11
packages/fppkg/src/pkgglobals.pp
View File

@ -24,11 +24,12 @@ Const
Type
TFPMKUnitDep=record
package : string[12];
reqver : string[8];
undef : string[32];
def : string[32];
available: boolean;
package : string[12];
reqver : string[8];
undef : string[32];
def : string[32];
PluginUnit : string[64];
available : boolean;
end;
Const

1
packages/fppkg/src/pkgrepos.pp
View File

@ -199,6 +199,7 @@ begin
FPMKUnitDeps[high(FPMKUnitDeps)].package:=APackage.Name;
FPMKUnitDeps[high(FPMKUnitDeps)].reqver:=APackage.Version.AsString;
FPMKUnitDeps[high(FPMKUnitDeps)].def:='HAS_PACKAGE_'+APackage.Name;
FPMKUnitDeps[high(FPMKUnitDeps)].PluginUnit:=APackage.FPMakePluginUnits;
FPMKUnitDeps[high(FPMKUnitDeps)].available:=true;
end;

12
packages/fppkg/src/pkguninstalledsourcesrepository.pp
View File

@ -61,7 +61,7 @@ type
function AddPackagesToRepository(ARepository: TFPRepository): Boolean; override;
function IsInstallationNeeded(APackage: TFPPackage): TFPInstallationNeeded; override;
function GetBaseInstallDir: string; override;
function GetConfigFileForPackage(APackageName: string): string; override;
function GetConfigFileForPackage(APackage: TFPPackage): string; override;
property SourceRepositoryName: string read FSourceRepositoryName write FSourceRepositoryName;
end;
@ -140,10 +140,14 @@ begin
Result := FPath;
end;
function TFPUninstalledSourcesPackagesStructure.GetConfigFileForPackage(APackageName: string): string;
function TFPUninstalledSourcesPackagesStructure.GetConfigFileForPackage(APackage: TFPPackage): string;
begin
Result := IncludeTrailingPathDelimiter(GetBaseInstallDir)+
APackageName+PathDelim+APackageName+'-'+GFPpkg.CompilerOptions.CompilerTarget+FpmkExt;
if APackage.SourcePath<>'' then
Result := IncludeTrailingPathDelimiter(APackage.SourcePath)
else
Result := IncludeTrailingPathDelimiter(GetBaseInstallDir)+APackage.Name+PathDelim;
Result := Result +APackage.Name+'-'+GFPpkg.CompilerOptions.CompilerTarget+FpmkExt;
end;
{ TFppkgUninstalledRepositoryOptionSection }