Browse Source

* Handle FPC -oEXENAME option gracefully by adding a new field to TTarget class.

  + Add FExeName field for TTarget class
  + Add public SetExeName to be able to use -o Free Pascal compiler option
    to specify name of produced executable.
  + Add GetBinFileBase method to get base of executable or library name.

git-svn-id: trunk@38143 -
pierre 7 years ago
parent
commit
eb39402e28
1 changed files with 28 additions and 4 deletions
  1. 28 4
      packages/fpmkunit/src/fpmkunit.pp

+ 28 - 4
packages/fpmkunit/src/fpmkunit.pp

@@ -606,6 +606,7 @@ Type
     FCommands : TCommands;
     FCommands : TCommands;
     FDirectory: String;
     FDirectory: String;
     FExtension: String;
     FExtension: String;
+    FExeName : String;
     FTargetSourceFileName : String;
     FTargetSourceFileName : String;
     FFileType: TFileType;
     FFileType: TFileType;
     FOptions: TStrings;
     FOptions: TStrings;
@@ -620,6 +621,7 @@ Type
     Function GetUnitFileName : String; virtual;
     Function GetUnitFileName : String; virtual;
     function GetUnitLibFileName(AOS: TOS): String; virtual;
     function GetUnitLibFileName(AOS: TOS): String; virtual;
     Function GetObjectFileName : String; virtual;
     Function GetObjectFileName : String; virtual;
+    Function GetBinFileBase: String;
     function GetRSTFileName : String; Virtual;
     function GetRSTFileName : String; Virtual;
     function GetRSJFileName : String; Virtual;
     function GetRSJFileName : String; Virtual;
     function GetImportLibFileName(AOS : TOS) : String; Virtual;
     function GetImportLibFileName(AOS : TOS) : String; Virtual;
@@ -634,6 +636,7 @@ Type
     Function  GetOutputFileName (AOs : TOS) : String; Virtual;
     Function  GetOutputFileName (AOs : TOS) : String; Virtual;
     Function HaveOptions : Boolean;
     Function HaveOptions : Boolean;
     procedure SetName(const AValue: String);override;
     procedure SetName(const AValue: String);override;
+    procedure SetExeName(const AValue: String);
     procedure SetXML(const AValue: string);
     procedure SetXML(const AValue: string);
     Procedure GetCleanFiles(List : TStrings; const APrefixU, APrefixB : String; ACPU:TCPU; AOS : TOS); virtual;
     Procedure GetCleanFiles(List : TStrings; const APrefixU, APrefixB : String; ACPU:TCPU; AOS : TOS); virtual;
     Procedure GetInstallFiles(List : TStrings; const APrefixU, APrefixB : String; ACPU:TCPU; AOS : TOS); virtual;
     Procedure GetInstallFiles(List : TStrings; const APrefixU, APrefixB : String; ACPU:TCPU; AOS : TOS); virtual;
@@ -8548,20 +8551,29 @@ begin
 end;
 end;
 
 
 
 
+function TTarget.GetBinFileBase: String;
+begin
+  if FExeName <> '' then
+    Result := FExeName
+  else
+    Result:=Name;
+end;
+
+
 function TTarget.GetProgramFileName(AOS : TOS): String;
 function TTarget.GetProgramFileName(AOS : TOS): String;
 begin
 begin
-  result := AddProgramExtension(Name, AOS);
+    result := AddProgramExtension(GetBinFileBase, AOS);
 end;
 end;
 
 
 
 
 function TTarget.GetProgramDebugFileName(AOS: TOS): String;
 function TTarget.GetProgramDebugFileName(AOS: TOS): String;
 begin
 begin
-  result := Name + DbgExt;
+  result := GetBinFileBase + DbgExt;
 end;
 end;
 
 
 function TTarget.GetLibraryFileName(AOS : TOS): String;
 function TTarget.GetLibraryFileName(AOS : TOS): String;
 begin
 begin
-  result := AddLibraryExtension(Name, AOS);
+  result := AddLibraryExtension(GetBinFileBase, AOS);
   if aOS in AllUnixOSes then
   if aOS in AllUnixOSes then
     Result:='lib'+Result;
     Result:='lib'+Result;
 end;
 end;
@@ -8569,7 +8581,7 @@ end;
 
 
 function TTarget.GetLibraryDebugFileName(AOS: TOS): String;
 function TTarget.GetLibraryDebugFileName(AOS: TOS): String;
 begin
 begin
-  result := Name + DbgExt;
+  result := GetBinFileBase + DbgExt;
 end;
 end;
 
 
 
 
@@ -8602,6 +8614,18 @@ begin
   FDirectory:=D;
   FDirectory:=D;
 end;
 end;
 
 
+procedure TTarget.SetExeName(const AValue: String);
+Var
+  N,E : String;
+begin
+  N:=FixPath(AValue, False);
+  E:=ExtractFileExt(N);
+  N:=ExtractFileName(N);
+  FExeName:=Copy(N,1,Length(N)-Length(E));
+  { Use exact AValue for -o option }
+  Options.Add('-o'+AValue);
+end;
+
 procedure TTarget.SetXML(const AValue: string);
 procedure TTarget.SetXML(const AValue: string);
 begin
 begin
   FXML:=FixPath(AValue, False);
   FXML:=FixPath(AValue, False);