Browse Source

* Added ability to pass options to other packages + test

git-svn-id: trunk@35797 -
joost 8 years ago
parent
commit
75e8cbd187

+ 8 - 0
.gitattributes

@@ -3434,6 +3434,14 @@ packages/fppkg/tests/packages/base/packagea/fpmake.pp svneol=native#text/plain
 packages/fppkg/tests/packages/base/packagea/src/PackageAUnitA.pas svneol=native#text/plain
 packages/fppkg/tests/packages/base/packagea/src/PackageAUnitA.pas svneol=native#text/plain
 packages/fppkg/tests/packages/base/packageb/fpmake.pp svneol=native#text/plain
 packages/fppkg/tests/packages/base/packageb/fpmake.pp svneol=native#text/plain
 packages/fppkg/tests/packages/base/packageb/src/PackageBUnitB.pas svneol=native#text/plain
 packages/fppkg/tests/packages/base/packageb/src/PackageBUnitB.pas svneol=native#text/plain
+packages/fppkg/tests/packages/specific/transmitoptions/packagea/fpmake.pp svneol=native#text/pascal
+packages/fppkg/tests/packages/specific/transmitoptions/packagea/src/PackageAUnitA.pas svneol=native#text/pascal
+packages/fppkg/tests/packages/specific/transmitoptions/packageb1/fpmake.pp svneol=native#text/pascal
+packages/fppkg/tests/packages/specific/transmitoptions/packageb1/src/PackageB1UnitB.pas svneol=native#text/pascal
+packages/fppkg/tests/packages/specific/transmitoptions/packageb2/fpmake.pp svneol=native#text/pascal
+packages/fppkg/tests/packages/specific/transmitoptions/packageb2/src/PackageB2UnitB.pas svneol=native#text/pascal
+packages/fppkg/tests/packages/specific/transmitoptions/packagec/fpmake.pp svneol=native#text/pascal
+packages/fppkg/tests/packages/specific/transmitoptions/packagec/src/PackageC.pas svneol=native#text/pascal
 packages/fppkg/tests/readme.txt svneol=native#text/plain
 packages/fppkg/tests/readme.txt svneol=native#text/plain
 packages/fuse/Makefile svneol=native#text/plain
 packages/fuse/Makefile svneol=native#text/plain
 packages/fuse/Makefile.fpc svneol=native#text/plain
 packages/fuse/Makefile.fpc svneol=native#text/plain

+ 74 - 1
packages/fpmkunit/src/fpmkunit.pp

@@ -790,6 +790,7 @@ Type
     FSources: TSources;
     FSources: TSources;
     FDirectory: String;
     FDirectory: String;
     FOptions: TStrings;
     FOptions: TStrings;
+    FTransmitOptions: TStrings;
     FFileName: String;
     FFileName: String;
     FShortName: String;
     FShortName: String;
     FAuthor: String;
     FAuthor: String;
@@ -823,8 +824,10 @@ Type
     Function GetFileName : string;
     Function GetFileName : string;
     Function GetShortName : string;
     Function GetShortName : string;
     function GetOptions: TStrings;
     function GetOptions: TStrings;
+    function GetTransmitOptions: TStrings;
     Function GetVersion : string;
     Function GetVersion : string;
     procedure SetOptions(const AValue: TStrings);
     procedure SetOptions(const AValue: TStrings);
+    procedure SetTransmitOptions(AValue: TStrings);
     Procedure SetVersion(const V : string);
     Procedure SetVersion(const V : string);
   Protected
   Protected
     procedure SetName(const AValue: String);override;
     procedure SetName(const AValue: String);override;
@@ -870,6 +873,9 @@ Type
     Property SupportBuildModes: TBuildModes read FSupportBuildModes write FSupportBuildModes;
     Property SupportBuildModes: TBuildModes read FSupportBuildModes write FSupportBuildModes;
     Property BuildMode: TBuildMode read FBuildMode;
     Property BuildMode: TBuildMode read FBuildMode;
     Property Flags: TStrings read FFlags;
     Property Flags: TStrings read FFlags;
