浏览代码

* 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 -

peter 17 年之前
父节点
当前提交
dd1a7ce8e3
共有 5 个文件被更改,包括 353 次插入323 次删除
  1. 304 257
      utils/fppkg/fpmkunitsrc.inc
  2. 4 0
      utils/fppkg/fppkg.pp
  3. 38 19
      utils/fppkg/pkgfpmake.pp
  4. 3 47
      utils/fppkg/pkgglobals.pp
  5. 4 0
      utils/fppkg/pkgoptions.pp

文件差异内容过多而无法显示
+ 304 - 257
utils/fppkg/fpmkunitsrc.inc


+ 4 - 0
utils/fppkg/fppkg.pp

@@ -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}

+ 38 - 19
utils/fppkg/pkgfpmake.pp

@@ -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';
-      OOptions:=OOptions+' -O2 -XXs';
+        AddOption('-vi');
+      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';
-  OOptions:=OOptions+' --compiler='+CompilerOptions.Compiler;
-  OOptions:=OOptions+' --cpu='+CPUToString(CompilerOptions.CompilerCPU);
-  OOptions:=OOptions+' --os='+OSToString(CompilerOptions.CompilerOS);
+    AddOption('--verbose');
+  AddOption('--compiler='+CompilerOptions.Compiler);
+  AddOption('--cpu='+CPUToString(CompilerOptions.CompilerCPU));
+  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;
-  OOptions:=OOptions+' --globalunitdir='+CompilerOptions.GlobalUnitDir;
+    AddOption('--localunitdir='+CompilerOptions.LocalUnitDir);
+  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;

+ 3 - 47
utils/fppkg/pkgglobals.pp

@@ -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.

+ 4 - 0
utils/fppkg/pkgoptions.pp

@@ -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}

部分文件因为文件数量过多而无法显示