* quoted parameters

* workaround broken fpc.exe in 2.2.0, retreive real compiler binary instead
  * fppkg requires at least 2.2.1 to be compiled, because of broken sysutils and zipper

git-svn-id: trunk@10132 -
This commit is contained in:
peter 2008-02-01 08:12:33 +00:00
parent 2400207ead
commit dd1a7ce8e3
5 changed files with 1178 additions and 1147 deletions

File diff suppressed because it is too large Load Diff

View File

@ -2,6 +2,10 @@ program fppkg;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
{$if defined(VER2_2) and (FPC_PATCH<1)}
{$fatal At least FPC 2.2.1 is required to compile fppkg}
{$endif}
uses uses
// General // General
{$ifdef unix} {$ifdef unix}

View File

@ -114,6 +114,8 @@ end;
{ TFPMakeCompiler } { TFPMakeCompiler }
Procedure TFPMakeCompiler.CompileFPMake; Procedure TFPMakeCompiler.CompileFPMake;
var
OOptions : string;
function CheckUnitDir(const AUnitName:string;Out AUnitDir:string):boolean; function CheckUnitDir(const AUnitName:string;Out AUnitDir:string):boolean;
begin begin
@ -136,17 +138,24 @@ Procedure TFPMakeCompiler.CompileFPMake;
AUnitDir:=''; AUnitDir:='';
end; end;
procedure AddOption(const s:string);
begin
if OOptions<>'' then
OOptions:=OOptions+' ';
OOptions:=OOptions+maybequoted(s);
end;
const const
TempBuildDir = 'build-fpmake'; TempBuildDir = 'build-fpmake';
Var Var
i : Integer; i : Integer;
OOptions,
DepDir, DepDir,
FPMakeBin, FPMakeBin,
FPMakeSrc : string; FPMakeSrc : string;
NeedFPMKUnitSource, NeedFPMKUnitSource,
HaveFpmake : boolean; HaveFpmake : boolean;
begin begin
OOptions:='';
SetCurrentDir(PackageBuildPath); SetCurrentDir(PackageBuildPath);
// Check for fpmake source // Check for fpmake source
FPMakeBin:='fpmake'+ExeExt; FPMakeBin:='fpmake'+ExeExt;
@ -164,13 +173,13 @@ begin
begin begin
if Not HaveFPMake then if Not HaveFPMake then
Error(SErrMissingFPMake); Error(SErrMissingFPMake);
OOptions:='-n'; AddOption('-n');
for i:=1 to FPMKUnitDepCount do for i:=1 to FPMKUnitDepCount do
begin begin
if FPMKUnitDepAvailable[i] then if FPMKUnitDepAvailable[i] then
begin begin
if CheckUnitDir(FPMKUnitDeps[i].package,DepDir) then if CheckUnitDir(FPMKUnitDeps[i].package,DepDir) then
OOptions:=OOptions+' -Fu'+DepDir AddOption(maybequoted('-Fu'+DepDir))
else else
Error(SErrMissingInstallPackage,[FPMKUnitDeps[i].package]); Error(SErrMissingInstallPackage,[FPMKUnitDeps[i].package]);
end end
@ -180,26 +189,27 @@ begin
if FPMKUnitDeps[i].package='fpmkunit' then if FPMKUnitDeps[i].package='fpmkunit' then
begin begin
NeedFPMKUnitSource:=true; NeedFPMKUnitSource:=true;
OOptions:=OOptions+' -Fu'+TempBuildDir; AddOption('-Fu'+TempBuildDir);
end; end;
if FPMKUnitDeps[i].undef<>'' then if FPMKUnitDeps[i].undef<>'' then
OOptions:=OOptions+' -d'+FPMKUnitDeps[i].undef; AddOption('-d'+FPMKUnitDeps[i].undef);
end; end;
end; end;
// Add RTL unit dir // Add RTL unit dir
if not CheckUnitDir('rtl',DepDir) then if not CheckUnitDir('rtl',DepDir) then
Error(SErrMissingInstallPackage,['rtl']); Error(SErrMissingInstallPackage,['rtl']);
OOptions:=OOptions+' -Fu'+DepDir; AddOption('-Fu'+DepDir);
// Units in a directory for easy cleaning // Units in a directory for easy cleaning
DeleteDir(TempBuildDir); DeleteDir(TempBuildDir);
ForceDirectories(TempBuildDir); ForceDirectories(TempBuildDir);
OOptions:=OOptions+' -FU'+TempBuildDir; AddOption('-FU'+TempBuildDir);
// Compile options // Compile options
// -- default is to optimize, smartlink and strip to reduce // -- default is to optimize, smartlink and strip to reduce
// the executable size (there can be 100's of fpmake's on a system) // the executable size (there can be 100's of fpmake's on a system)
if vlInfo in LogLevels then if vlInfo in LogLevels then
OOptions:=OOptions+' -vi'; AddOption('-vi');
OOptions:=OOptions+' -O2 -XXs'; AddOption('-O2');
AddOption('-XXs');
// Create fpmkunit.pp if needed // Create fpmkunit.pp if needed
if NeedFPMKUnitSource then if NeedFPMKUnitSource then
CreateFPMKUnitSource(TempBuildDir+PathDelim+'fpmkunit.pp'); CreateFPMKUnitSource(TempBuildDir+PathDelim+'fpmkunit.pp');
@ -228,27 +238,36 @@ Function TFPMakeRunner.RunFPMake(const Command:string) : Integer;
Var Var
FPMakeBin, FPMakeBin,
OOptions : string; OOptions : string;
procedure AddOption(const s:string);
begin
if OOptions<>'' then
OOptions:=OOptions+' ';
OOptions:=OOptions+maybequoted(s);
end;
begin begin
OOptions:='';
{ Maybe compile fpmake executable? } { Maybe compile fpmake executable? }
ExecuteAction(CurrentPackage,'compilefpmake'); ExecuteAction(CurrentPackage,'compilefpmake');
{ Create options } { Create options }
OOptions:=' --nofpccfg'; AddOption('--nofpccfg');
if vlInfo in LogLevels then if vlInfo in LogLevels then
OOptions:=OOptions+' --verbose'; AddOption('--verbose');
OOptions:=OOptions+' --compiler='+CompilerOptions.Compiler; AddOption('--compiler='+CompilerOptions.Compiler);
OOptions:=OOptions+' --cpu='+CPUToString(CompilerOptions.CompilerCPU); AddOption('--cpu='+CPUToString(CompilerOptions.CompilerCPU));
OOptions:=OOptions+' --os='+OSToString(CompilerOptions.CompilerOS); AddOption('--os='+OSToString(CompilerOptions.CompilerOS));
if IsSuperUser or GlobalOptions.InstallGlobal then if IsSuperUser or GlobalOptions.InstallGlobal then
OOptions:=OOptions+' --baseinstalldir='+CompilerOptions.GlobalInstallDir AddOption('--baseinstalldir='+CompilerOptions.GlobalInstallDir)
else else
OOptions:=OOptions+' --baseinstalldir='+CompilerOptions.LocalInstallDir; AddOption('--baseinstalldir='+CompilerOptions.LocalInstallDir);
if CompilerOptions.LocalInstallDir<>'' then if CompilerOptions.LocalInstallDir<>'' then
OOptions:=OOptions+' --localunitdir='+CompilerOptions.LocalUnitDir; AddOption('--localunitdir='+CompilerOptions.LocalUnitDir);
OOptions:=OOptions+' --globalunitdir='+CompilerOptions.GlobalUnitDir; AddOption('--globalunitdir='+CompilerOptions.GlobalUnitDir);
{ Run FPMake } { Run FPMake }
FPMakeBin:='fpmake'+ExeExt; FPMakeBin:='fpmake'+ExeExt;
SetCurrentDir(PackageBuildPath); SetCurrentDir(PackageBuildPath);
Result:=ExecuteProcess(FPMakeBin,Command+OOptions); Result:=ExecuteProcess(FPMakeBin,Command+' '+OOptions);
if Result<>0 then if Result<>0 then
Error(SErrExecutionFPMake,[Command]); Error(SErrExecutionFPMake,[Command]);
end; end;