+    // Options which are passed to the compiler for packages which depend on
+    // this package.
+    Property TransmitOptions: TStrings Read GetTransmitOptions Write SetTransmitOptions;
     // Compiler options.
     // Compiler options.
     Property OSes : TOSes Read FOSes Write FOSes;
     Property OSes : TOSes Read FOSes Write FOSes;
     Property CPUs : TCPUs Read FCPUs Write FCPUs;
     Property CPUs : TCPUs Read FCPUs Write FCPUs;
@@ -1153,6 +1159,7 @@ Type
     procedure ResolvePackagePaths(APackage:TPackage);
     procedure ResolvePackagePaths(APackage:TPackage);
     procedure AddDependencyPaths(L: TStrings; DependencyType: TDependencyType; ATarget: TTarget);
     procedure AddDependencyPaths(L: TStrings; DependencyType: TDependencyType; ATarget: TTarget);
     procedure AddDependencyUnitPaths(L:TStrings;APackage: TPackage);
     procedure AddDependencyUnitPaths(L:TStrings;APackage: TPackage);
+    procedure AddDependencyTransmittedOptions(Args: TStrings; APackage: TPackage);
   Public
   Public
     Constructor Create(AOwner : TComponent); override;
     Constructor Create(AOwner : TComponent); override;
     destructor Destroy;override;
     destructor Destroy;override;
@@ -1797,6 +1804,7 @@ Const
   KeyNeedLibC = 'NeedLibC';
   KeyNeedLibC = 'NeedLibC';
   KeyDepends  = 'Depends';
   KeyDepends  = 'Depends';
   KeyFlags    = 'Flags';
   KeyFlags    = 'Flags';
+  KeyTransmit = 'TransmitOptions';
   KeyAddIn    = 'FPMakeAddIn';
   KeyAddIn    = 'FPMakeAddIn';
   KeySourcePath = 'SourcePath';
   KeySourcePath = 'SourcePath';
   KeyFPMakeOptions = 'FPMakeOptions';
   KeyFPMakeOptions = 'FPMakeOptions';
@@ -3539,6 +3547,7 @@ begin
   FreeAndNil(FTargets);
   FreeAndNil(FTargets);
   FreeAndNil(FVersion);
   FreeAndNil(FVersion);
   FreeAndNil(FOptions);
   FreeAndNil(FOptions);
+  FreeAndNil(FTransmitOptions);
   FreeAndNil(FFlags);
   FreeAndNil(FFlags);
   FreeAndNil(FPackageVariants);
   FreeAndNil(FPackageVariants);
   inherited destroy;
   inherited destroy;
@@ -3749,6 +3758,13 @@ begin
     Options.Assign(AValue);
     Options.Assign(AValue);
 end;
 end;
 
 
+procedure TPackage.SetTransmitOptions(AValue: TStrings);
+begin
+  If (AValue=Nil) or (AValue.Count=0) then
+    FreeAndNil(FTransmitOptions)
+  else
+    TransmitOptions.Assign(AValue);
+end;
 
 
 Procedure TPackage.SetVersion(const V : string);
 Procedure TPackage.SetVersion(const V : string);
 begin
 begin
@@ -3785,6 +3801,12 @@ begin
   Result:=FOptions;
   Result:=FOptions;
 end;
 end;
 
 
+function TPackage.GetTransmitOptions: TStrings;
+begin
+  If (FTransmitOptions=Nil) then
+    FTransmitOptions:=TStringList.Create;
+  Result:=FTransmitOptions;
+end;
 
 
 Procedure TPackage.GetManifest(Manifest : TStrings);
 Procedure TPackage.GetManifest(Manifest : TStrings);
 
 
@@ -3999,7 +4021,8 @@ begin
         NeedLibC:=Upcase(Values[KeyNeedLibC])='Y';
         NeedLibC:=Upcase(Values[KeyNeedLibC])='Y';
         IsFPMakeAddIn:=Upcase(Values[KeyAddIn])='Y';
         IsFPMakeAddIn:=Upcase(Values[KeyAddIn])='Y';
         Flags.DelimitedText:=Values[KeyFlags];
         Flags.DelimitedText:=Values[KeyFlags];
