paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-23 03:29:41 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
(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
1 changed files with 59 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

83
packages/fpmkunit/src/fpmkunit.pp
View File

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