View Issue Details

IDProjectCategoryView StatusLast Update
0034289PatchesIDEpublic2018-09-17 14:13
Reporterm_burkhard@gmx.chAssigned ToJuha Manninen 
PrioritynormalSeverityminorReproducibilityhave not tried
Status resolvedResolutionwon't fix 
PlatformAllOSAllOS VersionAll
Product Version1.9 (SVN)Product Build1.9.0 r59700M 
Target VersionFixed in Version 
Summary0034289: ExecuteCompileReasons is missing in compoptsintf.pas
DescriptionI have also added the functions ExecuteBeforeCompileReasons and Execute After CompileReasons as a supplement to this report.

https://bugs.freepascal.org/view.php?id=34283
Steps To ReproduceExample call:

function TProjectAVRApp.InitProject(AProject: TLazProject): TModalResult;
begin
  ...
  AProject.LazCompilerOptions.ExecuteBeforeCompileReasons := [crCompile] + [crRun];
  AProject.LazCompilerOptions.ExecuteAfterCompileReasons := [crRun];

or

  s := 'Before: ';
  if crCompile in LazProject.LazCompilerOptions.ExecuteBeforeCompileReasons then begin
    s += 'compile ';
  end;
  if crBuild in LazProject.LazCompilerOptions.ExecuteBeforeCompileReasons then begin
    s += 'build ';
  end;
  if crRun in LazProject.LazCompilerOptions.ExecuteBeforeCompileReasons then begin
    s += 'run ';
  end;
  ShowMessage(s);

  
TagsNo tags attached.
Fixed in Revision
LazTarget-
Widgetset
Attached Files
  • reasons.patch (4,335 bytes)
    --- fpcupdeluxe_avr_original_2/lazarus/components/ideintf/compoptsintf.pas	2018-09-15 20:00:32.625115819 +0200
    +++ fpcupdeluxe_ATmega328/lazarus/components/ideintf/compoptsintf.pas	2018-09-15 20:28:20.467258490 +0200
    @@ -290,6 +290,8 @@ type
         function GetUnitPaths: String; virtual; abstract;
         function GetExecuteBeforeCommand: string; virtual; abstract;
         function GetExecuteAfterCommand: string; virtual; abstract;
    +    function GetExecuteBeforeCompileReasons: TCompileReasons; virtual; abstract;
    +    function GetExecuteAfterCompileReasons: TCompileReasons; virtual; abstract;
         procedure SetCompilerPath(const AValue: String); virtual; abstract;
         procedure SetConditionals(AValue: string); virtual; abstract;
         procedure SetCustomOptions(const AValue: string); virtual; abstract;
    @@ -310,6 +312,8 @@ type
         procedure SetUnitPaths(const AValue: String); virtual; abstract;
         procedure SetExecuteBeforeCommand(const ACommand: string); virtual; abstract;
         procedure SetExecuteAfterCommand(const ACommand: string); virtual; abstract;
    +    procedure SetExecuteBeforeCompileReasons(ACompileReasons: TCompileReasons); virtual; abstract;
    +    procedure SetExecuteAfterCompileReasons(ACompileReasons: TCompileReasons); virtual; abstract;
       public
         constructor Create(const TheOwner: TObject); virtual;
         destructor Destroy; override;
    @@ -456,6 +460,8 @@ type
         property CompilerPath: String read GetCompilerPath write SetCompilerPath;
         property ExecuteBeforeCommand: String read GetExecuteBeforeCommand write SetExecuteBeforeCommand;
         property ExecuteAfterCommand: String read GetExecuteAfterCommand write SetExecuteAfterCommand;
    +    property ExecuteBeforeCompileReasons: TCompileReasons read GetExecuteBeforeCompileReasons write SetExecuteBeforeCompileReasons;
    +    property ExecuteAfterCompileReasons: TCompileReasons read GetExecuteAfterCompileReasons write SetExecuteAfterCompileReasons;
         procedure SetAlternativeCompile(const Command: string; ScanFPCMsgs: boolean); virtual; abstract; // disable normal compile and call this instead
       end;
     
    --- fpcupdeluxe_avr_original_2/lazarus/ide/project.pp	2018-09-15 20:00:12.301006947 +0200
    +++ fpcupdeluxe_ATmega328/lazarus/ide/project.pp	2018-09-16 16:19:17.909216697 +0200
    @@ -528,8 +528,11 @@ type
         procedure SetUnitPaths(const AValue: string); override;
         procedure SetUnitOutputDir(const AValue: string); override;
         procedure SetConditionals(AValue: string); override;
    -    function SubstituteProjectMacros(const s: string;
    -                                     PlatformIndependent: boolean): string;
    +    function SubstituteProjectMacros(const s: string; PlatformIndependent: boolean): string;
    +    function GetExecuteBeforeCompileReasons: TCompileReasons; override;
    +    function GetExecuteAfterCompileReasons: TCompileReasons; override;
    +    procedure SetExecuteBeforeCompileReasons(ACompileReasons: TCompileReasons); override;
    +    procedure SetExecuteAfterCompileReasons(ACompileReasons: TCompileReasons); override;
       public
         constructor Create(const AOwner: TObject); override;
         destructor Destroy; override;
    @@ -6210,6 +6213,34 @@ begin
       end;
     end;
     
    +function TProjectCompilerOptions.GetExecuteBeforeCompileReasons: TCompileReasons;
    +begin
    +  if ExecuteAfter is TProjectCompilationToolOptions then begin
    +    Result := TProjectCompilationToolOptions(ExecuteBefore).CompileReasons;
    +  end;
    +end;
    +
    +function TProjectCompilerOptions.GetExecuteAfterCompileReasons: TCompileReasons;
    +begin
    +  if ExecuteAfter is TProjectCompilationToolOptions then begin
    +    Result := TProjectCompilationToolOptions(ExecuteAfter).CompileReasons;
    +  end;
    +end;
    +
    +procedure TProjectCompilerOptions.SetExecuteBeforeCompileReasons(ACompileReasons: TCompileReasons);
    +begin
    +  if ExecuteAfter is TProjectCompilationToolOptions then begin
    +    TProjectCompilationToolOptions(ExecuteBefore).CompileReasons := ACompileReasons;
    +  end;
    +end;
    +
    +procedure TProjectCompilerOptions.SetExecuteAfterCompileReasons(ACompileReasons: TCompileReasons);
    +begin
    +  if ExecuteAfter is TProjectCompilationToolOptions then begin
    +    TProjectCompilationToolOptions(ExecuteAfter).CompileReasons := ACompileReasons;
    +  end;
    +end;
    +
     procedure TProjectCompilerOptions.Assign(Source: TPersistent);
     var
       ProjCompOptions: TProjectCompilerOptions;
    
    reasons.patch (4,335 bytes)