-
+        if Values[KeyTransmit]<>'' then
+          TransmitOptions.DelimitedText:=Values[KeyTransmit];
         i := 1;
         i := 1;
         repeat
         repeat
         PackageVariantsStr:=Values[KeyPackageVar+inttostr(i)];
         PackageVariantsStr:=Values[KeyPackageVar+inttostr(i)];
@@ -4079,6 +4102,8 @@ begin
       Values[KeyDepends]:=Deps;
       Values[KeyDepends]:=Deps;
       if Flags.Count>0 then
       if Flags.Count>0 then
         Values[KeyFlags]:=Flags.DelimitedText;
         Values[KeyFlags]:=Flags.DelimitedText;
+      if TransmitOptions.Count>0 then
+        Values[KeyTransmit]:=TransmitOptions.DelimitedText;
       if NeedLibC then
       if NeedLibC then
         Values[KeyNeedLibC]:='Y'
         Values[KeyNeedLibC]:='Y'
       else
       else
@@ -6350,6 +6375,51 @@ begin
     end;
     end;
 end;
 end;
 
 
+threadvar
+  GHandledRecursiveDependencies: TStrings;
+
+procedure TBuildEngine.AddDependencyTransmittedOptions(Args: TStrings; APackage: TPackage);
+Var
+  I, J : Integer;
+  P : TPackage;
+  D : TDependency;
+  S : String;
+  IsRootLevel: Boolean;
+begin
+  if not Assigned(GHandledRecursiveDependencies) then
+    begin
+      GHandledRecursiveDependencies := TStringList.Create;
+      IsRootLevel := True;
+    end
+  else
+    IsRootLevel := False;
+
+  try
+    For I:=0 to APackage.Dependencies.Count-1 do
+      begin
+        D:=APackage.Dependencies[i];
+        if (D.DependencyType=depPackage) and
+           (Defaults.CPU in D.CPUs) and (Defaults.OS in D.OSes) then
+          begin
+            P:=TPackage(D.Target);
+            If Assigned(P) then
+              begin
+                // Already processed?
+                if GHandledRecursiveDependencies.IndexOf(P.Name)=-1 then
+                  begin
+                    GHandledRecursiveDependencies.Add(P.Name);
+                    AddDependencyTransmittedOptions(Args,P);
+                    Args.AddStrings(P.TransmitOptions);
+                  end;
+              end;
+          end;
+      end;
+  finally
+    if IsRootLevel then
+      FreeAndNil(GHandledRecursiveDependencies);
+  end;
+end;
+
 function TBuildEngine.AddPathPrefix(APackage: TPackage; APath: string): string;
 function TBuildEngine.AddPathPrefix(APackage: TPackage; APath: string): string;
 begin
 begin
   if IsRelativePath(APath) and (GPathPrefix<>'') then
   if IsRelativePath(APath) and (GPathPrefix<>'') then
@@ -6450,6 +6520,9 @@ begin
     Args.Add('-Fl'+FCachedlibcPath);
     Args.Add('-Fl'+FCachedlibcPath);
     end;
     end;
 
 
+  // Custom options which are added by dependencies
+  AddDependencyTransmittedOptions(Args, APackage);
+
   // Custom Options
   // Custom Options
   If (Defaults.HaveOptions) then
   If (Defaults.HaveOptions) then
     Args.AddStrings(Defaults.Options);
     Args.AddStrings(Defaults.Options);

+ 33 - 3
packages/fppkg/tests/fullfpcinstallationtests.pas

@@ -33,6 +33,7 @@ type
     procedure TestBuildWithInstalledDependency;
     procedure TestBuildWithInstalledDependency;
     procedure TestFakePackageDir;
     procedure TestFakePackageDir;
     procedure TestSourceDependency;
     procedure TestSourceDependency;
+    procedure TestTransmitOptions;
   end;
   end;
 
 
   { TFullFPCInstallationSetup }
   { TFullFPCInstallationSetup }
