diff --git a/dastworx/src/halstead.d b/dastworx/src/halstead.d
index 29d2409d..2ad69319 100644
--- a/dastworx/src/halstead.d
+++ b/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];
diff --git a/lazproj/coedit.lpi b/lazproj/coedit.lpi
index b2b69da8..20c371e8 100644
--- a/lazproj/coedit.lpi
+++ b/lazproj/coedit.lpi
@@ -244,7 +244,7 @@
-
+
@@ -529,6 +529,10 @@
+
+
+
+
diff --git a/lazproj/coedit.lpr b/lazproj/coedit.lpr
index 4658c3af..55360a28 100644
--- a/lazproj/coedit.lpr
+++ b/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}
diff --git a/src/ce_halstead.pas b/src/ce_halstead.pas
new file mode 100644
index 00000000..80ce4972
--- /dev/null
+++ b/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.
+
diff --git a/src/ce_main.lfm b/src/ce_main.lfm
index bd099147..332ecbf2 100644
--- a/src/ce_main.lfm
+++ b/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
diff --git a/src/ce_main.pas b/src/ce_main.pas
index b993f477..1a452f5d 100644
--- a/src/ce_main.pas
+++ b/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 val.isNil then
+ if fDoc.isNil or not fDoc.isDSource 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;
- 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;
+ metrics.measure(fDoc);
end;
procedure TCEMainForm.actFileNewDubScriptExecute(Sender: TObject);