paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-05 07:53:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

ide: do not load preferred package dependency if old package is locked

Browse Source
This commit is contained in:
mattias 2024-09-13 15:08:25 +02:00
parent 10f44cfcff
commit 300b09287a
4 changed files with 241 additions and 169 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
ide/lazbuild.lpr
View File

@ -517,7 +517,7 @@ begin
// check if package is already loaded
Result:=PackageGraph.FindPackageWithFilename(AFilename);
if (Result<>nil) then exit;
if not FileExistsUTF8(AFilename) then
if not FileExists(AFilename) then
PrintErrorAndHalt(ErrorLoadPackageFailed, 'Package file not found: "' + AFilename + '"');
Result:=TLazPackage.Create;
@ -533,8 +533,13 @@ begin
if not IsValidPkgName(Result.Name) then
PrintErrorAndHalt(ErrorPackageNameInvalid,
Format(lisPkgMangThePackageNameOfTheFileIsInvalid, [Result.Name, LineEnding, Result.Filename]));
// check if Package with same name is already loaded
ConflictPkg:=PackageGraph.FindPackageWithName(Result.Name,nil);
if not PackageGraph.PackageCanBeReplaced(ConflictPkg,Result) then
PrintErrorAndHalt(ErrorLoadPackageFailed,
'Cannot replace loaded package '+ConflictPkg.IDAsString+' with '+Result.IDAsString+' from "'+Result.Filename+'"');
if ConflictPkg<>nil then begin
// replace package
PackageGraph.ReplacePackage(ConflictPkg,Result);

59
ide/packages/idepackager/packagedefs.pas
View File

@ -546,7 +546,7 @@ type
FStorePathDelim: TPathDelimSwitch;
FTopologicalLevel: integer;
FTranslated: string;
FUpdateLock: integer;
FUpdateLocks: TStringArray;
FUsageOptions: TPkgAdditionalCompilerOptions;
FUserIgnoreChangeStamp: integer;
FUserReadOnly: boolean;
@ -613,8 +613,10 @@ type
procedure BackupOptions;
procedure RestoreOptions;
// modified
procedure BeginUpdate;
procedure EndUpdate;
procedure BeginUpdate(const Reference: string);
procedure EndUpdate(const Reference: string);
function IsUpdateLocked: boolean;
procedure WriteUpdateLocks(const Prefix: string);
procedure LockModified;
procedure UnlockModified;
function ReadOnly: boolean; override;
@ -2676,6 +2678,11 @@ destructor TLazPackage.Destroy;
var
pod: TPkgOutputDir;
begin
if IsUpdateLocked then
begin
WriteUpdateLocks('TLazPackage.Destroy');
raise Exception.Create('TLazPackage.Destroy 20240913140628');
end;
Include(FFlags,lpfDestroying);
Clear;
for pod in TPkgOutputDir do
@ -2712,21 +2719,50 @@ begin
CompilerOptions.Modified:=FOptionsBackup.CompilerOptions.Modified;
end;
procedure TLazPackage.BeginUpdate;
procedure TLazPackage.BeginUpdate(const Reference: string);
begin
inc(FUpdateLock);
Insert(Reference,FUpdateLocks,length(FUpdateLocks));
FDefineTemplates.BeginUpdate;
FSourceDirectories.BeginUpdate;
end;
procedure TLazPackage.EndUpdate;
procedure TLazPackage.EndUpdate(const Reference: string);
var
l: SizeInt;
begin
if FUpdateLock=0 then RaiseGDBException('TLazPackage.EndUpdate');
dec(FUpdateLock);
l:=length(FUpdateLocks);
if l=0 then
raise Exception.Create('Error: (lazarus) TLazPackage.EndUpdate 20240913135959');
dec(l);
if FUpdateLocks[l]<>Reference then
begin
WriteUpdateLocks('TLazPackage.EndUpdate');
debugln(['Error: (lazarus) TLazPackage.EndUpdate cannot remove reference "'+Reference+'"']);
raise Exception.Create('TLazPackage.EndUpdate 20240913140039 cannot remove reference "'+Reference+'"');
end;
SetLength(FUpdateLocks,l);
FDefineTemplates.EndUpdate;
FSourceDirectories.EndUpdate;
end;
function TLazPackage.IsUpdateLocked: boolean;
begin
Result:=length(FUpdateLocks)>0;
end;
procedure TLazPackage.WriteUpdateLocks(const Prefix: string);
var
l, i: Integer;
begin
l:=length(FUpdateLocks);
if l=0 then
debugln(['TLazPackage.WriteUpdateLocks ',Prefix,' ',IDAsString,' not locked'])
else
for i:=0 to l-1 do
debugln(['Info: (lazarus) ',Prefix,' '+IDAsString+' UpdateLocks[',i,']="',FUpdateLocks[i],'"']);
end;
procedure TLazPackage.Clear;
var
i: Integer;
@ -2903,7 +2939,8 @@ begin
Flags:=Flags+[lpfLoading];
FileVersion:=XMLConfig.GetValue(Path+'Version',0);
OldFilename:=Filename;
BeginUpdate;
BeginUpdate('TLazPackage.LoadFromXMLConfig');
try
Clear;
Filename:=OldFilename;
LockModified;
@ -2961,8 +2998,10 @@ begin
finally
Config.Free;
end;
finally
EndUpdate('TLazPackage.LoadFromXMLConfig');
end;
EndUpdate;
Modified:=false;
UnlockModified;
Flags:=Flags-[lpfLoading];