@@ -55,11 +56,12 @@ type
     class function GetTemplatePath: string;
     class function GetTemplatePath: string;
     class function GetTestPath: string;
     class function GetTestPath: string;
     class function GetBasePackagesPath: string;
     class function GetBasePackagesPath: string;
+    class function GetSpecificPackagesPath: string;
     class function GetCurrentTestBasePackagesPath: string;
     class function GetCurrentTestBasePackagesPath: string;
     class function GetTestBinPath: string;
     class function GetTestBinPath: string;
     class function GetTargetString: string;
     class function GetTargetString: string;
     class function GetCompilerVersion: string;
     class function GetCompilerVersion: string;
-    class function SyncPackageIntoCurrentTest(APackageName: string): string;
+    class function SyncPackageIntoCurrentTest(APackageName: string; SpecificPackageDir: string = ''): string;
   end;
   end;
 
 
 implementation
 implementation
@@ -246,6 +248,11 @@ begin
   Result := IncludeTrailingPathDelimiter(ConcatPaths([FPackagesPath, 'base']));
   Result := IncludeTrailingPathDelimiter(ConcatPaths([FPackagesPath, 'base']));
 end;
 end;
 
 
+class function TFullFPCInstallationSetup.GetSpecificPackagesPath: string;
+begin
+  Result := IncludeTrailingPathDelimiter(ConcatPaths([FPackagesPath, 'specific']));
+end;
+
 class function TFullFPCInstallationSetup.GetCurrentTestBasePackagesPath: string;
 class function TFullFPCInstallationSetup.GetCurrentTestBasePackagesPath: string;
 begin
 begin
   Result := IncludeTrailingPathDelimiter(ConcatPaths([GetCurrentTestPath, 'packages']));
   Result := IncludeTrailingPathDelimiter(ConcatPaths([GetCurrentTestPath, 'packages']));
@@ -266,10 +273,16 @@ begin
   Result := FCompilerVersion;
   Result := FCompilerVersion;
 end;
 end;
 
 
-class function TFullFPCInstallationSetup.SyncPackageIntoCurrentTest(APackageName: string): string;
+class function TFullFPCInstallationSetup.SyncPackageIntoCurrentTest(APackageName: string; SpecificPackageDir: string): string;
+var
+  PackagePath: string;
 begin
 begin
   ForceDirectories(ConcatPaths([TFullFPCInstallationSetup.GetTestPath, 'currenttest', 'packages']));
   ForceDirectories(ConcatPaths([TFullFPCInstallationSetup.GetTestPath, 'currenttest', 'packages']));
-  RunTestCommandIndir(TFullFPCInstallationSetup.GetTestPath, 'rsync', ['-rtvu', '--delete', TFullFPCInstallationSetup.GetBasePackagesPath+APackageName+PathDelim, TFullFPCInstallationSetup.GetCurrentTestBasePackagesPath+APackageName], 'sync template');
+  if SpecificPackageDir='' then
+    PackagePath := TFullFPCInstallationSetup.GetBasePackagesPath+APackageName+PathDelim
+  else
+    PackagePath := ConcatPaths([TFullFPCInstallationSetup.GetSpecificPackagesPath, SpecificPackageDir, APackageName])+PathDelim;
+  RunTestCommandIndir(TFullFPCInstallationSetup.GetTestPath, 'rsync', ['-rtvu', '--delete', PackagePath, TFullFPCInstallationSetup.GetCurrentTestBasePackagesPath+APackageName], 'sync template');
 end;
 end;
 
 
 procedure TFullFPCInstallationTests.SetUp;
 procedure TFullFPCInstallationTests.SetUp;
@@ -444,6 +457,23 @@ begin
   RunTestCommandIndir(ConcatPaths([TFullFPCInstallationSetup.GetCurrentTestBasePackagesPath,'packageb']), ConcatPaths([TFullFPCInstallationSetup.GetCurrentTestBasePackagesPath,'packageb', 'fpmake']), ['build', '--nofpccfg', '--compiler='+CompilerStr, '--searchpath='+FpcSearchpath, '--searchpath='+PackageSearchpath], 'build packagea');
   RunTestCommandIndir(ConcatPaths([TFullFPCInstallationSetup.GetCurrentTestBasePackagesPath,'packageb']), ConcatPaths([TFullFPCInstallationSetup.GetCurrentTestBasePackagesPath,'packageb', 'fpmake']), ['build', '--nofpccfg', '--compiler='+CompilerStr, '--searchpath='+FpcSearchpath, '--searchpath='+PackageSearchpath], 'build packagea');
 end;
 end;
 
 
