add option to detect main in runnable or unittested modules, close #79

src/ce_main.pas

@@ -465,6 +465,7 @@ type
     fDscanUnittests: boolean;
     fAutoSaveProjectFiles: boolean;
     fFlatLook: boolean;
+    fDetectMain: boolean;
     function getAdditionalPATH: string;
     procedure setAdditionalPATH(const value: string);
     function getDubCompiler: TCECompiler;
@@ -490,7 +491,7 @@ type
     property dscanUnittests: boolean read fDscanUnittests write fDscanUnittests default true;
     property autoSaveProjectFiles: boolean read fAutoSaveProjectFiles write fAutoSaveProjectFiles default false;
     property flatLook: boolean read fFlatLook write setFlatLook;
-
+    property detectMain: boolean read fDetectMain write fDetectMain;
 
     // published for ICEEditableOptions but stored by DCD wrapper since it reloads before CEMainForm
     property dcdPort: word read fDcdPort write fDcdPort stored false;
@@ -2252,9 +2253,12 @@ begin
     dmdproc.Parameters.AddText(fRunnableSw);
     if lst.isNotNil and (lst.Count <> 0) then
       dmdproc.Parameters.AddStrings(lst);
+    if fAppliOpts.detectMain and not fDoc.implementMain then
+      dmdproc.Parameters.Add('-main');
     if unittest then
     begin
-      dmdproc.Parameters.Add('-main');
+      if not fAppliOpts.detectMain then
+        dmdproc.Parameters.Add('-main');
       dmdproc.Parameters.Add('-unittest');
       if fCovModUt then
         dmdproc.Parameters.Add('-cov');

src/ce_synmemo.pas

@@ -5,10 +5,11 @@ unit ce_synmemo;
 interface
 
 uses
-  Classes, SysUtils, controls,lcltype, Forms, graphics, ExtCtrls, crc,
+  Classes, SysUtils, controls,lcltype, Forms, graphics, ExtCtrls, crc, process,
   SynEdit, SynPluginSyncroEdit, SynCompletion, SynEditKeyCmds, LazSynEditText,
   SynHighlighterLFM, SynEditHighlighter, SynEditMouseCmds, SynEditFoldedView,
   SynEditMarks, SynEditTypes, SynHighlighterJScript, SynBeautifier, dialogs,
+  fpjson, jsonparser,
   ce_common, ce_observer, ce_writableComponent, ce_d2syn, ce_txtsyn, ce_dialogs,
   ce_sharedres, ce_dlang, ce_stringrange;
 
@@ -215,6 +216,7 @@ type
     procedure nextChangedArea;
     procedure previousChangedArea;
     procedure copy;
+    function implementMain: boolean;
     //
     function breakPointsCount: integer;
     function breakPointLine(index: integer): integer;
@@ -1288,6 +1290,76 @@ begin
     ExecuteCommand(ecGotoXY, #0, @p);
   end;
 end;
+
+function TCESynMemo.implementMain: boolean;
+  function search(root: TJSONData): boolean;
+  var
+    i: integer;
+    p: TJSONData;
+  begin
+    if root.isNil then
+      exit(false);
+    root := root.FindPath('members');
+    if root.isNil then
+      exit(false);
+    for i := 0 to root.Count-1 do
+    begin
+      p := root.Items[i].FindPath('kind');
+      if p.isNotNil and (p.AsString = 'function') then
+      begin
+        p := root.Items[i].FindPath('name');
+        if p.isNotNil and (p.AsString = 'main') then
+          exit(true);
+      end;
+      if search(root.Items[i]) then
+        exit(true);
+    end;
+    exit(false);
+  end;
+var
+  prc: TProcess;
+  jfn: string;
+  jdt: string;
+begin
+  if fileName.fileExists then
+    save
+  else
+    saveTempFile;
+  jfn := tempFilename + '.json';
+  prc := TProcess.Create(nil);
+  try
+    prc.Executable:= 'dmd' + exeExt;
+    prc.Parameters.Add(fileName);
+    prc.Parameters.Add('-c');
+    prc.Parameters.Add('-o-');
+    prc.Parameters.Add('-Xf' + jfn);
+    prc.Execute;
+    while prc.Running do Sleep(5);
+  finally
+    prc.Free;
+  end;
+  if not jfn.fileExists then
+    exit(false);
+  with TMemoryStream.Create do
+  try
+    LoadFromFile(jfn);
+    setLength(jdt, size);
+    read(jdt[1], size);
+  finally
+    free;
+    DeleteFile(jfn);
+  end;
+  with TJSONParser.Create(jdt) do
+  try
+    try
+      result := search(Parse.Items[0]);
+    except
+      exit(false);
+    end;
+  finally
+    free;
+  end;
+end;
 {$ENDREGION}
 
 {$REGION DDoc & CallTip --------------------------------------------------------}