add a project action to check semantics

CHANGELOG.md

@@ -3,6 +3,7 @@
 ## Enhancement
 
 - Halstead metrics: show full function signatures.
+- projects: added the _Check semantics_ to the menu. (#83)
 - DUB projects: added support for the _syntax_ build type. (#83)
 - GDB commander: arguments of the _Debugee Options_ can be temporarily deactivated by prepending `//`.
 - GDB commander: add an option allowing to set the path to the gdb binary. (#73)

docs/features_projects.md

@@ -40,6 +40,7 @@ The widget used to edit the properties is the [DEXED project editor](widgets_dex
 - **"Compile project"**: Compiles the project using the current configuration.
 - **"Compile and run project"**: Compiles the project using the current configuration and executes the output when the binary produced is executable.
 - **"Compile and run project..."**: Ditto. Before the execution of the binary an input query dialog lets you pass options to the process.
+- **"Check semantics"**: Like _Compile project_ but only checks the program semantics and does not generate object files.
 - **"Run project"**: Executes the project output when the binary produced is executable.
 - **"Run project..."**: Ditto. Before the execution, an input query dialog lets you specify switches and arguments to the process.
 - **"Test project"**: Only for DUB projects. Invoke `dub test` using the configuration selected in the [project inspector](widgets_project_inspector.html).

src/u_ceproject.pas

@@ -127,6 +127,7 @@ type
     function compiled: Boolean;
     procedure compile;
     procedure test;
+    procedure checkSemantics;
     function targetUpToDate: boolean;
     procedure checkMissingFiles;
     //
@@ -834,6 +835,33 @@ begin
     fCompilProc.Terminate(1);
 end;
 
+procedure TNativeProject.checkSemantics;
+var
+  i: integer;
+  s: string;
+  d: DCompiler;
+begin
+  i := currentConfiguration.otherOptions.customOptions.Count;
+  d := CEProjectCompiler;
+  if d = DCompiler.global then
+    d := fCompilerSelector.transtlateGlobal();
+  case CEProjectCompiler of
+    dmd, ldmd, gdmd  : s := '-o-';
+    gdc              : s := '-fsyntax-only'
+    ldc              : s := '--o-';
+    user1, user2     :
+    begin
+      s := '-o-';
+      fMsgs.message('semantics check may not start if the user defined compiler is for GDC',
+        fAsProjectItf, amcProj, amkWarn);
+      exit;
+    end;
+  end;
+  currentConfiguration.otherOptions.customOptions.Add(s);
+  compile();
+  currentConfiguration.otherOptions.customOptions.Delete(i);
+end;
+
 procedure TNativeProject.compile;
 var
   config: TCompilerConfiguration;

src/u_compilers.lfm

@@ -6,7 +6,7 @@ object CompilersPathsEditor: TCompilersPathsEditor
   Caption = 'CompilersPathsEditor'
   ClientHeight = 900
   ClientWidth = 460
-  LCLVersion = '2.0.10.0'
+  LCLVersion = '2.2.0.1'
   object ScrollBox1: TScrollBox
     Left = 0
     Height = 900

src/u_compilers.pas

@@ -150,6 +150,7 @@ type
     function isCompilerValid(value: DCompiler): boolean;
     function getCompilerPath(value: DCompiler; translateToWrapper: boolean): string;
     procedure getCompilerImports(value: DCompiler; paths: TStrings);
+    function transtlateGlobal: DCompiler;
     //
     procedure projNew(project: ICommonProject);
     procedure projChanged(project: ICommonProject);
@@ -655,6 +656,11 @@ begin
       begin checkIfGlobalIsGlobal; getCompilerImports(fPaths.definedAsGlobal, paths); end;
   end;
 end;
+
+function TCompilersPathsEditor.transtlateGlobal: DCompiler;
+begin
+  result := fPaths.definedAsGlobal;
+end;
 {$ENDREGION}
 
 {$REGION Compilers paths things ------------------------------------------------}

src/u_dubproject.pas

@@ -106,7 +106,7 @@ type
     destructor destroy; override;
   end;
 
-  TDubCommand = (dcBuild, dcRun, dcTest);
+  TDubCommand = (dcBuild, dcRun, dcTest, dcCheckSema);
 
   TDubProject = class(TComponent, ICommonProject)
   private
@@ -191,6 +191,7 @@ type
     function configurationName(index: integer): string;
 
     procedure compile;
+    procedure checkSemantics;
     function compiled: boolean;
     procedure run(const runArgs: string = '');
     procedure test;
@@ -239,9 +240,9 @@ const
 
   DubDefaultConfigName = '(default config)';
 
-  dubCmd2Arg: array[TDubCommand] of string = ('build', 'run', 'test');
+  dubCmd2Arg: array[TDubCommand] of string = ('build', 'run', 'test', 'build');
-  dubCmd2PreMsg: array[TDubCommand] of string = ('compiling ', 'running ', 'testing ');
+  dubCmd2PreMsg: array[TDubCommand] of string = ('compiling ', 'running ', 'testing ', 'checking ');
-  dubCmd2PostMsg: array[TDubCommand] of string = ('compiled', 'executed', 'tested');
+  dubCmd2PostMsg: array[TDubCommand] of string = ('compiled', 'executed', 'tested', 'checked');
 
 procedure getPackagesLocations(loc: TStringList);
 var
@@ -1109,6 +1110,7 @@ procedure TDubProject.executeDub(command: TDubCommand; const runArgs: string = '
 var
   prjname: string;
   rargs: TStringList;
+  t: integer;
   i: integer;
   e: string;
   d: string;
@@ -1164,7 +1166,11 @@ begin
   fDubProc.OnTerminate:= @dubProcTerminated;
   if (command <> dcTest) or not dubBuildOptions.autoSelectTestConfig then
   begin
-    fDubProc.Parameters.Add('--build=' + fBuildTypes[fBuiltTypeIx]);
+    if command = dcCheckSema then
+      t := integer(TDubBuildType.syntax)
+    else
+      t := fBuiltTypeIx;
+    fDubProc.Parameters.Add('--build=' + fBuildTypes[t]);
     if (fConfigs.Count <> 1) and (fConfigs[0] <> DubDefaultConfigName) then
       fDubProc.Parameters.Add('--config=' + fConfigs[fConfigIx]);
   end;
@@ -1179,7 +1185,7 @@ begin
   end;
   fDubProc.Parameters.Add('--compiler=' + d);
   dubBuildOptions.getOpts(fDubProc.Parameters);
-  if (command <> dcBuild) and runArgs.isNotEmpty then
+  if (command <> dcBuild) and (command <> dcCheckSema) and runArgs.isNotEmpty then
   begin
     fDubProc.Parameters.Add('--');
     rargs := TStringList.Create;
@@ -1198,6 +1204,11 @@ begin
   executeDub(dcBuild);
 end;
 
+procedure TDubProject.checkSemantics;
+begin
+  executeDub(dcCheckSema);
+end;
+
 function TDubProject.compiled: boolean;
 begin
   exit(fCompiled);

src/u_interfaces.pas

@@ -85,6 +85,8 @@ type
 
       // tries to compile.
       procedure compile;
+      //
+      procedure checkSemantics;
       // indicates wether last complation was successful.
       function compiled: boolean;
       // tries to execute the project output.
@@ -399,6 +401,8 @@ type
     function getCompilerPath(value: DCompiler; translateToWrapper: boolean): string;
     // Fills value with the runtime/phobos import paths for a particular D compiler.
     procedure getCompilerImports(value: DCompiler; paths: TStrings);
+    // Retrieves the global compiler actual value
+    function transtlateGlobal: DCompiler;
   end;
 
   // Returns a string indicating which compiler will be used.

src/u_main.lfm

@@ -11,7 +11,6 @@ object MainForm: TMainForm
   OnDropFiles = FormDropFiles
   OnResize = FormResize
   ShowHint = True
-  LCLVersion = '2.2.0.1'
   object mainMenu: TMainMenu
     Top = 1
     object MenuItem1: TMenuItem
@@ -237,6 +236,9 @@ object MainForm: TMainForm
       object MenuItem35: TMenuItem
         Action = actProjCompAndRunWithArgs
       end
+      object MenuItem118: TMenuItem
+        Action = actProjCheckSema
+      end
       object MenuItem113: TMenuItem
         Action = actProjStopComp
       end
@@ -854,6 +856,11 @@ object MainForm: TMainForm
       Caption = 'Set persistent environment...'
       OnExecute = actProjSetEnvExecute
     end
+    object actProjCheckSema: TAction
+      Category = 'Project'
+      Caption = 'Check semantics'
+      OnExecute = actProjCheckSemaExecute
+    end
   end
   object ApplicationProperties1: TApplicationProperties
     OnActivate = ApplicationProperties1Activate

src/u_main.pas

@@ -117,6 +117,7 @@ type
     actFileCloseAll: TAction;
     actFileNewClip: TAction;
     actEdFormat: TAction;
+    actProjCheckSema: TAction;
     actProjSetEnv: TAction;
     actProjGitPull: TAction;
     actProjGitBranchesUpd: TAction;
@@ -184,6 +185,7 @@ type
     MenuItem115: TMenuItem;
     MenuItem116: TMenuItem;
     MenuItem117: TMenuItem;
+    MenuItem118: TMenuItem;
     mnuGitBranch: TMenuItem;
     mnuItemDubDialog: TMenuItem;
     mnuItemHelp: TMenuItem;
@@ -310,6 +312,7 @@ type
     procedure actLayoutResetExecute(Sender: TObject);
     procedure actNewGroupExecute(Sender: TObject);
     procedure actProjAddToGroupExecute(Sender: TObject);
+    procedure actProjCheckSemaExecute(Sender: TObject);
     procedure actProjDscanExecute(Sender: TObject);
     procedure actProjGitBranchesUpdExecute(Sender: TObject);
     procedure actProjGitPullExecute(Sender: TObject);
@@ -1466,6 +1469,7 @@ begin
   actFileDscanner.ImageIndex := i;
   actProjDscan.ImageIndex:= i;
   actFileMetricsHalstead.ImageIndex:=i;
+  actProjCheckSema.ImageIndex := i;
 
   i := loadIcon('DISK');
   actFileSave.ImageIndex:= i;
@@ -3593,6 +3597,11 @@ begin
   if InputQuery('Execution arguments', '', runargs) then
     fProj.run(runargs);
 end;
+
+procedure TMainForm.actProjCheckSemaExecute(Sender: TObject);
+begin
+  fProj.checkSemantics();
+end;
 {$ENDREGION}
 
 {$REGION view ------------------------------------------------------------------}