View File

@ -5,6 +5,9 @@ unit pkgglobals;
interface interface
uses uses
{$ifdef unix}
baseunix,
{$endif}
SysUtils, SysUtils,
Classes; Classes;
@ -53,11 +56,6 @@ const
type type
EPackagerError = class(Exception); EPackagerError = class(Exception);
{$if defined(VER2_2) and defined(WINDOWS)}
Function GetAppConfigDir(Global : Boolean) : String;
Function GetAppConfigFile(Global : Boolean; SubDir : Boolean) : String;
{$endif VER2_2 AND WINDOWS}
// Logging // Logging
Function StringToLogLevels (S : String) : TLogLevels; Function StringToLogLevels (S : String) : TLogLevels;
Function LogLevelsToString (V : TLogLevels): String; Function LogLevelsToString (V : TLogLevels): String;
@ -93,9 +91,6 @@ Implementation
uses uses
typinfo, typinfo,
{$ifdef unix}
baseunix,
{$endif}
{$IFNDEF USE_SHELL} {$IFNDEF USE_SHELL}
process, process,
{$ENDIF USE_SHELL} {$ENDIF USE_SHELL}
@ -124,43 +119,6 @@ begin
end; end;
{$if defined(VER2_2) and defined(WINDOWS)}
Function SHGetFolderPath(Ahwnd: HWND; Csidl: Integer; Token: THandle; Flags: DWord; Path: PChar): HRESULT;
stdcall;external 'shfolder' name 'SHGetFolderPathA';
Function GetAppConfigDir(Global : Boolean) : String;
Const
CSIDL_LOCAL_APPDATA = $001C; { %USERPROFILE%\Local Settings\Application Data (non roaming) }
CSIDL_COMMON_APPDATA = $0023; { %PROFILESPATH%\All Users\Application Data }
CSIDL_FLAG_CREATE = $8000; { (force creation of requested folder if it doesn't exist yet) }
Var
APath : Array[0..MAX_PATH] of char;
ID : integer;
begin
If Global then
ID:=CSIDL_COMMON_APPDATA
else
ID:=CSIDL_LOCAL_APPDATA;
if SHGetFolderPath(0,ID or CSIDL_FLAG_CREATE,0,0,@APATH[0])=S_OK then
Result:=IncludeTrailingPathDelimiter(StrPas(@APath[0]))
If (Result<>'') then
begin
if FPPkgGetVendorName<>'' then
Result:=IncludeTrailingPathDelimiter(Result+FPPkgGetVendorName);
Result:=Result+ApplicationName;
end
else
Result:=DGetAppConfigDir(Global);
end;
Function GetAppConfigFile(Global : Boolean; SubDir : Boolean) : String;
begin
Result:=IncludeTrailingPathDelimiter(GetAppConfigDir(Global));
if SubDir then
Result:=IncludeTrailingPathDelimiter(Result+'Config');
Result:=Result+ApplicationName+ConfigExtension;
end;
{$endif VER2_2 AND WINDOWS}
function StringToLogLevels(S: String): TLogLevels; function StringToLogLevels(S: String): TLogLevels;
Var Var
@ -410,9 +368,7 @@ end;
initialization initialization
{$ifndef VER2_2}
OnGetVendorName:=@FPPkgGetVendorName; OnGetVendorName:=@FPPkgGetVendorName;
{$endif}
OnGetApplicationName:=@FPPkgGetApplicationName; OnGetApplicationName:=@FPPkgGetApplicationName;
end. end.

View File

@ -426,6 +426,10 @@ begin
FCompilerVersion:=infosl[0]; FCompilerVersion:=infosl[0];
FCompilerCPU:=StringToCPU(infosl[1]); FCompilerCPU:=StringToCPU(infosl[1]);
FCompilerOS:=StringToOS(infosl[2]); FCompilerOS:=StringToOS(infosl[2]);
// Temporary hack to workaround bug in fpc.exe that doesn't support spaces
// We retrieve the real binary
if FCompilerVersion='2.2.0' then
FCompiler:=GetCompilerInfo(FCompiler,'-PB');
Log(vlDebug,SLogDetectedCompiler,[FCompiler,FCompilerVersion,MakeTargetString(FCompilerCPU,FCompilerOS)]); Log(vlDebug,SLogDetectedCompiler,[FCompiler,FCompilerVersion,MakeTargetString(FCompilerCPU,FCompilerOS)]);
// Use the same algorithm as the compiler, see options.pas // Use the same algorithm as the compiler, see options.pas
{$ifdef Unix} {$ifdef Unix}