IDE: started checking base packages and on mismatch building IDE using lazbuild

This commit is contained in:
mattias 2023-03-19 13:16:03 +01:00
parent 6cebac6b7b
commit 575dbd75de
7 changed files with 229 additions and 34 deletions

View File

@ -200,8 +200,10 @@ type
function ShowConfigBuildLazDlg(AProfiles: TBuildLazarusProfiles;
ADisableCompilation: Boolean): TModalResult;
function MakeLazarus(Profile: TBuildLazarusProfile; Flags: TBuildLazarusFlags): TModalResult;
function MakeIDEUsingLazbuild(Clean: boolean): TModalResult;
function IsWriteProtected(Profile: TBuildLazarusProfile): Boolean;
function SaveIDEMakeOptions(Profile: TBuildLazarusProfile; Flags: TBuildLazarusFlags): TModalResult;
function SearchMakeExe(Interactive: boolean): string;
public
property PackageOptions: string read fPackageOptions write fPackageOptions;
property ProfileChanged: boolean read fProfileChanged write fProfileChanged;
@ -455,18 +457,7 @@ begin
if s<>'' then
EnvironmentOverrides.Values['PP']:=s;
Executable:=EnvironmentOptions.GetParsedMakeFilename;
if (Executable<>'') and (not FileExistsUTF8(Executable)) then
Executable:=FindDefaultExecutablePath(Executable);
if (Executable='') or (not FileExistsUTF8(Executable)) then begin
Executable:=FindDefaultMakePath;
if (Executable='') or (not FileExistsUTF8(Executable)) then begin
IDEMessageDialog(lisMakeNotFound,
Format(lisTheProgramMakeWasNotFoundThisToolIsNeededToBuildLa, [LineEnding]),
mtError, [mbCancel]);
exit;
end;
end;
Executable:=SearchMakeExe(true);
// add -w option to print leaving/entering messages of "make"
AddCmdLineParam('-w',false);
@ -564,6 +555,99 @@ begin
end;
end;
function TLazarusBuilder.MakeIDEUsingLazbuild(Clean: boolean): TModalResult;
var
s, MakeExe, LazbuildExe: String;
Tool: TAbstractExternalTool;
EnvironmentOverrides: TStringList;
begin
Result:=mrCancel;
EnvironmentOverrides:=TStringList.Create;
try
EnvironmentOverrides.Values['LANG']:= 'en_US';
s:=EnvironmentOptions.GetParsedCompilerFilename;
if s<>'' then
EnvironmentOverrides.Values['PP']:=s;
MakeExe:=SearchMakeExe(true);
fWorkingDir:=EnvironmentOptions.GetParsedLazarusDirectory;
if not CheckDirectoryWritable(fWorkingDir) then
exit;
// clean up
if Clean then
begin
Tool:=ExternalToolList.Add('make distclean');
Tool.Reference(Self,ClassName);
try
Tool.Data:=TIDEExternalToolData.Create(IDEToolCompileIDE,'make distclean',
MakeExe);
Tool.FreeData:=true;
Tool.Process.Executable:=MakeExe;
Tool.Process.Parameters.Add('distclean');
Tool.Process.CurrentDirectory:=fWorkingDir;
Tool.AddParsers(SubToolMake);
Tool.EnvironmentOverrides:=EnvironmentOverrides;
Tool.Execute;
Tool.WaitForExit;
if Tool.ErrorMessage<>'' then
exit(mrCancel);
finally
Tool.Release(Self);
end;
end;
// build lazbuild
Tool:=ExternalToolList.Add('make lazbuild');
Tool.Reference(Self,ClassName);
try
Tool.Data:=TIDEExternalToolData.Create(IDEToolCompileIDE,'make lazbuild',
MakeExe);
Tool.FreeData:=true;
Tool.Process.Executable:=MakeExe;
Tool.Process.Parameters.Add('lazbuild');
Tool.AddParsers(SubToolFPC);
Tool.AddParsers(SubToolMake);
Tool.Process.CurrentDirectory:=fWorkingDir;
Tool.EnvironmentOverrides:=EnvironmentOverrides;
Tool.Execute;
Tool.WaitForExit;
if Tool.ErrorMessage<>'' then
exit(mrCancel);
finally
Tool.Release(Self);
end;
// build the IDE using lazbuild
LazbuildExe:=AppendPathDelim(fWorkingDir)+'lazbuild'+GetExeExt;
Tool:=ExternalToolList.Add('lazbuild --useride=');
Tool.Reference(Self,ClassName);
try
Tool.Data:=TIDEExternalToolData.Create(IDEToolCompileIDE,'lazbuild --user-ide=',
MakeExe);
Tool.FreeData:=true;
Tool.Process.Executable:=LazbuildExe;
Tool.Process.Parameters.Add('--user-ide=');
Tool.Process.Parameters.Add('--lazarusdir=.');
Tool.Process.Parameters.Add('--pcp='+GetPrimaryConfigPath);
Tool.AddParsers(SubToolFPC);
Tool.AddParsers(SubToolMake);
Tool.Process.CurrentDirectory:=fWorkingDir;
Tool.EnvironmentOverrides:=EnvironmentOverrides;
Tool.Execute;
Tool.WaitForExit;
if Tool.ErrorMessage<>'' then
exit(mrCancel);
finally
Tool.Release(Self);
end;
finally
EnvironmentOverrides.Free;
end;
end;
procedure TLazarusBuilder.SpecialIdeConfig;
var
MakeIDECfgFilename: string;
@ -998,6 +1082,25 @@ begin
Result:=mrOk;
end;
function TLazarusBuilder.SearchMakeExe(Interactive: boolean): string;
begin
Result:=EnvironmentOptions.GetParsedMakeFilename;
if (Result<>'') and (not FileExistsUTF8(Result)) then
Result:=FindDefaultExecutablePath(Result);
if (Result='') or (not FileExistsUTF8(Result)) then begin
Result:=FindDefaultMakePath;
if (Result='') or (not FileExistsUTF8(Result)) then begin
Result:='';
if not Interactive then
exit;
IDEMessageDialog(lisMakeNotFound,
Format(lisTheProgramMakeWasNotFoundThisToolIsNeededToBuildLa, [LineEnding]),
mtError, [mbCancel]);
exit;
end;
end;
end;
{ TConfigureBuildLazarusDlg }
constructor TConfigureBuildLazarusDlg.Create(TheOwner: TComponent);

