统计Delphi中switch语句(Case)的case个数

Count the number of cases in switch statement(Case) in Delphi

我是 Delphi 的新手,我想计算 delphi 中 case 语句中的案例数。例如在这段代码中有 3 个 case 语句和一个 default case 语句,所以这里的 case 总数是 4。我如何计算这个?

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;

正如其他人所提到的,您可以使用解析器来完成此操作。从头开始编写 Object Pascal 解析器是一项艰巨的任务,但是有许多可用的现有解析器。

这个答案中使用的那个 是 Jacob Thurman 为 Delphi 的 Castalia 工具设计的解析器 - 见 https://github.com/jacobthurman/Castalia-Delphi-Parser

这里有一篇解释文章

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

TmwSimplePasPar 解析器基本上 "consumes" 一个输入流寻找 "sentence" 用 Object Pascal 编写。在执行此操作时,它会调用 它的一系列识别方法,它遇到的每个 ObjectPascal 片段一个 在输入流中。使用方法是派生这个class的后代 并覆盖与手头任务相关的特定识别方法。

TmwSimplePasPar 特别适合您的任务的原因在于它包含 特定于 Case 语句、它们的标签和选择器的方法。如你所愿 看,下面的代码覆盖了这些方法来收集有关 Case 的信息 输入流中遇到的语句。唯一需要的地方 与覆盖的 TmwSimplePasPar 方法相比更改代码是 CaseStatement 一个,我在处理的块中添加了一条语句 识别 else 块(如果存在)。

出于两个原因,我将我的解析器命名为 class TNaiveCaseParser,以便将其保留为 尽可能简单:

  • 它只正确处理它遇到的第一个 Case 语句。

  • 忽略嵌套Case语句的可能性。为了处理这些,你 需要某种堆栈来跟踪 "current" Case 语句。

代码:

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;

我用于测试的源代码(在 D7 中请注意)是

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.

输出为

Labels: 4, Selectors: 3, has Else block

顺便说一句,大约一个小时前我开始为这个答案编写代码之前,我没有使用过 Thurman 的解析器,我认为这说明了解析器的设计和质量。