* fixed dataraces in setting the UnitDir/UnitConfigDir fields of TPackage

(could be resolved by multiple other packages at the same time)
    (mantis #37725)
  * made some "array of const" parameters "const"
  * fixed removing the extra variables again in TDictionary.Substitute

git-svn-id: trunk@46857 -
This commit is contained in:
Jonas Maebe 2020-09-12 19:05:36 +00:00
parent 2f21f5ae93
commit 8616338374

View File

@ -488,7 +488,7 @@ Type
Function GetValue(AName : String) : String; Function GetValue(AName : String) : String;
Function GetValue(const AName,Args : String) : String; virtual; Function GetValue(const AName,Args : String) : String; virtual;
Function ReplaceStrings(Const ASource : String; Const MaxDepth: Integer = 10) : String; virtual; Function ReplaceStrings(Const ASource : String; Const MaxDepth: Integer = 10) : String; virtual;
Function Substitute(Const Source : String; Macros : Array of string) : String; virtual; Function Substitute(Const Source : String; const Macros : Array of string) : String; virtual;
end; end;
{ TPackageDictionary } { TPackageDictionary }
@ -855,6 +855,9 @@ Type
// Is set when all sourcefiles are found // Is set when all sourcefiles are found
FAllFilesResolved: boolean; FAllFilesResolved: boolean;
FPackageVariants: TFPList; FPackageVariants: TFPList;
{$ifndef NO_THREADING}
FResolveDirsCS: TRTLCriticalSection;
{$endif}
Function GetDescription : string; Function GetDescription : string;
function GetDictionary: TDictionary; function GetDictionary: TDictionary;
Function GetFileName : string; Function GetFileName : string;
@ -894,6 +897,8 @@ Type
procedure SetDefaultPackageVariant; procedure SetDefaultPackageVariant;
procedure LoadUnitConfigFromFile(Const AFileName: String); procedure LoadUnitConfigFromFile(Const AFileName: String);
procedure SaveUnitConfigToFile(Const AFileName: String;ACPU:TCPU;AOS:TOS); procedure SaveUnitConfigToFile(Const AFileName: String;ACPU:TCPU;AOS:TOS);
procedure EnterResolveDirsCS;
procedure LeaveResolveDirsCS;
Property Version : String Read GetVersion Write SetVersion; Property Version : String Read GetVersion Write SetVersion;
Property FileName : String Read GetFileName Write FFileName; Property FileName : String Read GetFileName Write FFileName;
Property ShortName : String Read GetShortName Write FShortName; Property ShortName : String Read GetShortName Write FShortName;
@ -1304,9 +1309,9 @@ Type
Procedure CheckPackages; virtual; Procedure CheckPackages; virtual;
Procedure CreateBuildEngine; virtual; Procedure CreateBuildEngine; virtual;
Procedure Error(const Msg : String); Procedure Error(const Msg : String);
Procedure Error(const Fmt : String; Args : Array of const); Procedure Error(const Fmt : String; const Args : Array of const);
Procedure AnalyzeOptions; Procedure AnalyzeOptions;
Procedure Usage(const FMT : String; Args : Array of const); Procedure Usage(const FMT : String; const Args : Array of const);
Procedure Compile(Force : Boolean); virtual; Procedure Compile(Force : Boolean); virtual;
Procedure Clean(AllTargets: boolean); virtual; Procedure Clean(AllTargets: boolean); virtual;
Procedure Install(ForceBuild : Boolean); virtual; Procedure Install(ForceBuild : Boolean); virtual;
@ -3683,6 +3688,9 @@ begin
// Implicit dependency on RTL // Implicit dependency on RTL
FDependencies.Add('rtl'); FDependencies.Add('rtl');
FSupportBuildModes:=[bmBuildUnit, bmOneByOne]; FSupportBuildModes:=[bmBuildUnit, bmOneByOne];
{$ifndef NO_THREADING}
InitCriticalSection(FResolveDirsCS);
{$endif}
end; end;
@ -3690,6 +3698,9 @@ destructor TPackage.destroy;
var var
i: integer; i: integer;
begin begin
{$ifndef NO_THREADING}
DoneCriticalSection(FResolveDirsCS);
{$endif}
FreeAndNil(FDictionary); FreeAndNil(FDictionary);
FreeAndNil(FDependencies); FreeAndNil(FDependencies);
FreeAndNil(FInstallFiles); FreeAndNil(FInstallFiles);
@ -4316,6 +4327,20 @@ begin
end; end;
end; end;
procedure TPackage.EnterResolveDirsCS;
begin
{$ifndef NO_THREADING}
EnterCriticalSection(FResolveDirsCS);
{$endif}
end;
procedure TPackage.LeaveResolveDirsCS;
begin
{$ifndef NO_THREADING}
LeaveCriticalSection(FResolveDirsCS);
{$endif}
end;
{**************************************************************************** {****************************************************************************
@ -5040,7 +5065,7 @@ begin
end; end;
procedure TCustomInstaller.Error(const Fmt: String; Args: array of const); procedure TCustomInstaller.Error(const Fmt: String; const Args: array of const);
begin begin
Raise EInstallerError.CreateFmt(Fmt,Args); Raise EInstallerError.CreateFmt(Fmt,Args);
end; end;
@ -5377,7 +5402,7 @@ begin
end; end;
procedure TCustomInstaller.Usage(const FMT: String; Args: array of const); procedure TCustomInstaller.Usage(const FMT: String; const Args: array of const);
Procedure LogCmd(const LC,Msg : String); Procedure LogCmd(const LC,Msg : String);
begin begin
@ -6602,27 +6627,36 @@ var
i: Integer; i: Integer;
Continue: Boolean; Continue: Boolean;
begin begin
if APackage.UnitDir='' then {$ifndef NO_THREADING}
begin APackage.EnterResolveDirsCS;
Log(vldebug, SDbgSearchExtDepPath, [APackage.Name]); try
GetPluginManager.BeforeResolvePackagePath(Self, APackage, Continue); {$endif}
if Continue then if APackage.UnitDir='' then
begin begin
for I := 0 to Defaults.SearchPath.Count-1 do Log(vldebug, SDbgSearchExtDepPath, [APackage.Name]);
GetPluginManager.BeforeResolvePackagePath(Self, APackage, Continue);
if Continue then
begin begin
if Defaults.SearchPath[i]<>'' then for I := 0 to Defaults.SearchPath.Count-1 do
GetPluginManager.ResolvePackagePath(Self, APackage, Defaults.SearchPath[i], Continue); begin
if not Continue then if Defaults.SearchPath[i]<>'' then
Break GetPluginManager.ResolvePackagePath(Self, APackage, Defaults.SearchPath[i], Continue);
if not Continue then
Break
end;
if Continue then
GetPluginManager.AfterResolvePackagePath(Self, APackage, Continue);
end; end;
if Continue then if APackage.UnitDir = '' then
GetPluginManager.AfterResolvePackagePath(Self, APackage, Continue); APackage.UnitDir := DirNotFound
end; end;
{$ifndef NO_THREADING}
if APackage.UnitDir = '' then finally
APackage.UnitDir := DirNotFound APackage.LeaveResolveDirsCS;
end; end;
{$endif}
end; end;
@ -9488,7 +9522,7 @@ begin
end; end;
Function TDictionary.Substitute(Const Source : String; Macros : Array of string) : String; Function TDictionary.Substitute(Const Source : String; const Macros : Array of string) : String;
Var Var
I : Integer; I : Integer;
begin begin
@ -9499,6 +9533,7 @@ begin
Inc(I,2); Inc(I,2);
end; end;
Result:=ReplaceStrings(Source); Result:=ReplaceStrings(Source);
I:=0;
While I<High(Macros) do While I<High(Macros) do
begin begin
RemoveItem(Macros[i]); RemoveItem(Macros[i]);