Enh: Parse class interfaces and very basic analysis

.gitignore

@@ -6,3 +6,5 @@ Tests/Tests.dproj.local
 *.res
 *.local
 *.stat
+*.identcache
+*.dsk

DelphiClass.pas

@@ -0,0 +1,40 @@
+unit DelphiClass;
+
+interface
+
+uses
+  Classes;
+
+type
+  TDelphiClass = class
+  private
+    fName    : String;
+    fRoutines: TStringList;
+  public
+    constructor Create(Name: String);
+    destructor Destroy; override;
+
+    property Name : String read fName;
+    property Routines: TStringList read fRoutines;
+  end;
+
+implementation
+
+uses
+  SysUtils;
+
+{ TDelphiClass }
+
+constructor TDelphiClass.Create(Name: String);
+begin
+  fName:=Name;
+  fRoutines:=TStringList.Create;
+end;
+
+destructor TDelphiClass.Destroy;
+begin
+  FreeAndNil(fRoutines);
+  inherited;
+end;
+
+end.

DelphiProject.pas

@@ -53,7 +53,7 @@ implementation
 uses
   System.Generics.Defaults,
   System.IOUtils,
-  SysUtils;
+  SysUtils, DelphiClass;
 
 { TDelphiProject }
 
@@ -255,6 +255,8 @@ procedure TDelphiProject.ParseUnit(U: TDelphiUnit; FileName: String; Depth: Inte
     end;
   end;
 
+var
+  CurrentClass: TDelphiClass;
 begin
   if U.Parsed then
     Exit;
@@ -277,9 +279,24 @@ procedure TDelphiProject.ParseUnit(U: TDelphiUnit; FileName: String; Depth: Inte
       ParseUsesClause(U.InterfaceUses);
 
     //Lex.SkipTo('implementation');
-
     while not Lex.OptionalSym('implementation') do
     begin
+      if Lex.SymbolIs('class') then
+      begin
+        CurrentClass:=TDelphiClass.Create(Lex.PreviousSym(1));
+        Lex.GetSym;
+        U.InterfaceClasses.Add(CurrentClass);
+        while not Lex.OptionalSym('end') do
+        begin
+          if Lex.OptionalSym('procedure') and not Lex.OptionalSym('(') then
+            CurrentClass.Routines.Add('procedure ' + GetQualifiedName)
+          else if Lex.OptionalSym('function') and not Lex.OptionalSym('(') then
+            CurrentClass.Routines.Add('function ' + GetQualifiedName)
+          else
+            Lex.GetSym;
+        end;
+      end;
+
       if Lex.OptionalSym('procedure') and not Lex.OptionalSym('(') then
         U.InterfaceRoutines.Add('procedure ' + GetQualifiedName)
       else if Lex.OptionalSym('function') and not Lex.OptionalSym('(') then

DelphiUnit.pas

@@ -5,7 +5,8 @@ interface
 uses
   System.Generics.Defaults,
   System.Generics.Collections,
-  System.Classes;
+  System.Classes,
+  DelphiClass;
 
 type
 
@@ -20,6 +21,7 @@ interface
     duWeighting,
     duDepth,
     duDepthDiff,
+    duClasses,
     duRoutines,
     duIntfDependency,
     duImplDependency,
@@ -43,6 +45,7 @@   TDelphiUnit = class
     fContainsCycles         : TLazyBool;
     fInterfaceUses          : TObjectList<TDelphiUnit>;
     fInterfaceRoutines      : TStringList;
+    fInterfaceClasses       : TObjectList<TDelphiClass>;
     fImplementationUses     : TObjectList<TDelphiUnit>;
 
     fRefsFromInterfaces     : TObjectList<TDelphiUnit>;  // other units referring to me form their Interface
@@ -76,19 +79,20 @@   TDelphiUnit = class
 
     function DepthDifferential: Integer;
 
-    property Name                   : String                   read fName      write fName;
-    property FileName               : String                   read fFileName  write fFileName;
-    property Depth                  : Integer                  read fDepth     write fDepth;
-    property LineCount              : Integer                  read fLineCount write fLineCount;
-    property Parsed                 : Boolean                  read fParsed    write fParsed;
-    property ContainsCycles         : Boolean                  read GetContainsCycles;
-    property MaxDependency          : Integer                  read GetMaxDependency;
-    property MaxInterfaceDependency : Integer                  read GetMaxInterfaceDependency;
-    property InterfaceUses          : TObjectList<TDelphiUnit> read fInterfaceUses;
-    property InterfaceRoutines      : TStringList              read fInterfaceRoutines;
-    property ImplementationUses     : TObjectList<TDelphiUnit> read fImplementationUses;
-    property RefsFromInterfaces     : TObjectList<TDelphiUnit> read fRefsFromInterfaces ;
-    property RefsFromImplementations: TObjectList<TDelphiUnit> read fRefsFromImplementations;
+    property Name                   : String                    read fName      write fName;
+    property FileName               : String                    read fFileName  write fFileName;
+    property Depth                  : Integer                   read fDepth     write fDepth;
+    property LineCount              : Integer                   read fLineCount write fLineCount;
+    property Parsed                 : Boolean                   read fParsed    write fParsed;
+    property ContainsCycles         : Boolean                   read GetContainsCycles;
+    property MaxDependency          : Integer                   read GetMaxDependency;
+    property MaxInterfaceDependency : Integer                   read GetMaxInterfaceDependency;
+    property InterfaceUses          : TObjectList<TDelphiUnit>  read fInterfaceUses;
+    property InterfaceClasses       : TObjectList<TDelphiClass> read fInterfaceClasses;
+    property InterfaceRoutines      : TStringList               read fInterfaceRoutines;
+    property ImplementationUses     : TObjectList<TDelphiUnit>  read fImplementationUses;
+    property RefsFromInterfaces     : TObjectList<TDelphiUnit>  read fRefsFromInterfaces ;
+    property RefsFromImplementations: TObjectList<TDelphiUnit>  read fRefsFromImplementations;
   end;
 
   TDelphiUnitComparer = class(TComparer<TDelphiUnit>)
@@ -121,6 +125,7 @@ procedure TDelphiUnit.Clear;
   fMaxDependency:=-1;
   fContainsCycles:=lbNotCalculated;
   fInterfaceUses.Clear;
+  fInterfaceClasses.Clear;
   fInterfaceRoutines.Clear;
   fImplementationUses.Clear;
   fRefsFromInterfaces.Clear;
@@ -136,9 +141,10 @@ constructor TDelphiUnit.Create;
   fLineCount:=0;
   fMaxInterfaceDependency:=-1;
   fMaxDependency:=-1;
-  fContainsCycles          :=lbNotCalculated;
+  fContainsCycles          := lbNotCalculated;
   fInterfaceUses           := TObjectList<TDelphiUnit>.Create(False);
-  fInterfaceRoutines       :=TStringList.Create;
+  fInterfaceClasses        := TObjectList<TDelphiClass>.Create(True);
+  fInterfaceRoutines       := TStringList.Create;
   fImplementationUses      := TObjectList<TDelphiUnit>.Create(False);
   fRefsFromInterfaces      := TObjectList<TDelphiUnit>.Create(False);
   fRefsFromImplementations := TObjectList<TDelphiUnit>.Create(False);
@@ -160,6 +166,7 @@ function TDelphiUnit.DepthDifferential: Integer;
 destructor TDelphiUnit.Destroy;
 begin
   FreeAndNil(fInterfaceUses);
+  FreeAndNil(fInterfaceClasses);
   FreeAndNil(fInterfaceRoutines);
   FreeAndNil(fImplementationUses);
   FreeAndNil(fRefsFromInterfaces);
@@ -357,6 +364,7 @@ class function TDelphiUnit.UnitContainsCycles(UnitToProcess: TDelphiUnit): Boole
 procedure TDelphiUnit.GetStatDetails(StatType: TDelphiUnitStatType; Strings: TStrings);
 var
   U: TDelphiUnit;
+  C: TDelphiClass;
 begin
   Strings.Clear;
   case StatType of
@@ -374,6 +382,8 @@ procedure TDelphiUnit.GetStatDetails(StatType: TDelphiUnitStatType; Strings: TSt
     duWeighting     : Strings.AddObject(IntToStr(Weighting), Self);
     duDepth         : Strings.AddObject(IntToStr(Depth), Self);
     duDepthDiff     : Strings.AddObject(IntToStr(DepthDifferential), Self);
+    duClasses       : for C in fInterfaceClasses do
+                        Strings.AddObject(C.Name + ': ' + IntToStr(C.Routines.Count) + ' routines', C);
     duRoutines      : Strings.Assign(InterfaceRoutines);
     duIntfDependency: GetDependencyTree(Self, Strings, dufInterfacesOnly, 0, 10);
     duImplDependency: GetDependencyTree(Self, Strings, dufAll, 0, 10);
@@ -454,6 +464,7 @@ function TDelphiUnitComparer.Compare(const Left, Right: TDelphiUnit): Integer;
     duWeighting     : Result := CompareIntegers(Left.Weighting, Right.Weighting);
     duDepth         : Result := CompareIntegers(Left.Depth, Right.Depth);
     duDepthDiff     : Result := CompareIntegers(Left.DepthDifferential, Right.DepthDifferential);
+    duClasses       : Result := CompareIntegers(Left.InterfaceClasses.Count, Right.InterfaceClasses.Count);
     duRoutines      : Result := CompareIntegers(Left.InterfaceRoutines.Count, Right.InterfaceRoutines.Count);
     duIntfDependency: Result := CompareIntegers(Left.MaxInterfaceDependency, Right.MaxInterfaceDependency);
     duImplDependency: Result := CompareIntegers(Left.MaxDependency, Right.MaxDependency);

LexicalAnalyser.pas

@@ -12,7 +12,8 @@     TLexicalAnalyser = class
     private
       fText     : String;
       fPos      : Integer;
-      fPrev     : String;
+      fPrevPrev : String; // 2 symbols back
+      fPrev     : String; // 1 symbols back
       fSym      : string;
       fCh       : Char;
       fLineNo   : Integer;
@@ -22,7 +23,6 @@     TLexicalAnalyser = class
       procedure GetCh;
       procedure GetASym;
       procedure ShowError(S: String);
-      function SymbolIs(S: String): Boolean;
       function TextBetween(Start: Integer; Finish: Integer): String;
       function LineStart: Integer;
       function LineEnd: Integer;
@@ -31,11 +31,13 @@     TLexicalAnalyser = class
       constructor CreateFromFile(FileName: String);
       constructor CreateFromString(S: String);
 
-      function CurrentSym: String;
-      function GetSym: String;
+      function  CurrentSym: String;
+      function  PreviousSym(SymbolsAgo: Integer): String;
+      function  GetSym: String;
 
-      function AtEnd: Boolean;
+      function  AtEnd: Boolean;
 
+      function  SymbolIs(S: String): Boolean;
       procedure RequiredSym(S: String);
       function  OptionalSym(S: String): Boolean;
       procedure SkipToEof;
@@ -298,6 +300,7 @@ function TLexicalAnalyser.GetSym: String;
 begin
   if fSym = #0 then
     raise Exception.Create('GetSym: EOF!!! previous was: ' + fSym);
+  fPrevPrev:=fPrev;
   fPrev:=fSym;
   GetASym;
   Result:=fSym;
@@ -372,4 +375,13 @@ function TLexicalAnalyser.OptionalSym(S: String): Boolean;
   end
 end;
 
+function TLexicalAnalyser.PreviousSym(SymbolsAgo: Integer): String;begin
+  if SymbolsAgo = 0 then
+    Result:=fPrev
+  else if SymbolsAgo = 1 then
+    Result:=fPrevPrev
+  else
+    raise Exception.Create('PreviousSym: too far back!');
+end;
+
 end.

Main.dfm

@@ -27,6 +27,10 @@ object FormMain: TFormMain
     OnChange = PageControl1Change
     object TabSheetSettings: TTabSheet
       Caption = 'Project Settings'
+      ExplicitLeft = 0
+      ExplicitTop = 0
+      ExplicitWidth = 0
+      ExplicitHeight = 0
       object PanelDPIFudge: TPanel
         Left = 0
         Top = 0
@@ -138,6 +142,10 @@ object FormMain: TFormMain
     object TabSheetStatistics: TTabSheet
       Caption = 'Statistics'
       ImageIndex = 2
+      ExplicitLeft = 0
+      ExplicitTop = 0
+      ExplicitWidth = 0
+      ExplicitHeight = 0
       object PanelDPIFudgeStats: TPanel
         Left = 0
         Top = 0
@@ -221,6 +229,10 @@ object FormMain: TFormMain
     object TabSheetGEXF: TTabSheet
       Caption = 'GEXF'
       ImageIndex = 3
+      ExplicitLeft = 0
+      ExplicitTop = 0
+      ExplicitWidth = 0
+      ExplicitHeight = 0
       object PanelFudgeGEXF: TPanel
         Left = 0
         Top = 0
@@ -278,6 +290,10 @@ object FormMain: TFormMain
     object TabSheetIgnoredFiles: TTabSheet
       Caption = 'Ignored Files'
       ImageIndex = 4
+      ExplicitLeft = 0
+      ExplicitTop = 0
+      ExplicitWidth = 0
+      ExplicitHeight = 0
       object PanelFudgeIgnore: TPanel
         Left = 0
         Top = 0
@@ -317,6 +333,10 @@ object FormMain: TFormMain
     object TabSheetLog: TTabSheet
       Caption = 'Log'
       ImageIndex = 1
+      ExplicitLeft = 0
+      ExplicitTop = 0
+      ExplicitWidth = 0
+      ExplicitHeight = 0
       object MemoLog: TMemo
         Left = 0
         Top = 0

Main.pas

@@ -106,11 +106,12 @@ implementation
   cStatsColWeighting      = 6;
   cStatsColDepth          = 7;
   cStatsColDepthDiff      = 8;
-  cStatsColIntfProcs      = 9;
-  cStatsColIntfDependency = 10;
-  cStatsColImplDependency = 11;
-  cStatsColCyclic         = 12;
-  cStatsColFileName       = 13;
+  cStatsColIntfClasses    = 9;
+  cStatsColIntfProcs      = 10;
+  cStatsColIntfDependency = 11;
+  cStatsColImplDependency = 12;
+  cStatsColCyclic         = 13;
+  cStatsColFileName       = 14;
 
 procedure TFormMain.ButtonAddSearchPathClick(Sender: TObject);
 begin
@@ -237,6 +238,7 @@ procedure TFormMain.InitGrid;
   AddHeading( cStatsColWeighting, 'Weighting', 100);
   AddHeading( cStatsColDepth,     'Depth', 100);
   AddHeading( cStatsColDepthDiff, 'Depth Diff', 100);
+  AddHeading( cStatsColIntfClasses, 'Intf Classes', 100);
   AddHeading( cStatsColIntfProcs, 'Intf Routines', 100);
   AddHeading( cStatsColIntfDependency, 'Intf Dependency', 100);
   AddHeading( cStatsColImplDependency, 'Impl Dependency', 100);
@@ -264,6 +266,7 @@ procedure TFormMain.LoadGrid(SortCol: TDelphiUnitStatType; Ascending: Boolean; S
     StringGridStats.Cells[cStatsColWeighting,  Row]     := IntToStr(U.Weighting);
     StringGridStats.Cells[cStatsColDepth    ,  Row]     := IntToStr(U.Depth);
     StringGridStats.Cells[cStatsColDepthDiff,  Row]     := IntToStr(U.DepthDifferential);
+    StringGridStats.Cells[cStatsColIntfClasses,Row]     := IntToStr(U.InterfaceClasses.Count);
     StringGridStats.Cells[cStatsColIntfProcs,  Row]     := IntToStr(U.InterfaceRoutines.Count);
     StringGridStats.Cells[cStatsColIntfDependency, Row] := IntToStr(U.MaxInterfaceDependency);
     StringGridStats.Cells[cStatsColImplDependency, Row] := IntToStr(U.MaxDependency);
@@ -371,6 +374,7 @@ function TFormMain.StatTypeForCol(Col: Integer): TDelphiUnitStatType;
     cStatsColWeighting      : Result:= duWeighting;
     cStatsColDepth          : Result:= duDepth;
     cStatsColDepthDiff      : Result:= duDepthDiff;
+    cStatsColIntfClasses    : Result:= duClasses;
     cStatsColIntfProcs      : Result:= duRoutines;
     cStatsColFileName       : Result:= duFileName;
     cStatsColIntfDependency : Result:= duIntfDependency;

Tests/LexicalAnalyserTests.pas

@@ -84,6 +84,10 @@   TLexicalAnalyserTests = class
     [TestCase('Parenthesis: array', '[A],[,A,]')]
     procedure TestParenthesis(const InputString : String; const Open, Content, Close: String);
 
+    [Test]
+    [TestCase('Previous', 'A = B,=,A')]
+    procedure TestPrevious(const InputString : String; const Previous0, Previous1: String);
+
   end;
 
 implementation
@@ -206,6 +210,25 @@ procedure TLexicalAnalyserTests.TestParenthesis(const InputString, Open, Content
   end;
 end;
 
+procedure TLexicalAnalyserTests.TestPrevious(const InputString, Previous0, Previous1: String);
+var
+  Lex: TLexicalAnalyser;
+  FirstSym: String;
+  SecondSym: String;
+  ThirdSym: String;
+begin
+  Lex:=TLexicalAnalyser.CreateFromString(InputString);
+  try
+    FirstSym := Lex.CurrentSym;
+    SecondSym := Lex.GetSym;
+    ThirdSym := Lex.GetSym;
+    Assert.AreEqual(Lex.PreviousSym(0), Previous0);
+    Assert.AreEqual(Lex.PreviousSym(1), Previous1);
+  finally
+    FreeAndNil(Lex);
+  end;
+end;
+
 procedure TLexicalAnalyserTests.TestUnary(const InputString, Op, Operand: String);
 var
   Lex: TLexicalAnalyser;