View File

@ -609,6 +609,7 @@
<Unit>
<Filename Value="../packager/lpkcache.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="LPKCache"/>
</Unit>
<Unit>
<Filename Value="frames/editor_general_options.pas"/>

View File

@ -7837,6 +7837,10 @@ var
PkgCompileFlags: TPkgCompileFlags;
OldToolStatus: TIDEToolStatus;
CompilerKind: TPascalCompiler;
{$IFDEF EnableBuildIDEUsingLazbuild}
ErrMsg: String;
r: integer;
{$ENDIF}
begin
if ToolStatus<>itNone then begin
IDEMessageDialog(lisNotNow,lisYouCanNotBuildLazarusWhileDebuggingOrCompiling,
@ -7883,7 +7887,27 @@ begin
end;
MainBuildBoss.SetBuildTargetIDE;
PackageGraph.ParseBasePackages;
{$IFDEF EnableBuildIDEUsingLazbuild}
ErrMsg:=PackageGraph.SrcBasePackagesNeedLazbuild;
if ErrMsg<>'' then
begin
r:=IDEQuestionDialog('Major changes detected',
'The Lazarus sources use a different list of base packages.'+LineEnding
+'It is recommended to compile the IDE clean using lazbuild.',
mtConfirmation,[mrYes,'Clean up + lazbuild',21,'No clean up + lazbuild',mrIgnore,'Compile normally',mrCancel]);
case r of
mrYes:
exit(fBuilder.MakeIDEUsingLazbuild(true));
21:
exit(fBuilder.MakeIDEUsingLazbuild(false));
mrIgnore: ;
else
exit;
end;
end;
{$ELSE}
PackageGraph.ParseBasePackages(false);
{$ENDIF}
// clean up
PkgCompileFlags:=[];

View File

@ -1155,7 +1155,7 @@ procedure TInstallPkgSetDialog.AddToUninstall;
APackage:=PackageGraph.FindPackageWithID(aPackageID);
if APackage<>nil then begin
// check if package is a base package
if PackageGraph.IsStaticBasePackage(APackage.Name) then begin
if PackageGraph.IsCompiledInBasePackage(APackage.Name) then begin
MessageDlg(lisUninstallImpossible,
Format(lisThePackageCanNotBeUninstalledBecauseItIsNeededByTh, [
APackage.Name]), mtError, [mbCancel], 0);

View File

@ -242,7 +242,7 @@ begin
Info.LPKFilename:=CurFilename;
Info.InLazSrc:=FileIsInPath(Info.LPKFilename,
EnvironmentOptions.GetParsedLazarusDirectory);
Info.Base:=Info.InLazSrc and PackageGraph.IsStaticBasePackage(Info.ID.Name);
Info.Base:=Info.InLazSrc and PackageGraph.IsCompiledInBasePackage(Info.ID.Name);
Pkg:=PackageGraph.FindPackageWithFilename(Info.LPKFilename);
if Pkg<>nil then
Info.Installed:=Pkg.Installed;

View File

@ -430,14 +430,15 @@ type
public
// installed packages
FirstAutoInstallDependency: TPkgDependency;
function ParseBasePackages: boolean; // read list from current sources
function ParseBasePackages(Verbose: boolean): boolean; // read list from current sources
function SrcBasePackagesNeedLazbuild: string; // check if compiled-in and source base pkg list differ that a built using make is needed
procedure LoadStaticBasePackages;
procedure LoadAutoInstallPackages(PkgList: TStringList);
procedure SortAutoInstallDependencies;
function GetIDEInstallPackageOptions(
var InheritedOptionStrings: TInheritedCompOptsStrings): string;
function SaveAutoInstallConfig: TModalResult;// for the uses section
function IsStaticBasePackage(PackageName: string): boolean;
function IsCompiledInBasePackage(PackageName: string): boolean;
procedure FreeAutoInstallDependencies;
public
// registration
@ -476,6 +477,7 @@ type
property Verbosity: TPkgVerbosityFlags read FVerbosity write FVerbosity;
// base packages
property SrcBasePackages: TStringListUTF8Fast read FSrcBasePackages;
property FCLPackage: TLazPackage read FFCLPackage;
property LCLBasePackage: TLazPackage read FLCLBasePackage;
property LCLPackage: TLazPackage read FLCLPackage;
@ -2123,7 +2125,7 @@ begin
FTree.Add(APackage);
FItems.Add(APackage);
if IsStaticBasePackage(APackage.Name) then begin
if IsCompiledInBasePackage(APackage.Name) then begin
APackage.Installed:=pitStatic;
APackage.AutoInstall:=pitStatic;
if SysUtils.CompareText(APackage.Name,'FCL')=0 then begin
@ -2375,7 +2377,7 @@ begin
APackage:=TLazPackage(PkgList[i]);
if (APackage=nil)
or APackage.Missing
or IsStaticBasePackage(APackage.Name)
or IsCompiledInBasePackage(APackage.Name)
or (APackage.PackageType in [lptRunTime,lptRunTimeOnly])
then continue;
@ -2398,7 +2400,7 @@ begin
lisPkgMangstaticPackagesConfigFile);
end;
function TLazPackageGraph.IsStaticBasePackage(PackageName: string): boolean;
function TLazPackageGraph.IsCompiledInBasePackage(PackageName: string): boolean;
var
bp: TLazarusIDEBasePkg;
begin
@ -5119,18 +5121,34 @@ begin
Result:=mrOk;
end;
function TLazPackageGraph.ParseBasePackages: boolean;
function TLazPackageGraph.ParseBasePackages(Verbose: boolean): boolean;
var
LazDir, SrcFilename, Atom, PkgName: String;
Code: TCodeBuffer;
p, AtomStart: integer;
begin
Result:=false;
LazDir:=EnvironmentOptions.GetParsedLazarusDirectory;
if LazDir='' then exit;
if (LazDir='') or not FilenameIsPascalSource(LazDir) then
begin
if Verbose then
debugln(['Error: (lazarus) TLazPackageGraph.ParseBasePackages missing LazarusDir "',LazDir,'"']);
exit;
end;
SrcFilename:=AppendPathDelim(LazDir)+'packager'+PathDelim+'pkgsysbasepkgs.pas';
if not FileExistsCached(SrcFilename) then exit;
if not FileExistsCached(SrcFilename) then
begin
if Verbose then
debugln(['Error: (lazarus) TLazPackageGraph.ParseBasePackages file not found: "',SrcFilename,'"']);
exit;
end;
Code:=CodeToolBoss.LoadFile(SrcFilename,true,false);
if Code=nil then exit;
if Code=nil then
begin
if Verbose then
debugln(['Error: (lazarus) TLazPackageGraph.ParseBasePackages failed to load "',SrcFilename,'"']);
exit;
end;
if (FSrcBasePackagesFilename=SrcFilename)
and (FSrcBasePackagesFileChangeStep=Code.FileChangeStep) then
exit(true); // cache valid
@ -5140,7 +5158,11 @@ begin
FSrcBasePackages.Clear;
if SearchCodeInSource(Code.Source,'LazarusIDEBasePkgNames:',1,p,false)<1 then
begin
if Verbose then
debugln(['Error: (lazarus) TLazPackageGraph.ParseBasePackages failed to find LazarusIDEBasePkgNames in "',SrcFilename,'"']);
exit;
end;
AtomStart:=p;
repeat
Atom:=ReadNextPascalAtom(Code.Source,p,AtomStart);
@ -5152,6 +5174,51 @@ begin
FSrcBasePackages.Add(PkgName);
end;
until false;
Result:=true;
end;
function TLazPackageGraph.SrcBasePackagesNeedLazbuild: string;
var
i: Integer;
PkgName, aFilename: String;
bp: TLazarusIDEBasePkg;
Pkg: TLazPackage;
begin
Result:='';
if not ParseBasePackages(true) then
exit('Unable to parse base package list.');
// check if all source base packages will be installed
for i:=0 to FSrcBasePackages.Count-1 do
begin
PkgName:=FSrcBasePackages[i];
if IsCompiledInBasePackage(PkgName) then
continue;
// new base package
if FindDependencyByNameInList(FirstAutoInstallDependency,pddRequires,PkgName)<>nil
then
exit; // it will be installed anyway -> ok
// the sources need a base package, that this IDE will not install
// -> better use lazbuild for building
exit('Sources need a new base package "'+PkgName+'"');
end;
// check if all compiled-in base packages are also source base packages
for bp in TLazarusIDEBasePkg do
begin
PkgName:=LazarusIDEBasePkgNames[bp];
if FSrcBasePackages.IndexOf(PkgName)>=0 then continue;
// sources do not listen this as base package
Pkg:=FindPackageWithName(PkgName,nil);
if Pkg=nil then continue;
if Pkg.IsVirtual then
exit('Sources do not use "'+PkgName+'" as base package.'); // avoid IDE package check errors and use lazbuild
aFilename:=Pkg.GetResolvedFilename(true);
if aFilename='' then
exit('Sources do not use "'+PkgName+'" as base package.'); // avoid IDE package check errors and use lazbuild
if not FileExistsCached(aFilename) then
exit('Sources do not use "'+PkgName+'" as base package.'); // avoid IDE package check errors and use lazbuild
end;
end;
function TLazPackageGraph.PreparePackageOutputDirectory(APackage: TLazPackage;
@ -5992,7 +6059,7 @@ begin
// -> unable to load this dependency due to conflict
debugln('Error: (lazarus) Open dependency found incompatible package: searched for '
+Dependency.AsString(true,false)+', but found '+APackage.IDAsString);
if IsStaticBasePackage(APackage.Name) then
if IsCompiledInBasePackage(APackage.Name) then
begin
//debugln(['Note: (lazarus) LazarusDir="',EnvironmentOptions.GetParsedLazarusDirectory,'"']);
// wrong base package
@ -6144,7 +6211,7 @@ begin
OpenDependency(Dependency,false);
if Dependency.LoadPackageResult<>lprSuccess then begin
// a valid lpk file of the installed package can not be found
IsBasePkg:=IsStaticBasePackage(Dependency.PackageName);
IsBasePkg:=IsCompiledInBasePackage(Dependency.PackageName);
// -> create a broken package
BrokenPackage:=TLazPackage.CreateAndClear;
with BrokenPackage do begin

View File

@ -1522,7 +1522,7 @@ begin
while Dependency<>nil do begin
if (Dependency.LoadPackageResult=lprSuccess)
and (not Dependency.RequiredPackage.Missing)
and (not PackageGraph.IsStaticBasePackage(Dependency.PackageName))
and (not PackageGraph.IsCompiledInBasePackage(Dependency.PackageName))
and (not (Dependency.RequiredPackage.PackageType in [lptRunTime,lptRunTimeOnly]))
then begin
if sl.IndexOf(Dependency.PackageName)<0 then begin
@ -4004,7 +4004,7 @@ var
function PkgInOldLazarusDir(APackage: TLazPackage): boolean;
begin
Result:=FileIsInPath(APackage.Filename,OldLazarusSrcDir)
or PackageGraph.IsStaticBasePackage(APackage.Name)
or PackageGraph.IsCompiledInBasePackage(APackage.Name)
or (SysUtils.CompareText(copy(APackage.Filename,1,length(LazDirMacro)),LazDirMacro)=0)
end;
@ -5531,7 +5531,7 @@ begin
PkgList:=nil;
FPMakeList:=nil;
try
PackageGraph.ParseBasePackages;
PackageGraph.ParseBasePackages(false);
// check if package is designtime package
if APackage.PackageType in [lptRunTime,lptRunTimeOnly] then begin
@ -5681,7 +5681,7 @@ begin
end;
// check if package is a lazarus base package
if PackageGraph.IsStaticBasePackage(APackage.Name) then begin
if PackageGraph.IsCompiledInBasePackage(APackage.Name) then begin
Result:=IDEMessageDialogAb(lisUninstallImpossible,
Format(lisThePackageCanNotBeUninstalledBecauseItIsNeededByTh,[APackage.Name]),
mtError,[mbCancel],ShowAbort);
@ -5704,7 +5704,7 @@ begin
if Result<>mrOk then exit;
end;
PackageGraph.ParseBasePackages;
PackageGraph.ParseBasePackages(false);
// remove package from auto installed packages
if APackage.AutoInstall<>pitNope then begin
@ -5919,7 +5919,7 @@ begin
NewFirstAutoInstallDependency:=nil;
PkgList:=nil;
try
PackageGraph.ParseBasePackages;
PackageGraph.ParseBasePackages(false);
if not (piiifClear in Flags) then
begin
@ -5991,7 +5991,7 @@ begin
CurDependency:=PackageGraph.FirstAutoInstallDependency;
while CurDependency<>nil do begin
if (CurDependency.RequiredPackage<>nil)
and (not PackageGraph.IsStaticBasePackage(CurDependency.PackageName)) then
and (not PackageGraph.IsCompiledInBasePackage(CurDependency.PackageName)) then
CurDependency.RequiredPackage.AutoInstall:=pitNope;
CurDependency:=CurDependency.NextRequiresDependency;
end;
@ -6066,7 +6066,7 @@ begin
Dependencies:=nil;
while OldDependency<>nil do begin
if (OldDependency.RequiredPackage<>nil)
and PackageGraph.IsStaticBasePackage(OldDependency.RequiredPackage.Name) then
and PackageGraph.IsCompiledInBasePackage(OldDependency.RequiredPackage.Name) then
begin
Dependency:=TPkgDependency.Create;
Dependency.Assign(OldDependency);