Relationships

related to 0034283 resolvedJuha Manninen ExecuteCommand is missing in compoptsintf.pas 

Activities

m_burkhard@gmx.ch

2018-09-16 16:39

reporter  

reasons.patch (4,335 bytes)
--- fpcupdeluxe_avr_original_2/lazarus/components/ideintf/compoptsintf.pas	2018-09-15 20:00:32.625115819 +0200
+++ fpcupdeluxe_ATmega328/lazarus/components/ideintf/compoptsintf.pas	2018-09-15 20:28:20.467258490 +0200
@@ -290,6 +290,8 @@ type
     function GetUnitPaths: String; virtual; abstract;
     function GetExecuteBeforeCommand: string; virtual; abstract;
     function GetExecuteAfterCommand: string; virtual; abstract;
+    function GetExecuteBeforeCompileReasons: TCompileReasons; virtual; abstract;
+    function GetExecuteAfterCompileReasons: TCompileReasons; virtual; abstract;
     procedure SetCompilerPath(const AValue: String); virtual; abstract;
     procedure SetConditionals(AValue: string); virtual; abstract;
     procedure SetCustomOptions(const AValue: string); virtual; abstract;
@@ -310,6 +312,8 @@ type
     procedure SetUnitPaths(const AValue: String); virtual; abstract;
     procedure SetExecuteBeforeCommand(const ACommand: string); virtual; abstract;
     procedure SetExecuteAfterCommand(const ACommand: string); virtual; abstract;
+    procedure SetExecuteBeforeCompileReasons(ACompileReasons: TCompileReasons); virtual; abstract;
+    procedure SetExecuteAfterCompileReasons(ACompileReasons: TCompileReasons); virtual; abstract;
   public
     constructor Create(const TheOwner: TObject); virtual;
     destructor Destroy; override;
@@ -456,6 +460,8 @@ type
     property CompilerPath: String read GetCompilerPath write SetCompilerPath;
     property ExecuteBeforeCommand: String read GetExecuteBeforeCommand write SetExecuteBeforeCommand;
     property ExecuteAfterCommand: String read GetExecuteAfterCommand write SetExecuteAfterCommand;
+    property ExecuteBeforeCompileReasons: TCompileReasons read GetExecuteBeforeCompileReasons write SetExecuteBeforeCompileReasons;
+    property ExecuteAfterCompileReasons: TCompileReasons read GetExecuteAfterCompileReasons write SetExecuteAfterCompileReasons;
     procedure SetAlternativeCompile(const Command: string; ScanFPCMsgs: boolean); virtual; abstract; // disable normal compile and call this instead
   end;
 