+procedure TFullFPCInstallationTests.TestTransmitOptions;
+begin
+  // Test the TransmitOptions settings. PackageA contain some TransmitOptions,
+  // without which the other packages won't compile.
+  // PackageC depends on both PackageB's, but should only add the TransmitOptions
+  // from PackageA once.
+  TFullFPCInstallationSetup.SyncPackageIntoCurrentTest('packagea', 'transmitoptions');
+  TFullFPCInstallationSetup.SyncPackageIntoCurrentTest('packageb1', 'transmitoptions');
+  TFullFPCInstallationSetup.SyncPackageIntoCurrentTest('packageb2', 'transmitoptions');
+  TFullFPCInstallationSetup.SyncPackageIntoCurrentTest('packagec', 'transmitoptions');
+
+  RunFppkgIndir(TFullFPCInstallationSetup.GetCurrentTestBasePackagesPath + 'packagea', ['install'], 'build PackageA');
+  RunFppkgIndir(TFullFPCInstallationSetup.GetCurrentTestBasePackagesPath + 'packageb1', ['install'], 'build PackageB1');
+  RunFppkgIndir(TFullFPCInstallationSetup.GetCurrentTestBasePackagesPath + 'packageb2', ['install'], 'build PackageB2');
+  RunFppkgIndir(TFullFPCInstallationSetup.GetCurrentTestBasePackagesPath + 'packagec', ['install'], 'build PackageC');
+end;
+
 Initialization
 Initialization
   RegisterTestDecorator(TFullFPCInstallationSetup, TFullFPCInstallationTests);
   RegisterTestDecorator(TFullFPCInstallationSetup, TFullFPCInstallationTests);
 end.
 end.

+ 28 - 0
packages/fppkg/tests/packages/specific/transmitoptions/packagea/fpmake.pp

@@ -0,0 +1,28 @@
+{$mode objfpc}{$H+}
+program fpmake;
+
+uses fpmkunit;
+
+Var
+  P : TPackage;
+  T : TTarget;
+begin
+  With Installer do
+    begin
+    P:=AddPackage('packagea');
+    P.Version:='1.2.3';
+
+    P.Author := 'Joost vam der Sluis';
+    P.License := 'GPL';
+    P.HomepageURL := 'www.freepascal.org';
+    P.Email := '';
+    P.Description := 'Transmit-options test-package';
+ 
+    P.SourcePath.Add('src');
+    P.TransmitOptions.Add('-dPackageA');
+    P.TransmitOptions.Add('-FaPackageAUnitA');
+
+    T:=P.Targets.AddUnit('PackageAUnitA.pas');
+    Run;
+    end;
+end.

+ 16 - 0
packages/fppkg/tests/packages/specific/transmitoptions/packagea/src/PackageAUnitA.pas

@@ -0,0 +1,16 @@
+Unit PackageAUnitA;
+
+{$mode objfpc}{$H+}
+
+interface
+
+function PackageAUnitAFunctionA: Boolean;
+
+implementation
+
+function PackageAUnitAFunctionA: Boolean;
+begin
+  Result := True;
+end;
+
+end.

+ 28 - 0
packages/fppkg/tests/packages/specific/transmitoptions/packageb1/fpmake.pp

@@ -0,0 +1,28 @@
+{$mode objfpc}{$H+}
+program fpmake;
+
+uses fpmkunit;
+
+Var
+  P : TPackage;
+  T : TTarget;
+begin
+  With Installer do
+    begin
+    P:=AddPackage('packageb1');
+    P.Version:='4.5.6';
+
+    P.Author := 'Joost vam der Sluis';
+    P.License := 'GPL';
+    P.HomepageURL := 'www.freepascal.org';
+    P.Email := '';
+    P.Description := 'Transmit-options test-package that depends on PackageA';
+
+    P.Dependencies.Add('packagea');
+
+    P.SourcePath.Add('src');
+ 
+    T:=P.Targets.AddUnit('PackageB1UnitB.pas');
+    Run;
+    end;
+end.

