paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-18 20:39:43 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Replaced global- and local-unitdir with a list of search-paths

Browse Source 
git-svn-id: trunk@34680 -
This commit is contained in:
joost 2016-10-08 21:26:08 +00:00
parent 6ed48e8ae1
commit a886681bb3
1 changed files with 94 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -950,14 +950,13 @@ Type
FMode : TCompilerMode;
FCompilerVersion : String;
FPrefix: String;
FLocalUnitDir,
FGlobalUnitDir,
FBaseInstallDir,
FUnitInstallDir,
FUnitConfigFilesInstallDir,
FBinInstallDir,
FDocInstallDir,
FExamplesInstallDir : String;
FSearchPath: TStrings;
FSkipCrossPrograms: boolean;
FThreadsAmount: integer;
FRemoveTree: String;
@ -969,6 +968,7 @@ Type
FUseEnvironment: Boolean;
FZipPrefix: String;
FExplicitOSNone: Boolean;
function SafeExpandFileName(const AFileName: string): string;
function GetBuildCPU: TCpu;
function GetBuildOS: TOS;
function GetBuildString: String;
@ -983,6 +983,7 @@ Type
function GetExamplesInstallDir: String;
function GetOptions: TStrings;
function GetPrefix: String;
function GetSearchPath: TStrings;
function GetUnitInstallDir: String;
function GetUnitConfigFilesInstallDir: String;
procedure SetLocalUnitDir(const AValue: String);
@ -993,6 +994,7 @@ Type
procedure SetOptions(const AValue: TStrings);
procedure SetOS(const AValue: TOS);
procedure SetPrefix(const AValue: String);
procedure SetSearchPath(AValue: TStrings);
procedure SetTarget(const AValue: String);
procedure SetUnitInstallDir(const AValue: String);
procedure SetUnitConfigFilesInstallDir(const AValue: String);
@ -1002,6 +1004,7 @@ Type
Function CmdLineOptions : String;
Public
Constructor Create;
Destructor Destroy; override;
Procedure InitDefaults;
Function HaveOptions: Boolean;
function IsBuildDifferentFromTarget: boolean;
@ -1041,6 +1044,9 @@ Type
// paths etc.
Property LocalUnitDir : String Read GetLocalUnitDir Write SetLocalUnitDir;
Property GlobalUnitDir : String Read GetGlobalUnitDir Write SetGlobalUnitDir;
// The SearchPath contains a list of directories in which packages are
// installed. Packages are searched for in order of this list.
Property SearchPath: TStrings read GetSearchPath write SetSearchPath;
Property Prefix : String Read GetPrefix Write SetPrefix;
Property ZipPrefix : String Read FZipPrefix Write SetZipPrefix;
Property BaseInstallDir : String Read GetBaseInstallDir Write SetBaseInstallDir;
@ -1598,6 +1604,7 @@ ResourceString
SWarngcclibpath = 'Warning: Unable to determine the libgcc path.';
SWarnNoFCLProcessSupport= 'No FCL-Process support';
SWarnRetryRemDirectory = 'Failed to remove directory "%s". Retry after a short delay';
SWarnCombinedPathAndUDir= 'Warning: SearchPath and Global/Local-UnitDir setting are better not be combined';
SInfoPackageAlreadyProcessed = 'Package %s is already processed';
SInfoCompilingTarget = 'Compiling target %s';
@ -1687,6 +1694,7 @@ ResourceString
SHelpBaseInstallDir = 'Use indicated directory as base install dir.';
SHelpLocalUnitDir = 'Use indicated directory as local (user) unit dir.';
SHelpGlobalUnitDir = 'Use indicated directory as global unit dir.';
SHelpSearchPath = 'Add search directory for packages.';
SHelpUnitInstallDir = 'Use indicated directory to install units into.';
SHelpCompiler = 'Use indicated binary as compiler';
SHelpConfig = 'Use indicated config file when compiling.';
@ -4024,6 +4032,12 @@ begin
end;
function TCustomDefaults.GetSearchPath: TStrings;
begin
Result := FSearchPath;
end;
function TCustomDefaults.GetUnitInstallDir: String;
begin
result := FUnitInstallDir;
@ -4038,7 +4052,10 @@ end;
function TCustomDefaults.GetLocalUnitDir: String;
begin
Result:=FLocalUnitDir;
if FSearchPath.Count>0 then
Result:=FSearchPath[0]
else
Result:='';
end;
function TCustomDefaults.GetFPDocOutputDir: String;
@ -4057,6 +4074,14 @@ begin
Result:=FixPath(FFPUnitSourcePath, True);
end;
function TCustomDefaults.SafeExpandFileName(const AFileName: string): string;
begin
if AFileName<>'' then
Result:=IncludeTrailingPathDelimiter(ExpandFileName(AFileName))
else
Result:='';
end;
function TCustomDefaults.GetBuildCPU: TCpu;
begin
result := StringToCPU({$I %FPCTARGETCPU%});
@ -4074,30 +4099,34 @@ end;
function TCustomDefaults.GetGlobalUnitDir: String;
begin
If (FGlobalUnitDir<>'') then
Result:=FGlobalUnitDir
if FSearchPath.Count>1 then
Result:=FSearchPath[1]
else
Result:=UnitInstallDir;
Result:='';
end;
procedure TCustomDefaults.SetLocalUnitDir(const AValue: String);
begin
// Use ExpandFileName to support ~/ expansion
if AValue<>'' then
FLocalUnitDir:=IncludeTrailingPathDelimiter(ExpandFileName(AValue))
if FSearchPath.Count=0 then
FSearchPath.Add(SafeExpandFileName(AValue))
else
FLocalUnitDir:='';
FSearchPath[0]:=SafeExpandFileName(AValue);
end;
procedure TCustomDefaults.SetGlobalUnitDir(const AValue: String);
begin
// Use ExpandFileName to support ~/ expansion
if AValue<>'' then
FGlobalUnitDir:=IncludeTrailingPathDelimiter(ExpandFileName(AValue))
if FSearchPath.Count<2 then
begin
if FSearchPath.Count<1 then
FSearchPath.Add('');
FSearchPath.Add(SafeExpandFileName(AValue));
end
else
FGlobalUnitDir:='';
FSearchPath[1]:=SafeExpandFileName(AValue);
end;
procedure TCustomDefaults.IntSetBaseInstallDir(const AValue: String);
@ -4142,6 +4171,11 @@ begin
BaseInstallDir:='';
end;
procedure TCustomDefaults.SetSearchPath(AValue: TStrings);
begin
FSearchPath.Assign(AValue);
end;
procedure TCustomDefaults.SetTarget(const AValue: String);
Var
@ -4201,9 +4235,16 @@ end;
constructor TCustomDefaults.Create;
begin
FSearchPath:=TStringList.Create;
InitDefaults;
end;
destructor TCustomDefaults.Destroy;
begin
FSearchPath.Free;
inherited;
end;
procedure TCustomDefaults.InitDefaults;
begin
@ -4342,8 +4383,8 @@ begin
Values[KeyCPU]:=CPUToString(FCPU);
Values[KeyOS]:=OSToString(FOS);
Values[KeyMode]:=ModeToString(FMode);
Values[KeyLocalUnitDir]:=FLocalUnitDir;
Values[KeyGlobalUnitDir]:=FGlobalUnitDir;
Values[KeyLocalUnitDir]:=LocalUnitDir;
Values[KeyGlobalUnitDir]:=GlobalUnitDir;
Values[KeyPrefix]:=FPrefix;
Values[KeyBaseInstallDir]:=FBaseInstallDir;
Values[KeyUnitInstallDir]:=FUnitInstallDir;
@ -4411,8 +4452,8 @@ begin
If (Line<>'') then
FMode:=StringToMode(Line);
FTarget:=Values[KeyTarget];
FLocalUnitDir:=Values[KeyLocalUnitDir];
FGlobalUnitDir:=Values[KeyGlobalUnitDir];
LocalUnitDir:=Values[KeyLocalUnitDir];
GlobalUnitDir:=Values[KeyGlobalUnitDir];
FPrefix:=Values[KeyPrefix];
FBaseInstallDir:=Values[KeyBaseInstallDir];
FUnitInstallDir:=Values[KeyUnitInstallDir];
@ -4469,10 +4510,6 @@ begin
// Where to install by default
if (FBaseInstallDir='') and (FPrefix='') then
BaseInstallDir:=BD;
// Where to find the units by default
if (FGlobalUnitDir='') then
GlobalUnitDir:=IncludeTrailingPathDelimiter(BD)+'units'+PathDelim+Target;
end;
@ -4695,9 +4732,13 @@ Var
DefaultsFileName : string;
OptString : string;
CustOptName : string;
UnitDirSet: Boolean;
SearchPathSet: Boolean;
begin
I:=0;
FListMode:=False;
UnitDirSet:=False;
SearchPathSet:=False;
FLogLevels:=DefaultMessages;
While (I<ParamCount) do
begin
@ -4762,9 +4803,26 @@ begin
else if CheckOption(I,'U','unitinstalldir') then
Defaults.UnitInstallDir:=OptionArg(I)
else if CheckOption(I,'UL','localunitdir') then
Defaults.LocalUnitDir:=OptionArg(I)
begin
UnitDirSet:=true;
if SearchPathSet then
Log(vlWarning,SWarnCombinedPathAndUDir);
Defaults.LocalUnitDir:=OptionArg(I)
end
else if CheckOption(I,'UG','globalunitdir') then
Defaults.GlobalUnitDir:=OptionArg(I)
begin
UnitDirSet:=true;
if SearchPathSet then
Log(vlWarning,SWarnCombinedPathAndUDir);
Defaults.GlobalUnitDir:=OptionArg(I)
end
else if CheckOption(I,'sp','searchpath') then
begin
SearchPathSet:=true;
if UnitDirSet then
Log(vlWarning,SWarnCombinedPathAndUDir);
Defaults.SearchPath.Add(OptionArg(I, true));
end
else if CheckOption(I,'o','options', true) then
begin
OptString := OptionArg(I, true);
@ -4862,6 +4920,7 @@ begin
LogArgOption('B','baseinstalldir',SHelpBaseInstalldir);
LogArgOption('UL','localunitdir',SHelpLocalUnitdir);
LogArgOption('UG','globalunitdir',SHelpGlobalUnitdir);
LogArgOption('sp','searchpath',SHelpSearchPath);
LogArgOption('U','unitinstalldir',SHelpUnitInstallDir);
LogArgOption('r','compiler',SHelpCompiler);
LogArgOption('f','config',SHelpConfig);
@ -6006,23 +6065,27 @@ procedure TBuildEngine.ResolvePackagePaths(APackage:TPackage);
end;
end;
var
i: Integer;
begin
if APackage.UnitDir='' then
begin
// Retrieve Full directory name where to find the units.
// The search order is:
// - Package in this fpmake.pp
// - LocalUnitDir
// - GlobalUnitDir
// - SearchPath, first paths first.
if (APackage.State in [tsCompiled, tsNoCompile, tsInstalled]) then
ResolveUnitConfigFilenameForBasePath(FStartDir);
if (APackage.UnitDir='') and
(Defaults.LocalUnitDir<>'') then
ResolveUnitConfigFilenameForBasePath(Defaults.LocalUnitDir);
if (APackage.UnitDir='') and
(Defaults.GlobalUnitDir<>'') then
ResolveUnitConfigFilenameForBasePath(Defaults.GlobalUnitDir);
if (APackage.UnitDir='') 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;
end;
if (APackage.UnitDir='') then
APackage.UnitDir:=DirNotFound;
end;