统计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 的解析器,我认为这说明了解析器的设计和质量。
我是 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 的解析器,我认为这说明了解析器的设计和质量。