53
ide/packages/idepackager/packagesystem.pas
View File

@ -1047,7 +1047,7 @@ begin
PkgLink.LPKFileDateValid:=true;
XMLConfig:=TXMLConfig.Create(nil);
NewPackage:=TLazPackage.Create;
NewPackage.BeginUpdate;
NewPackage.BeginUpdate('TLazPackageGraph.OpenDependencyWithPackageLink');
NewPackage.Filename:=AFilename;
NewPackage.OnModifySilently := @PkgModify;
Result:=LoadXMLConfigFromCodeBuffer(AFilename,XMLConfig,
@ -1069,20 +1069,27 @@ begin
DebugLn('Error: (lazarus) package file "'+AFilename+'" and name "'+NewPackage.Name+'" mismatch.');
exit(mrCancel);
end;
OldPackage:=FindPackageWithName(NewPackage.Name,NewPackage);
if (OldPackage<>nil) and not PackageCanBeReplaced(OldPackage,NewPackage) then
begin
debugln('Error: (lazarus) Open dependency ['+Dependency.PackageName+']: Failed to replace "'+OldPackage.Filename+'" with "'+NewPackage.Filename+'"');
CTDumpStack;
exit(mrCancel);
end;
// ok
if pvPkgSearch in Verbosity then
debugln('Info: (lazarus) Open dependency ['+Dependency.PackageName+']: Success: "'+NewPackage.Filename+'"');
debugln('Info: (lazarus) Open dependency ['+Dependency.PackageName+']: Successfully loaded "'+NewPackage.Filename+'"');
Result:=mrOk;
Dependency.RequiredPackage:=NewPackage;
Dependency.LoadPackageResult:=lprSuccess;
OldPackage:=FindPackageWithName(NewPackage.Name,NewPackage);
if OldPackage=nil then
AddPackage(NewPackage)
else
ReplacePackage(OldPackage,NewPackage);
finally
if Assigned(NewPackage) then
NewPackage.EndUpdate;
NewPackage.EndUpdate('TLazPackageGraph.OpenDependencyWithPackageLink');
if Result<>mrOk then
NewPackage.Free;
EndUpdate;
@ -2200,6 +2207,8 @@ begin
FTree.Add(APackage);
FItems.Add(APackage);
APackage.BeginUpdate('TLazPackageGraph.AddPackage');
try
if IsCompiledInBasePackage(APackage.Name) then begin
APackage.Installed:=pitStatic;
APackage.AutoInstall:=pitStatic;
@ -2254,7 +2263,8 @@ begin
// open all required dependencies
Dependency:=APackage.FirstRequiredDependency;
while Dependency<>nil do begin
OpenDependency(Dependency,false);
if OpenDependency(Dependency,false)<>lprSuccess then
debugln(['Warning: (lazarus) TLazPackageGraph.AddPackage failed to open: ',Dependency.AsString(true,false)]);
Dependency:=Dependency.NextRequiresDependency;
end;
@ -2262,13 +2272,12 @@ begin
UpdateBrokenDependenciesToPackage(APackage);
// activate define templates
if Assigned(APackage.DefineTemplates) then
APackage.DefineTemplates.Active:=true
else // By Juha:
// Happened when an old package with the same name was replaced. Cannot reproduce.
DebugLn(['TLazPackageGraph.AddPackage: APackage.DefineTemplates=Nil']);
APackage.DefineTemplates.Active:=true;
if Assigned(OnAddPackage) then
OnAddPackage(APackage);
finally
APackage.EndUpdate('TLazPackageGraph.AddPackage');
end;
EndUpdate;
end;
@ -2305,6 +2314,11 @@ var
begin
if pvPkgSearch in Verbosity then
debugln(['Info: (lazarus) replacing package "'+OldPackage.Filename+'" with "'+NewPackage.Filename+'"']);
if OldPackage.IsUpdateLocked then
begin
OldPackage.WriteUpdateLocks('TLazPackageGraph.ReplacePackage');
raise Exception.Create('20240913140848');
end;
BeginUpdate(true);
// save flags
OldInstalled:=OldPackage.Installed;
@ -6010,6 +6024,13 @@ begin
if SysUtils.CompareText(OldPackage.Name,NewPackage.Name)<>0 then
RaiseGDBException('TLazPackageGraph.PackageCanBeReplaced');
if OldPackage.IsUpdateLocked then
begin
OldPackage.WriteUpdateLocks('TLazPackageGraph.PackageCanBeReplaced Old');
debugln(['Error: (lazarus) TLazPackageGraph.PackageCanBeReplaced ',OldPackage.IDAsString,' IsUpdateLocked']);
exit(false);
end;
Result:=true;
end;
@ -6159,8 +6180,9 @@ begin
//debugln(['TLazPackageGraph.OpenDependency checking preferred Prefer=',PreferredFilename]);
if (PreferredFilename<>'')
and ((Dependency.RequiredPackage=nil)
or ((Dependency.RequiredPackage.FindUsedByDepPrefer(Dependency)=nil)
and (CompareFilenames(PreferredFilename,Dependency.RequiredPackage.Filename)<>0)))
or ((not Dependency.RequiredPackage.IsUpdateLocked)
and (CompareFilenames(PreferredFilename,Dependency.RequiredPackage.Filename)<>0))
and (Dependency.RequiredPackage.FindUsedByDepPrefer(Dependency)=nil) )
then begin
if pvPkgSearch in Verbosity then
debugln(['Info: (lazarus) Open dependency ['+Dependency.PackageName+']: trying resolved preferred filename: "'+PreferredFilename+'" ...']);
@ -6402,7 +6424,8 @@ begin
// -> create a broken package
BrokenPackage:=TLazPackage.CreateAndClear;
with BrokenPackage do begin
BeginUpdate;
BeginUpdate('TLazPackageGraph.OpenInstalledDependency');
try
Missing:=true;
UserReadOnly:=true;
Name:=Dependency.PackageName;
@ -6426,7 +6449,9 @@ begin
Modified:=false;
OnModifySilently:=@PkgModify;
EndUpdate;
finally
EndUpdate('TLazPackageGraph.OpenInstalledDependency');
end;
end;
AddPackage(BrokenPackage);
//DebugLn('TLazPackageGraph.OpenInstalledDependency ',BrokenPackage.IDAsString,' ',dbgs(ord(BrokenPackage.AutoInstall)));

7
packager/addfiletoapackagedlg.pas
View File

@ -146,7 +146,8 @@ begin
end;
// ok -> add file to package
APackage.BeginUpdate;
APackage.BeginUpdate('TAddFileToAPackageDialog.OkButtonClick');
try
NewUnitPaths:='';
NewIncPaths:='';
APackage.AddFileByName(aFilename, NewUnitPaths, NewIncPaths);
@ -154,7 +155,9 @@ begin
if not APackage.ExtendUnitSearchPath(NewUnitPaths) then exit;
if not APackage.ExtendIncSearchPath(NewIncPaths) then exit;
if APackage.Editor<>nil then APackage.Editor.UpdateAll(true);
APackage.EndUpdate;
finally
APackage.EndUpdate('TAddFileToAPackageDialog.OkButtonClick');
end;
ModalResult:=mrOk;
finally