-1

I am new to Delphi and I want to count the number of cases from the case statement in delphi. For example in this code there are 3 case statement and one default case statement, so the total case in this is 4. How do I make a count of this?

colour := Green;
Case colour of
   Red : ShowMessage('The colour is Red');
 Green : ShowMessage('The colour is Green');
  Blue : ShowMessage('The colour is Blue');
else ShowMessage('The colour is Unknown!');
end;
9
  • I can't keep myself from asking, what is the actual problem you try to solve with that count? Mar 3, 2017 at 11:00
  • To find the cyclomatic complexity I need to count the number of cases
    – Papagaio
    Mar 3, 2017 at 11:02
  • Ah, ok. AFAIK, there's nothing built-in in Delphi. Mar 3, 2017 at 11:05
  • @Papagaio What about using Sonarqube and the Delphi plugin ? Mar 3, 2017 at 11:14
  • 1
    @DavidHeffernan: Actually, this q prompted me to take a look at Jacob Thurman's Castalia parser which he made available around 2011.
    – MartynA
    Mar 4, 2017 at 10:21

1 Answer 1

2

As others have mentioned, you can do this with a parser. Writing an Object Pascal parser from scratch is a major undertaking, but there are a number of existing ones available.

The one used in this answer is Jacob Thurman's parser for Delphi's Castalia tool - see https://github.com/jacobthurman/Castalia-Delphi-Parser

There is an explanatory article about it here

https://jonlennartaasenden.wordpress.com/2014/09/13/castalia-parser-how-to-use/

The TmwSimplePasPar parser basically "consumes" an input stream looking for a "sentence" written in Object Pascal. While it is doing this it calls a succession of its recognition methods, one per ObjectPascal fragment that it encounters in the input stream. The way to use it is to derive a descendant of this class and override particular recognition methods which are relevant to the task at hand.

What makes TmwSimplePasPar particularly suited to your task is that is contains methods specific to Case statements, their labels and selectors. As you'll see, the code below overrides these methods to gather information about a Case statement encountered in the input stream. The only one where it is necessary to change the code compared to the overridden TmwSimplePasPar method is the CaseStatement one, where I have added a statement in the block which handles recognition of the else block, if present.

I've called my Parser class TNaiveCaseParser for two reasons, to keep it as simple as possible:

  • It only correctly processes the first Case statement it encounters.

  • It ignores the possibility of nested Case statements. To handle those, you would need some kind of stack to keep track of the "current" Case statement.

Code:

uses
  [...]CastaliaPasLexTypes, CastaliaSimplePasPar;

type

  TCaseStatement = class
  private
    FSelectors: integer;
    FHasElse: Boolean;
    FLabels: Integer;
    FFound: Boolean;
  public
    property Found : Boolean read FFound write FFound;
    property Labels : Integer read FLabels write FLabels;
    property Selectors : integer read FSelectors write FSelectors;
    property HasElse : Boolean read FHasElse write FHasElse;
  end;

  TNaiveCaseParser = class(TmwSimplePasPar)
  public
    C : TCaseStatement;
    constructor Create;
    destructor Destroy;
    procedure CaseLabel; override;
    procedure CaseSelector; override;
    procedure CaseStatement; override;
  end;

  TForm1 = class(TForm)
    Memo1: TMemo;
    Memo2: TMemo;
    btnParse: TButton;
    procedure btnParseClick(Sender: TObject);
  public
    procedure OnMessage(Sender: TObject; const Typ: TMessageEventType;
      const Msg: string; X, Y: Integer);
    procedure Parse;
  end;

[...}

{ TNaiveCaseParser }

procedure TNaiveCaseParser.CaseLabel;
begin
  inherited;
  C.Labels := C.Labels + 1;
end;

procedure TNaiveCaseParser.CaseSelector;
begin
  inherited;
  C.Selectors := C.Selectors + 1;
end;

procedure TNaiveCaseParser.CaseStatement;
begin
  Expected(ptCase);
  Expression;
  Expected(ptOf);
  CaseSelector;
  while TokenID = ptSemiColon do
  begin
    SEMICOLON;
    case TokenID of
      ptElse, ptEnd: ;
    else
      CaseSelector;
    end;
  end;
  if TokenID = ptElse then
  begin
    NextToken;
    StatementList;
    SEMICOLON;
    //  Added
    C.HasElse := True;
  end;
  Expected(ptEnd);
  //  Added
  C.Found := True;
end;

constructor TNaiveCaseParser.Create;
begin
  inherited Create;
  C := TCaseStatement.Create;
end;

destructor TNaiveCaseParser.Destroy;
begin
  C.Free;
  inherited;
end;

procedure TForm1.OnMessage(Sender: TObject; const Typ: TMessageEventType;
  const Msg: string; X, Y: Integer);
var
  S : String;
begin
  S := Format('r: %d, c: %d %s', [y, x, Msg]);
  ShowMessage(S);
end;

procedure TForm1.btnParseClick(Sender: TObject);
begin
  Parse;
end;

procedure TForm1.Parse;
var
  P : TNaiveCaseParser;
  S : String;
  MS : TMemoryStream;
begin
  P := TNaiveCaseParser.Create;
  P.OnMessage := OnMessage;
  MS := TMemoryStream.Create;

  S := Memo1.Lines.Text;
  MS.Write(Pointer(S)^, Length(S) * SizeOf(Char));
  MS.Position := 0;

  try
    P.InitDefines;
    P.Run('Test.Pas', MS);
    if P.C.Found then begin
      if P.C.HasElse then
        Memo2.Lines.Add(Format('Labels: %d, Selectors: %d, has Else block', [P.C.Labels, P.C.Selectors]))
      else
        Memo2.Lines.Add(Format('Labels: %d, Selectors: %d', [P.C.Labels, P.C.Selectors]));
    end;
  finally
    P.Free;
    MS.Free;
  end;
end;

The source code I used for testing (in D7 please note) was

unit Test;
interface
implementation
procedure TestCase;
var
  colour : (Black, Red, Green, Blue);
begin
  colour := Green;
  Case colour of
    Black,
    Red : ShowMessage('The colour is Red or Black');
    Green : ShowMessage('The colour is Green');
    Blue : ShowMessage('The colour is Blue');
    else
      ShowMessage('The colour is Unknown!');
  end;
end;
end.

The output is

Labels: 4, Selectors: 3, has Else block

Btw, I had not used Thurman's parser until I started writing the code for this answer about an hour ago, which I think says something about the design and quality of the parser.

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.