#104, add option cat. for the metrics + put ana in separate unit

dastworx/src/halstead.d

@@ -9,6 +9,11 @@ import
 version(unittest){} else import
     common;
 
+/**
+ * Retrieves the count and unique count of the operands and operators of
+ * each function (inc. methods) of a module. After the call the results are
+ * serialized as JSON in te standard output.
+ */
 void performHalsteadMetrics(const(Module) mod)
 {
     HalsteadMetric hm = construct!(HalsteadMetric);
@@ -91,7 +96,7 @@ private final class HalsteadMetric: ASTVisitor
 
         version(unittest)
         {
-            import std.stdio;
+            import std.stdio: writeln;
             writeln(functions[$-1]);
             writeln('\t',operators);
             writeln('\t',operands);
@@ -479,7 +484,6 @@ version(unittest)
 
     Function test(string source)
     {
-        import std.typecons;
         HalsteadMetric hm = parseAndVisit!(HalsteadMetric)(source);
         scope(exit) destruct(hm);
         return hm.functions[$-1];

lazproj/coedit.lpi

@@ -244,7 +244,7 @@
         <PackageName Value="LCL"/>
       </Item7>
     </RequiredPackages>
-    <Units Count="55">
+    <Units Count="56">
       <Unit0>
         <Filename Value="coedit.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -529,6 +529,10 @@
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
       </Unit54>
+      <Unit55>
+        <Filename Value="..\src\ce_halstead.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit55>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

lazproj/coedit.lpr

@@ -12,7 +12,7 @@ uses
   ce_dockoptions, ce_shortcutseditor, ce_mru, ce_processes,
   ce_dialogs, ce_dubprojeditor, ce_controls, ce_dfmt, ce_lcldragdrop,
   ce_stringrange, ce_dlangmaps, ce_projgroup, ce_projutils, ce_d2synpresets,
-  ce_dastworx, ce_dbgitf, ce_ddemangle, ce_dubproject;
+  ce_dastworx, ce_dbgitf, ce_ddemangle, ce_dubproject, ce_halstead;
 
 {$R *.res}
 

src/ce_halstead.pas

@@ -0,0 +1,288 @@
+unit ce_halstead;
+
+{$I ce_defines.inc}
+
+interface
+
+uses
+  Classes, SysUtils, xfpjson, math,
+  ce_common, ce_observer, ce_interfaces, ce_dastworx, ce_writableComponent,
+  ce_synmemo;
+
+type
+
+  TBugCountMethod = (pow23div3000, div3000);
+
+  THalsteadMetricsBase = class(TWritableLfmTextComponent)
+  private
+    fMaxBugsPerFunction: single;
+    fMaxBugsPerModule: single;
+    fMaxVolumePerFunction: integer;
+    fShowAllResults: boolean;
+    fBugCountMethod: TBugCountMethod;
+    procedure setMaxBugsPerFunction(value: single);
+    procedure setMaxBugsPerModule(value: single);
+    procedure setMaxVolumePerFunction(value: integer);
+  published
+    property maxBugsPerFunction: single read fMaxBugsPerFunction write setMaxBugsPerFunction;
+    property maxBugsPerModule: single read fMaxBugsPerModule write setMaxBugsPerModule;
+    property maxVolumePerFunction: integer read fMaxVolumePerFunction write setMaxVolumePerFunction;
+    property showAllResults: boolean read fShowAllResults write fShowAllResults default false;
+    property bugCountMethod: TBugCountMethod read fBugCountMethod write fBugCountMethod default pow23div3000;
+  public
+    constructor create(aOwner: TComponent); override;
+    procedure assign(value: TPersistent); override;
+  end;
+
+  THalsteadMetrics = class(THalsteadMetricsBase, ICEEditableOptions)
+  private
+    fBackup: THalsteadMetricsBase;
+    fMsgs: ICEMessagesDisplay;
+    function optionedWantCategory(): string;
+    function optionedWantEditorKind: TOptionEditorKind;
+    function optionedWantContainer: TPersistent;
+    procedure optionedEvent(event: TOptionEditorEvent);
+    function optionedOptionsModified: boolean;
+  public
+    constructor create(aOwner: TComponent); override;
+    destructor destroy; override;
+    procedure measure(document: TCESynMemo);
+  end;
+
+  function metrics: THalsteadMetrics;
+
+implementation
+
+var
+  fMetrics: THalsteadMetrics = nil;
+const
+  optFname = 'metrics.txt';
+
+function metrics: THalsteadMetrics;
+begin
+  if fMetrics.isNil then
+    fMetrics := THalsteadMetrics.create(nil);
+  result := fMetrics;
+end;
+
+constructor THalsteadMetricsBase.create(aOwner: TComponent);
+begin
+  inherited;
+  fMaxBugsPerFunction:= 0.5;
+  fMaxBugsPerModule:= 2;
+  fMaxVolumePerFunction:= 1000;
+end;
+
+procedure THalsteadMetricsBase.assign(value: TPersistent);
+var
+  s: THalsteadMetricsBase;
+begin
+  if value is THalsteadMetricsBase then
+  begin
+    s := THalsteadMetricsBase(value);
+    fMaxBugsPerFunction:=s.fMaxBugsPerFunction;
+    fMaxBugsPerModule:=s.fMaxBugsPerModule;
+    fMaxVolumePerFunction:=s.fMaxVolumePerFunction;
+    fShowAllResults:=s.fShowAllResults;
+    fBugCountMethod:=s.fBugCountMethod;
+  end
+  else inherited;
+end;
+
+procedure THalsteadMetricsBase.setMaxBugsPerFunction(value: single);
+begin
+  if value < 0 then
+    value := 0;
+  fMaxBugsPerFunction:=value;
+end;
+
+procedure THalsteadMetricsBase.setMaxBugsPerModule(value: single);
+begin
+  if value < 0 then
+    value := 0;
+  fMaxBugsPerModule:=value;
+end;
+
+procedure THalsteadMetricsBase.setMaxVolumePerFunction(value: integer);
+begin
+  if value < 0 then
+    value := 0;
+  fMaxVolumePerFunction:=value;
+end;
+
+constructor THalsteadMetrics.create(aOwner: TComponent);
+var
+  f: string;
+begin
+  inherited;
+  fBackup:= THalsteadMetricsBase.create(self);
+  f := getCoeditDocPath + optFname;
+  if f.fileExists then
+    loadFromFile(f);
+  fBackup.assign(self);
+  EntitiesConnector.addObserver(self);
+end;
+
+destructor THalsteadMetrics.destroy;
+begin
+  EntitiesConnector.removeObserver(self);
+  saveTofile(getCoeditDocPath + optFname);
+  inherited;
+end;
+
+function THalsteadMetrics.optionedWantCategory(): string;
+begin
+  exit('Code metrics');
+end;
+
+function THalsteadMetrics.optionedWantEditorKind: TOptionEditorKind;
+begin
+  exit(oekGeneric);
+end;
+
+function THalsteadMetrics.optionedWantContainer: TPersistent;
+begin
+  fBackup.assign(self);
+  exit(self);
+end;
+
+procedure THalsteadMetrics.optionedEvent(event: TOptionEditorEvent);
+begin
+  case event of
+    oeeAccept: fBackup.assign(self);
+    oeeCancel: assign(fBackup);
+  end;
+end;
+
+function THalsteadMetrics.optionedOptionsModified: boolean;
+begin
+  exit(false);
+end;
+
+procedure THalsteadMetrics.Measure(document: TCESynMemo);
+
+  function checkFunction(const obj: TJSONObject; var bugsSum: single): boolean;
+  var
+    n1, sn1, n2, sn2: integer;
+    val: TJSONData;
+    voc, len, line: integer;
+    vol, dif, eff: single;
+    cpl, bgs: single;
+    vwn: boolean;
+    bwn: boolean;
+  const
+    bgt: array[boolean] of TCEAppMessageKind = (amkInf, amkWarn);
+  begin
+    result := true;
+    val := obj.Find('n1Count');
+    if val.isNil then
+      exit;
+    n1  := val.AsInteger;
+
+    val := obj.Find('n1Sum');
+    if val.isNil then
+      exit;
+    sn1 := val.AsInteger;
+
+    val := obj.Find('n2Count');
+    if val.isNil then
+      exit;
+    n2  := val.AsInteger;
+
+    val := obj.Find('n2Sum');
+    if val.isNil then
+      exit;
+    sn2 := val.AsInteger;
+
+    val := obj.Find('line');
+    if val.isNil then
+      exit;
+    line := val.AsInteger;
+    val := obj.Find('name');
+    if val.isNil then
+      exit;
+
+    voc := max(1, n1 + n2);
+    len := max(1, sn1 + sn2);
+    cpl := n1*log2(n1) + n2*log2(n2);
+    vol := len * log2(voc);
+    dif := n1 * 0.5 * (sn2 / n2);
+    eff := dif * vol;
+    case fBugCountMethod of
+      pow23div3000: bgs := power(eff, 0.666667) / 3000;
+      div3000: bgs := eff / 3000;
+    end;
+
+    bugsSum += bgs;
+
+    vwn := (fMaxVolumePerFunction <> 0) and not IsNan(vol) and (vol >= fMaxVolumePerFunction);
+    bwn := (fMaxBugsPerFunction <> 0) and not IsNan(bgs) and (bgs >= fMaxBugsPerFunction);
+    result := not vwn and not bwn;
+
+    if fShowAllResults or not result then
+    begin
+      fMsgs.message(format('%s(%d): metrics for "%s"',
+        [document.fileName, line, val.AsString]), document, amcEdit, amkInf);
+
+      fMsgs.message(format('    Vocabulary: %d', [voc]), document, amcEdit, amkInf);
+      fMsgs.message(format('    Length: %d', [len]), document, amcEdit, amkInf);
+      fMsgs.message(format('    Calculated program length: %f', [cpl]), document, amcEdit, amkInf);
+      fMsgs.message(format('    Volume: %.2f', [vol]), document, amcEdit, bgt[vwn]);
+      fMsgs.message(format('    Error proneness: %.2f', [dif]), document, amcEdit, amkInf);
+      fMsgs.message(format('    Implementation effort: %.2f', [eff]), document, amcEdit, amkInf);
+      fMsgs.message(format('    Implementation Time: %.2f secs.', [eff / 18]), document, amcEdit, amkInf);
+      fMsgs.message(format('    Estimated bugs: %.2f', [bgs]), document, amcEdit, bgt[bwn]);
+    end;
+  end;
+
+var
+  jsn: TJSONObject = nil;
+  fnc: TJSONObject = nil;
+  val: TJSONData;
+  arr: TJSONArray;
+  bgS: single = 0;
+  noW: boolean = true;
+  fnW: boolean;
+  i: integer;
+begin
+  if not fShowAllResults
+  and ((maxBugsPerFunction = 0) and (maxBugsPerModule = 0) and (maxVolumePerFunction = 0)) then
+    exit;
+
+  if not assigned(fMsgs) then
+    fMSgs := getMessageDisplay;
+
+  getHalsteadMetrics(document.Lines, jsn);
+  if jsn.isNil then
+    exit;
+
+  val := jsn.Find('functions');
+  if val.isNil or (val.JSONType <> jtArray) then
+    exit;
+  arr := TJSONArray(val);
+  for i := 0 to arr.Count-1 do
+  begin
+    fnc := TJSONObject(arr.Objects[i]);
+    if fnc.isNotNil then
+    begin
+      fnW := checkFunction(fnc, bgS);
+      noW := noW and fnW;
+    end;
+  end;
+
+  if (fMaxBugsPerModule <> 0) and (bgS >= fMaxBugsPerModule) then
+    fMsgs.message(format('The estimated number of bugs (%.2f) in this module exceeds the limit', [bgS]),
+      document, amcEdit, amkWarn)
+  else if noW then
+    fMsgs.message('No abnormal values in the code metrics',
+      document, amcEdit, amkInf);
+
+  jsn.Free;
+end;
+
+initialization
+  fMetrics := THalsteadMetrics.create(nil);
+finalization
+  fMetrics.Free;
+end.
+

src/ce_main.lfm

@@ -1468,7 +1468,7 @@ object CEMainForm: TCEMainForm
   OnCloseQuery = FormCloseQuery
   OnDropFiles = FormDropFiles
   ShowHint = True
-  LCLVersion = '1.6.0.4'
+  LCLVersion = '1.6.2.0'
   object mainMenu: TMainMenu
     Images = imgList
     top = 1
@@ -2389,6 +2389,42 @@ object CEMainForm: TCEMainForm
       end
       object MenuItem77: TMenuItem
         Action = actFileMetricsHalstead
+        Bitmap.Data = {
+          36040000424D3604000000000000360000002800000010000000100000000100
+          2000000000000004000064000000640000000000000000000000000000000000
+          0000000000000000000000000000000000000000000000000033000000000000
+          00330000003300000000000000000000000000000000000000002178AD002178
+          AD002178AD002178AD002178AD002177AC00000000332270B3FF00000033008A
+          48FF008A4AFF00000033008E4E00008D4D0000A3620000A160002178AD002178
+          AD002178AD002178AD002177AD00000000331E6EAAFF6FF0FFFF00843CFF00E2
+          9BFF00E39CFF008647FF00000033008C4D0000A3620000A160002178AD002178
+          AD002178AD002177AC00000000331D6FA8FF6DEDFFFF008234FF00E096FF00DE
+          97FF00DE97FF00E29BFF008646FF0000003300A2610000A160002178AD002178
+          AD002177AC00000000331C6EA5FF51C7F9FF00822CFF00E394FF00E196FF007F
+          38FF007F38FF00E096FF00E19BFF008445FF0000003300A160002178AD002177
+          AC00000000331B6DA3FF6BE6FFFF4DD6FFFF52D8FFFF008536FF008334FF55D7
+          FFFF71E1FFFF007E32FF00DF95FF00E09AFF009C5BFF000000332077AC000000
+          00331B6DA3FF4EC1F0FF45D1FFFF45CEFFFF47D4FFFF31351CFF33C1DAFF48D0
+          FFFF47CFFFFF48C2D9FF009648FF00E095FF00E49CFF009F5DFF00000033196D
+          A3FF6FE2FFFF3ECCFFFF3FC9FFFF3FC9FFFF3FCEFFFF3FD3FFFF40CEFFFF3FCA
+          FFFF3FC8FFFF40CAFFFF73DCFFFF008231FF00883CFF00A457001C73A8FF9BF5
+          FFFF36C8FFFF39C4FFFF3BC4FFFF3BC6FFFF39CCFFFF643F30FF39CCFFFF3BC6
+          FFFF3BC4FFFF39C4FFFF38C7FFFF9EF2FFFF206FB1FF2473B5001E75AA00196D
+          A3FF78E0FFFF32C1FFFF34C0FFFF35C2FFFF34CAFFFF563529FF34CAFFFF35C2
+          FFFF34C0FFFF32C1FFFF78E0FFFF196DA4FF1F75AB002177AE002077AC001E74
+          A9001A6DA2FF7CDFFFFF2CBDFFFF2FBEFFFF2FC6FFFF492A1CFF2FC6FFFF2EBE
+          FFFF2CBDFFFF7CDFFFFF1A6DA2FF1E74A9002077AC002178AD002178AD002177
+          AC001E74A9001A6EA2FF7EDFFFFF29BBFFFF2AC0FFFF3C1808FF2AC0FFFF27BA
+          FFFF7DDEFFFF1A6DA2FF1E74A9002177AC002178AD002178AD002178AD002178
+          AD002177AC001E75AA001B6FA3FF52B8F1FF22B9FFFF22BAFFFF21B8FFFF81DD
+          FFFF1A6DA2FF1E74A9002177AC002178AD002178AD002178AD002178AD002178
+          AD002178AD002178AC001F75AA001B6FA3FF83DCFFFF16B2FFFF82DBFFFF1A6E
+          A2FF1E74A9002177AC002178AD002178AD002178AD002178AD002178AD002178
+          AD002178AD002178AD002177AC001E75AA00186EA4FFD0F9FFFF186EA3FF1E75
+          A9002177AC002178AD002178AD002178AD002178AD002178AD002178AD002178
+          AD002178AD002178AD002178AD002077AC001E75AA001B73A8FF1E75AA002077
+          AC002178AD002178AD002178AD002178AD002178AD002178AD00
+        }
       end
       object MenuItem60: TMenuItem
         Action = actFileOpenContFold

src/ce_main.pas

@@ -7,7 +7,7 @@ interface
 uses
   Classes, SysUtils, LazFileUtils, SynEditKeyCmds, SynHighlighterLFM, Forms,
   StdCtrls, AnchorDocking, AnchorDockStorage, AnchorDockOptionsDlg, Controls,
-  Graphics, strutils, Dialogs, Menus, ActnList, ExtCtrls, process, math,
+  Graphics, strutils, Dialogs, Menus, ActnList, ExtCtrls, process,
   {$IFDEF WINDOWS}Windows, {$ENDIF} XMLPropStorage, SynExportHTML, fphttpclient,
   xfpjson, xjsonparser, xjsonscanner,
   ce_common, ce_dmdwrap, ce_ceproject, ce_synmemo, ce_writableComponent,
@@ -15,7 +15,8 @@ uses
   ce_search, ce_miniexplorer, ce_libman, ce_libmaneditor, ce_todolist, ce_observer,
   ce_toolseditor, ce_procinput, ce_optionseditor, ce_symlist, ce_mru, ce_processes,
   ce_infos, ce_dubproject, ce_dialogs, ce_dubprojeditor,{$IFDEF UNIX} ce_gdb,{$ENDIF}
-  ce_dfmt, ce_lcldragdrop, ce_projgroup, ce_projutils, ce_stringrange, ce_dastworx;
+  ce_dfmt, ce_lcldragdrop, ce_projgroup, ce_projutils, ce_stringrange, ce_dastworx,
+  ce_halstead;
 
 type
 
@@ -2876,86 +2877,10 @@ begin
 end;
 
 procedure TCEMainForm.actFileMetricsHalsteadExecute(Sender: TObject);
-procedure computeMetrics(const obj: TJSONObject);
-var
-  n1, sn1, n2, sn2: integer;
-  val: TJSONData;
-  voc, len, line: integer;
-  vol, dif, eff: single;
-  bgs: single;
-const
-  bgt: array[boolean] of TCEAppMessageKind = (amkInf, amkWarn);
 begin
-  val := obj.Find('n1Count');
+  if fDoc.isNil or not fDoc.isDSource then
-  if val.isNil then
     exit;
-  n1  := val.AsInteger;
+  metrics.measure(fDoc);
-
-  val := obj.Find('n1Sum');
-  if val.isNil then
-    exit;
-  sn1 := val.AsInteger;
-
-  val := obj.Find('n2Count');
-  if val.isNil then
-    exit;
-  n2  := val.AsInteger;
-
-  val := obj.Find('n2Sum');
-  if val.isNil then
-    exit;
-  sn2 := val.AsInteger;
-
-  val := obj.Find('line');
-  if val.isNil then
-    exit;
-  line := val.AsInteger;
-  val := obj.Find('name');
-  if val.isNil then
-    exit;
-  fMsgs.message(format('%s(%d): Halstead metrics for "%s"',
-    [fDoc.fileName, line, val.AsString]), fDoc, amcEdit, amkInf);
-
-  voc := n1 + n2;
-  len := sn1 + sn2;
-  vol := len * log2(voc);
-  dif := n1 * 0.5 * (sn2 / n2);
-  eff := dif * vol;
-  bgs := power(eff, 0.666667) / 3000;
-
-  fMsgs.message(format('    Vocabulary: %d', [voc]), fDoc, amcEdit, amkInf);
-  fMsgs.message(format('    Length: %d', [len]), fDoc, amcEdit, amkInf);
-  fMsgs.message(format('    Calculated program length: %f', [n1*log2(n1) + n2*log2(n2)]), fDoc, amcEdit, amkInf);
-  fMsgs.message(format('    Volume: %.2f', [vol]), fDoc, amcEdit, amkInf);
-  fMsgs.message(format('    Difficulty to review: %.2f', [dif]), fDoc, amcEdit, amkInf);
-  fMsgs.message(format('    Effort: %.2f', [eff]), fDoc, amcEdit, amkInf);
-  fMsgs.message(format('    Time required: %.2f secs.', [eff / 18]), fDoc, amcEdit, amkInf);
-  fMsgs.message(format('    Estimated bugs: %.2f', [bgs]), fDoc, amcEdit, bgt[bgs >= 0.25]);
-end;
-var
-  jsn: TJSONObject = nil;
-  fnc: TJSONObject = nil;
-  val: TJSONData;
-  arr: TJSONArray;
-  i: integer;
-begin
-  if fDoc.isNil then
-    exit;
-
-  getHalsteadMetrics(fDoc.Lines, jsn);
-  if jsn.isNil then
-    exit;
-  val := jsn.Find('functions');
-  if val.isNil or (val.JSONType <> jtArray) then
-    exit;
-  arr := TJSONArray(val);
-  for i := 0 to arr.Count-1 do
-  begin
-    fnc := TJSONObject(arr.Objects[i]);
-    if fnc.isNotNil then
-      computeMetrics(fnc);
-  end;
-  jsn.Free;
 end;
 
 procedure TCEMainForm.actFileNewDubScriptExecute(Sender: TObject);