--- fpcupdeluxe_avr_original_2/lazarus/ide/project.pp	2018-09-15 20:00:12.301006947 +0200
+++ fpcupdeluxe_ATmega328/lazarus/ide/project.pp	2018-09-16 16:19:17.909216697 +0200
@@ -528,8 +528,11 @@ type
     procedure SetUnitPaths(const AValue: string); override;
     procedure SetUnitOutputDir(const AValue: string); override;
     procedure SetConditionals(AValue: string); override;
-    function SubstituteProjectMacros(const s: string;
-                                     PlatformIndependent: boolean): string;
+    function SubstituteProjectMacros(const s: string; PlatformIndependent: boolean): string;
+    function GetExecuteBeforeCompileReasons: TCompileReasons; override;
+    function GetExecuteAfterCompileReasons: TCompileReasons; override;
+    procedure SetExecuteBeforeCompileReasons(ACompileReasons: TCompileReasons); override;
+    procedure SetExecuteAfterCompileReasons(ACompileReasons: TCompileReasons); override;
   public
     constructor Create(const AOwner: TObject); override;
     destructor Destroy; override;
@@ -6210,6 +6213,34 @@ begin
   end;
 end;
 
+function TProjectCompilerOptions.GetExecuteBeforeCompileReasons: TCompileReasons;
+begin
+  if ExecuteAfter is TProjectCompilationToolOptions then begin
+    Result := TProjectCompilationToolOptions(ExecuteBefore).CompileReasons;
+  end;
+end;
+
+function TProjectCompilerOptions.GetExecuteAfterCompileReasons: TCompileReasons;
+begin
+  if ExecuteAfter is TProjectCompilationToolOptions then begin
+    Result := TProjectCompilationToolOptions(ExecuteAfter).CompileReasons;
+  end;
+end;
+
+procedure TProjectCompilerOptions.SetExecuteBeforeCompileReasons(ACompileReasons: TCompileReasons);
+begin
+  if ExecuteAfter is TProjectCompilationToolOptions then begin
+    TProjectCompilationToolOptions(ExecuteBefore).CompileReasons := ACompileReasons;
+  end;
+end;
+
+procedure TProjectCompilerOptions.SetExecuteAfterCompileReasons(ACompileReasons: TCompileReasons);
+begin
+  if ExecuteAfter is TProjectCompilationToolOptions then begin
+    TProjectCompilationToolOptions(ExecuteAfter).CompileReasons := ACompileReasons;
+  end;
+end;
+
 procedure TProjectCompilerOptions.Assign(Source: TPersistent);
 var
   ProjCompOptions: TProjectCompilerOptions;
reasons.patch (4,335 bytes)

Juha Manninen

2018-09-16 17:05

developer   ~0110797

You could have just uploaded the patch into the existing issue which was left open for that purpose.
Anyway, I will apply this one later today.

Juha Manninen

2018-09-17 12:05

developer   ~0110822

Actually the patch sucks big time! Please try to pay attention to code quality.

This potentially returns an uninitialized Result:
 function TProjectCompilerOptions.GetExecuteBeforeCompileReasons: TCompileReasons;
 begin
   if ExecuteAfter is TProjectCompilationToolOptions then begin
     Result := TProjectCompilationToolOptions(ExecuteBefore).CompileReasons;
   end;
 end;

This one potentially fails silently:
 procedure TProjectCompilerOptions.SetExecuteBeforeCompileReasons(ACompileReasons: TCompileReasons);
 begin
   if ExecuteAfter is TProjectCompilationToolOptions then begin
     TProjectCompilationToolOptions(ExecuteBefore).CompileReasons := ACompileReasons;
   end;
 end;

I think we need an interface for TCompilationToolOptions, not to its members. It means the first commit for ExecuteCommand must be reverted. Now it is important to get this right because we just forked Lazarus 2.0. Once an interface is established it cannot be changed any more.

Juha Manninen

2018-09-17 14:13

developer   ~0110824

I resolve this one. Let's continue with the original issue report.

Issue History

Date Modified Username Field Change
2018-09-16 16:39 m_burkhard@gmx.ch New Issue
2018-09-16 16:39 m_burkhard@gmx.ch File Added: reasons.patch
2018-09-16 17:04 Juha Manninen Relationship added related to 0034283
2018-09-16 17:04 Juha Manninen Assigned To => Juha Manninen
2018-09-16 17:04 Juha Manninen Status new => assigned
2018-09-16 17:05 Juha Manninen Note Added: 0110797
2018-09-17 12:05 Juha Manninen Note Added: 0110822
2018-09-17 12:05 Juha Manninen LazTarget => -
2018-09-17 12:05 Juha Manninen Status assigned => feedback
2018-09-17 14:13 Juha Manninen Note Added: 0110824
2018-09-17 14:13 Juha Manninen Status feedback => resolved
2018-09-17 14:13 Juha Manninen Resolution open => won't fix