paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-26 03:09:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

ide: moved OutputDirectoryOverride from TParsedCompilerOptions to TBaseCompilerOptions

Browse Source
This commit is contained in:
mattias 2025-07-13 16:28:14 +02:00
parent 8e168bc2f5
commit 259196df63
8 changed files with 92 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
ide/buildmanager.pas
View File

@ -421,7 +421,7 @@ begin
GetBuildMacroValues:=@GetBuildMacroValuesHandler;
OnAppendCustomOption:=@AppendMatrixCustomOption;
OnGetOutputDirectoryOverride:=@GetMatrixOutputDirectoryOverride;
OnGetMatrixOutputDirectoryOverride:=@GetMatrixOutputDirectoryOverride;
CodeToolBoss.OnRescanFPCDirectoryCache:=@DoOnRescanFPCDirectoryCache;
end;

28
ide/packages/ideconfig/compileroptions.pp
View File

@ -245,6 +245,7 @@ type
FDefaultMakeOptionsFlags: TCompilerCmdLineOptions;
fInheritedOptions: TInheritedCompOptsParseTypesStrings;
fInheritedOptParseStamps: integer;
FOutputDirectoryOverride: string;
FParsedOpts: TParsedCompilerOptions;
FStorePathDelim: TPathDelimSwitch;
FOtherDefines: TStrings; // list of user selectable defines for custom options
@ -253,6 +254,7 @@ type
procedure AppendDefaultExt(var aFilename: string);
function GetExecuteAfter: TCompilationToolOptions;
function GetExecuteBefore: TCompilationToolOptions;
function GetOutputDirOverride: string;
procedure PrependDefaultType(var AFilename: string);
procedure SetCreateMakefileOnBuild(AValue: boolean);
protected
@ -279,6 +281,7 @@ type
procedure SetUnitPaths(const AValue: String); override;
procedure SetUnitOutputDir(const AValue: string); override;
procedure SetObjectPath(const AValue: string); override;
procedure SetOutputDirectoryOverride(const AValue: string); virtual;
procedure SetSrcPath(const AValue: string); override;
procedure SetDebugPath(const AValue: string); override;
procedure SetTargetCPU(const AValue: string); override;
@ -396,6 +399,7 @@ type
property BaseDirectory: string read GetBaseDirectory write SetBaseDirectory;
property DefaultMakeOptionsFlags: TCompilerCmdLineOptions
read FDefaultMakeOptionsFlags write SetDefaultMakeOptionsFlags;
property OutputDirectoryOverride: string read FOutputDirectoryOverride write SetOutputDirectoryOverride;
// stored properties
property StorePathDelim: TPathDelimSwitch read FStorePathDelim write FStorePathDelim;
property OtherDefines: TStrings read FOtherDefines;
@ -826,6 +830,7 @@ constructor TBaseCompilerOptions.Create(const AOwner: TObject;
begin
inherited Create(AOwner);
FParsedOpts := TParsedCompilerOptions.Create(Self);
ParsedOpts.OnGetOutputDirectoryOverride:=@GetOutputDirOverride;
FOtherDefines := TStringList.Create;
FExecuteBefore := AToolClass.Create(Self);
FExecuteAfter := AToolClass.Create(Self);
@ -1112,6 +1117,11 @@ begin
Result:=TCompilationToolOptions(fExecuteBefore);
end;
function TBaseCompilerOptions.GetOutputDirOverride: string;
begin
Result:=OutputDirectoryOverride;
end;
procedure TBaseCompilerOptions.SetBaseDirectory(AValue: string);
begin
if BaseDirectory=AValue then exit;
@ -1206,6 +1216,18 @@ begin
IncreaseChangeStamp;
end;
procedure TBaseCompilerOptions.SetOutputDirectoryOverride(const AValue: string);
begin
if FOutputDirectoryOverride=AValue then Exit;
FOutputDirectoryOverride:=AValue;
if ParsedOpts.InvalidateParseOnChange then
IncreaseCompilerParseStamp;// the output dir is used by other packages
//if FOutputDirectoryOverride<>'' then
// DebugLn(['TBaseCompilerOptions.SetOutputDirectoryOverride New=',FOutputDirectoryOverride])
//else
// DebugLn(['TBaseCompilerOptions.SetOutputDirectoryOverride using default']);
end;
{------------------------------------------------------------------------------
TfrmCompilerOptions LoadTheCompilerOptions
------------------------------------------------------------------------------}
@ -1752,8 +1774,8 @@ begin
if (Result<>'') and FilenameIsAbsolute(Result) then begin
// fully specified target filename
end else if Result<>'' then begin
//debugln(['TBaseCompilerOptions.CreateTargetFilename ParsedOpts.OutputDirectoryOverride=',ParsedOpts.OutputDirectoryOverride]);
if ParsedOpts.OutputDirectoryOverride<>'' then
//debugln(['TBaseCompilerOptions.CreateTargetFilename OutputDirectoryOverride=',OutputDirectoryOverride]);
if OutputDirectoryOverride<>'' then
begin
// the program/package is put into the output directory
UnitOutDir:=GetUnitOutPath(false);
@ -2788,7 +2810,7 @@ begin
if FilenameIsAbsolute(Result) then begin
// fully specified target filename
end else if (UnitOutputDirectory='')
and (ParsedOpts.OutputDirectoryOverride='')
and (OutputDirectoryOverride='')
and (ExtractFilePath(TargetFilename)='') then begin
// the unit is put into the same directory as its source
Result:=CreateAbsolutePath(Result,BaseDirectory);

37
ide/packages/ideconfig/parsedcompileropts.pas
View File

@ -156,16 +156,16 @@ const
type
TLocalSubstitutionEvent = function(s: string;
PlatformIndependent: boolean): string of object;
TPCOGetOverride = function: string of object;
{ TParsedCompilerOptions }
TParsedCompilerOptions = class
private
FInvalidateParseOnChange: boolean;
FOnGetOutputDirectoryOverride: TPCOGetOverride;
FOnLocalSubstitute: TLocalSubstitutionEvent;
FOutputDirectoryOverride: string;
FOwner: TObject;
procedure SetOutputDirectoryOverride(const AValue: string);
public
// parsed
Values: array[TParsedCompilerOptString] of TParseString;
@ -208,8 +208,8 @@ type
write FOnLocalSubstitute;
property InvalidateParseOnChange: boolean read FInvalidateParseOnChange
write FInvalidateParseOnChange;
property OutputDirectoryOverride: string read FOutputDirectoryOverride
write SetOutputDirectoryOverride;
property OnGetOutputDirectoryOverride: TPCOGetOverride read FOnGetOutputDirectoryOverride
write FOnGetOutputDirectoryOverride;
end;
{ TAdditionalCompilerOptions
@ -273,12 +273,12 @@ type
const UnparsedValue: string; PlatformIndependent: boolean): string of object;
TOnAppendCustomOptions = procedure(Sender: TObject;
var CustomOptions: string; Types: TBuildMatrixGroupTypes) of object;
TOnGetOutputDirectoryOverride = procedure(Sender: TObject;
TOnGetMatrixOutputDirectoryOverride = procedure(Sender: TObject;
var OutDir: string; Types: TBuildMatrixGroupTypes) of object;
var
OnAppendCustomOption: TOnAppendCustomOptions = nil; // set by MainBuildBoss
OnGetOutputDirectoryOverride: TOnGetOutputDirectoryOverride = nil; // set by MainBuildBoss
OnGetMatrixOutputDirectoryOverride: TOnGetMatrixOutputDirectoryOverride = nil; // set by MainBuildBoss
OnParseString: TParseStringEvent = nil;
GetBuildMacroValues: TGetBuildMacroValues = nil; // set by TPkgManager, do not change or free the variables
@ -378,18 +378,6 @@ end;
{ TParsedCompilerOptions }
procedure TParsedCompilerOptions.SetOutputDirectoryOverride(const AValue: string);
begin
if FOutputDirectoryOverride=AValue then exit;
FOutputDirectoryOverride:=AValue;
if InvalidateParseOnChange then
IncreaseCompilerParseStamp;// the output dir is used by other packages
//if FOutputDirectoryOverride<>'' then
// DebugLn(['TParsedCompilerOptions.SetOutputDirectoryOverride New=',FOutputDirectoryOverride])
//else
// DebugLn(['TParsedCompilerOptions.SetOutputDirectoryOverride using default']);
end;
constructor TParsedCompilerOptions.Create(TheOwner: TObject);
begin
FOwner:=TheOwner;
@ -477,9 +465,11 @@ var
s: String;
begin
if WithOverrides then begin
if (Option=pcosOutputDir) and (OutputDirectoryOverride<>'') then begin
Result:=OutputDirectoryOverride;
exit;
if (Option=pcosOutputDir) and Assigned(OnGetOutputDirectoryOverride) then
begin
s:=OnGetOutputDirectoryOverride();
if s<>'' then
exit(s);
end;
end;
if Values[Option].ParseStamp<>CompilerParseStamp then begin
@ -573,8 +563,8 @@ begin
// apply overrides
if not PlatformIndependent then begin
if Option=pcosOutputDir then begin
if Assigned(OnGetOutputDirectoryOverride) then
OnGetOutputDirectoryOverride(Self,Result,bmgtAll);
if Assigned(OnGetMatrixOutputDirectoryOverride) then
OnGetMatrixOutputDirectoryOverride(Self,Result,bmgtAll);
end;
end;
@ -627,7 +617,6 @@ procedure TParsedCompilerOptions.Assign(Src: TParsedCompilerOptions);
begin
FInvalidateParseOnChange := Src.FInvalidateParseOnChange;
// FOnLocalSubstitute := Src.FOnLocalSubstitute;
FOutputDirectoryOverride := Src.FOutputDirectoryOverride;
Values := Src.Values;
ParsedErrorOption := Src.ParsedErrorOption;
ParsedErrorMsg := Src.ParsedErrorMsg;

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

@ -305,7 +305,7 @@ type
private
FLazPackage: TLazPackage;
FSkipCompiler: Boolean;
procedure InvalidateOptions;
procedure InvalidateUsageOptions;
protected
procedure SetLazPackage(const AValue: TLazPackage);
procedure SetCustomOptions(const AValue: string); override;
@ -316,6 +316,7 @@ type
procedure SetSrcPath(const AValue: string); override;
procedure SetUnitPaths(const AValue: string); override;
procedure SetUnitOutputDir(const AValue: string); override;
procedure SetOutputDirectoryOverride(const AValue: string); override;
procedure SetConditionals(AValue: string); override;
public
constructor Create(const AOwner: TObject); override;
@ -3753,8 +3754,7 @@ end;
function TLazPackage.GetOutputDirType: TPkgOutputDir;
begin
if (CompilerOptions<>nil)
and (CompilerOptions.ParsedOpts<>nil)
and (CompilerOptions.ParsedOpts.OutputDirectoryOverride<>'') then
and (CompilerOptions.OutputDirectoryOverride<>'') then
Result:=podFallback
else
Result:=podDefault;
@ -4089,7 +4089,7 @@ end;
procedure TPkgCompilerOptions.SetCustomOptions(const AValue: string);
begin
if CustomOptions=AValue then exit;
InvalidateOptions;
InvalidateUsageOptions;
inherited SetCustomOptions(AValue);
if LazPackage<>nil then
LazPackage.DefineTemplates.CustomDefinesChanged;
@ -4098,59 +4098,68 @@ end;
procedure TPkgCompilerOptions.SetIncludePaths(const AValue: string);
begin
if IncludePath=AValue then exit;
InvalidateOptions;
InvalidateUsageOptions;
inherited SetIncludePaths(AValue);
end;
procedure TPkgCompilerOptions.SetLibraryPaths(const AValue: string);
begin
if Libraries=AValue then exit;
InvalidateOptions;
InvalidateUsageOptions;
inherited SetLibraryPaths(AValue);
end;
procedure TPkgCompilerOptions.SetLinkerOptions(const AValue: string);
begin
if LinkerOptions=AValue then exit;
InvalidateOptions;
InvalidateUsageOptions;
inherited SetLinkerOptions(AValue);
end;
procedure TPkgCompilerOptions.SetObjectPath(const AValue: string);
begin
if ObjectPath=AValue then exit;
InvalidateOptions;
InvalidateUsageOptions;
inherited SetObjectPath(AValue);
end;
procedure TPkgCompilerOptions.SetSrcPath(const AValue: string);
begin
if SrcPath=AValue then exit;
InvalidateOptions;
InvalidateUsageOptions;
inherited SetSrcPath(AValue);
end;
procedure TPkgCompilerOptions.SetUnitPaths(const AValue: string);
begin
if OtherUnitFiles=AValue then exit;
InvalidateOptions;
InvalidateUsageOptions;
inherited SetUnitPaths(AValue);
end;
procedure TPkgCompilerOptions.SetUnitOutputDir(const AValue: string);
begin
if UnitOutputDirectory=AValue then exit;
InvalidateOptions;
InvalidateUsageOptions;
inherited SetUnitOutputDir(AValue);
if LazPackage<>nil then
LazPackage.DefineTemplates.OutputDirectoryChanged;
end;
procedure TPkgCompilerOptions.SetOutputDirectoryOverride(const AValue: string);
begin
if AValue=OutputDirectoryOverride then exit;
inherited SetOutputDirectoryOverride(AValue);
InvalidateUsageOptions;
if LazPackage<>nil then
LazPackage.DefineTemplates.OutputDirectoryChanged;
end;
procedure TPkgCompilerOptions.SetConditionals(AValue: string);
begin
AValue:=UTF8Trim(AValue,[]);
if Conditionals=AValue then exit;
InvalidateOptions;
InvalidateUsageOptions;
inherited SetConditionals(AValue);
end;
@ -4201,7 +4210,7 @@ begin
Result:='';
end;
procedure TPkgCompilerOptions.InvalidateOptions;
procedure TPkgCompilerOptions.InvalidateUsageOptions;
begin
if (LazPackage=nil) then exit;
if LazPackage.UsageOptions=nil then RaiseGDBException('');

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

@ -3673,7 +3673,7 @@ begin
OutputDir:=APackage.GetOutputDirectory(false);
IsDefDirWritable:=OutputDirectoryIsWritable(APackage,OutputDir,false);
if APackage.CompilerOptions.ParsedOpts.OutputDirectoryOverride='' then
if APackage.CompilerOptions.OutputDirectoryOverride='' then
begin
// the last compile was put to the normal/default output directory
if IsDefDirWritable then
@ -3690,7 +3690,7 @@ begin
exit;
end;
Note+='Normal output directory is not writable, switching to fallback.'+LineEnding;
APackage.CompilerOptions.ParsedOpts.OutputDirectoryOverride:=NewOutputDir;
APackage.CompilerOptions.OutputDirectoryOverride:=NewOutputDir;
if ForceBuild then
Result:=mrYes
else
@ -3720,8 +3720,8 @@ begin
// => try using the default output directory
end;
OldOverride:=APackage.CompilerOptions.ParsedOpts.OutputDirectoryOverride;
APackage.CompilerOptions.ParsedOpts.OutputDirectoryOverride:='';
OldOverride:=APackage.CompilerOptions.OutputDirectoryOverride;
APackage.CompilerOptions.OutputDirectoryOverride:='';
if ConsoleVerbosity>=0 then
debugln(['Hint: (lazarus) trying the default output directory of package ',APackage.IDAsString]);
OldNeedBuildAllFlag:=NeedBuildAllFlag;
@ -3738,7 +3738,7 @@ begin
// => switch back to the fallback
if ConsoleVerbosity>=0 then
debugln(['Hint: (lazarus) switching back to fallback output directory package ',APackage.IDAsString]);
APackage.CompilerOptions.ParsedOpts.OutputDirectoryOverride:=OldOverride;
APackage.CompilerOptions.OutputDirectoryOverride:=OldOverride;
NeedBuildAllFlag:=OldNeedBuildAllFlag;
end;
end;
@ -5623,7 +5623,7 @@ begin
// the output directory is not writable
debugln(['Error: (lazarus) [TLazPackageGraph.PreparePackageOutputDirectory] failed to create writable directory (',APackage.IDAsString,'): ',OutputDir]);
Result:=mrCancel;
end else if APackage.CompilerOptions.ParsedOpts.OutputDirectoryOverride<>''
end else if APackage.CompilerOptions.OutputDirectoryOverride<>''
then
// package is already using the fallback directory
DeleteAllFilesInOutputDir:=true

44
ide/showcompileropts.lfm
View File

@ -20,8 +20,8 @@ object ShowCompilerOptionsDlg: TShowCompilerOptionsDlg
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 564
Height = 26
Top = 388
Height = 30
Top = 384
Width = 75
Anchors = [akRight, akBottom]
AutoSize = True
@ -37,7 +37,7 @@ object ShowCompilerOptionsDlg: TShowCompilerOptionsDlg
object PageControl1: TPageControl
AnchorSideBottom.Control = CloseButton
Left = 6
Height = 376
Height = 372
Top = 6
Width = 633
ActivePage = CmdLineParamsTabSheet
@ -48,14 +48,14 @@ object ShowCompilerOptionsDlg: TShowCompilerOptionsDlg
TabOrder = 0
object CmdLineParamsTabSheet: TTabSheet
Caption = 'CmdLineParams'
ClientHeight = 348
ClientWidth = 625
ClientHeight = 342
ClientWidth = 623
object CmdLineMemo: TMemo
AnchorSideBottom.Control = RelativePathsCheckBox
Left = 6
Height = 317
Height = 307
Top = 6
Width = 613
Width = 611
Align = alTop
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Around = 6
@ -71,9 +71,9 @@ object ShowCompilerOptionsDlg: TShowCompilerOptionsDlg
AnchorSideBottom.Control = CmdLineParamsTabSheet
AnchorSideBottom.Side = asrBottom
Left = 6
Height = 19
Top = 329
Width = 140
Height = 23
Top = 319
Width = 166
Anchors = [akLeft, akBottom]
Caption = 'RelativePathsCheckBox'
Checked = True
@ -86,10 +86,10 @@ object ShowCompilerOptionsDlg: TShowCompilerOptionsDlg
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = RelativePathsCheckBox
AnchorSideBottom.Side = asrBottom
Left = 161
Height = 19
Top = 329
Width = 117
Left = 187
Height = 23
Top = 319
Width = 137
BorderSpacing.Left = 15
Caption = 'MultilineCheckBox'
Checked = True
@ -100,13 +100,13 @@ object ShowCompilerOptionsDlg: TShowCompilerOptionsDlg
end
object InheritedParamsTabSheet: TTabSheet
Caption = 'InheritedParams'
ClientHeight = 348
ClientWidth = 625
ClientHeight = 342
ClientWidth = 623
object InhTreeView: TTreeView
Left = 0
Height = 282
Height = 276
Top = 0
Width = 625
Width = 623
Align = alClient
HideSelection = False
ReadOnly = True
@ -118,8 +118,8 @@ object ShowCompilerOptionsDlg: TShowCompilerOptionsDlg
object InhItemMemo: TMemo
Left = 0
Height = 61
Top = 287
Width = 625
Top = 281
Width = 623
Align = alBottom
ReadOnly = True
ScrollBars = ssAutoVertical
@ -129,8 +129,8 @@ object ShowCompilerOptionsDlg: TShowCompilerOptionsDlg
Cursor = crVSplit
Left = 0
Height = 5
Top = 282
Width = 625
Top = 276
Width = 623
Align = alBottom
ResizeAnchor = akBottom
end

2
ide/showcompileropts.pas
View File

@ -386,7 +386,7 @@ var
AddChildNode(liscustomOptions, CustomOptions, icoCustomOptions);
end;
OutDir:='.*';
OnGetOutputDirectoryOverride(CompilerOpts,OutDir,[Grp]);
OnGetMatrixOutputDirectoryOverride(CompilerOpts,OutDir,[Grp]);
if OutDir<>'.*' then begin
AddMatrixGroupNode(Grp);
AddChildNode('Output directory', OutDir, icoNone);

4
packager/pkgmanager.pas
View File

@ -540,14 +540,14 @@ begin
if MainIDEBar=nil then exit; // not interactive
if InputHistories=nil then exit;
if not Assigned(OnGetOutputDirectoryOverride) then exit;
if not Assigned(OnGetMatrixOutputDirectoryOverride) then exit;
PkgWithProjOverriddenOutDirs:=TFPList.Create;
try
for i:=0 to aPkgList.Count-1 do
begin
CurPkg:=TLazPackage(aPkgList[i]);
OutDir:='';
OnGetOutputDirectoryOverride(CurPkg,OutDir,[bmgtProject,bmgtSession]);
OnGetMatrixOutputDirectoryOverride(CurPkg,OutDir,[bmgtProject,bmgtSession]);
if OutDir<>'' then begin
IgnoreItem:=InputHistories.Ignores.Find(GetIgnorePkgOutDirID(CurPkg));
if (IgnoreItem=nil) then