+ 23 - 0
packages/fppkg/tests/packages/specific/transmitoptions/packageb1/src/PackageB1UnitB.pas

@@ -0,0 +1,23 @@
+Unit PackageB1UnitB;
+
+{$mode objfpc}{$H+}
+
+{$ifndef PackageA}
+{$fatal PackageA is not defined - The transmit-options are not in order}
+{$endif}
+
+interface
+
+uses 
+  PackageAUnitA;
+
+function PackageB1UnitBFunctionB: Boolean;
+
+implementation
+
+function PackageB1UnitBFunctionB: Boolean;
+begin
+  Result := PackageAUnitAFunctionA;
+end;
+
+end.

+ 28 - 0
packages/fppkg/tests/packages/specific/transmitoptions/packageb2/fpmake.pp

@@ -0,0 +1,28 @@
+{$mode objfpc}{$H+}
+program fpmake;
+
+uses fpmkunit;
+
+Var
+  P : TPackage;
+  T : TTarget;
+begin
+  With Installer do
+    begin
+    P:=AddPackage('packageb2');
+    P.Version:='4.5.6';
+
+    P.Author := 'Joost vam der Sluis';
+    P.License := 'GPL';
+    P.HomepageURL := 'www.freepascal.org';
+    P.Email := '';
+    P.Description := 'Another transmit-options test-package that depends on PackageA';
+
+    P.Dependencies.Add('packagea');
+
+    P.SourcePath.Add('src');
+ 
+    T:=P.Targets.AddUnit('PackageB2UnitB.pas');
+    Run;
+    end;
+end.

+ 23 - 0
packages/fppkg/tests/packages/specific/transmitoptions/packageb2/src/PackageB2UnitB.pas

@@ -0,0 +1,23 @@
+Unit PackageB2UnitB;
+
+{$mode objfpc}{$H+}
+
+interface
+
+{$ifndef PackageA}
+{$fatal PackageA is not defined - The transmit-options are not in order}
+{$endif}
+
+uses
+  PackageAUnitA;
+
+function PackageB2UnitBFunctionB: Boolean;
+
+implementation
+
+function PackageB2UnitBFunctionB: Boolean;
+begin
+  Result := PackageAUnitAFunctionA;
+end;
+
+end.

+ 32 - 0
packages/fppkg/tests/packages/specific/transmitoptions/packagec/fpmake.pp

@@ -0,0 +1,32 @@
+{$mode objfpc}{$H+}
+program fpmake;
+
+uses fpmkunit;
+
+Var
+  P : TPackage;
+  T : TTarget;
+
+{$R *.res}
+
+begin
+  With Installer do
+    begin
+    P:=AddPackage('packagec');
+    P.Version:='4.5.6';
+
+    P.Author := 'Joost vam der Sluis';
+    P.License := 'GPL';
+    P.HomepageURL := 'www.freepascal.org';
+    P.Email := '';
+    P.Description := 'Transmit-options test-package that depends on PackageB1 and PackageB2';
+
+    P.Dependencies.Add('packageb1');
+    P.Dependencies.Add('packageb2');
+
+    P.SourcePath.Add('src');
+ 
+    T:=P.Targets.AddProgram('PackageC.pas');
+    Run;
+    end;
+end.

+ 14 - 0
packages/fppkg/tests/packages/specific/transmitoptions/packagec/src/PackageC.pas

@@ -0,0 +1,14 @@
+Program PackageC;
+
+{$mode objfpc}{$H+}
+
+{$ifndef PackageA}
+{$fatal PackageA is not defined - The transmit-options are not in order}
+{$endif}
+
+var
+  B: Boolean;
+
+begin
+  B := PackageAUnitAFunctionA;
+end.