paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-04 09:02:22 +01:00
Code Issues Packages Projects Releases Wiki Activity

* Case statement labels are now expressions

Browse Source 
git-svn-id: trunk@22051 -
This commit is contained in:
michael 2012-08-09 19:24:02 +00:00
parent 4d86d25c6c
commit e4758e3cd1
2 changed files with 25 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
packages/fcl-passrc/src/pastree.pp
View File

@ -975,7 +975,7 @@ type
public
destructor Destroy; override;
procedure AddElement(Element: TPasImplElement); override;
function AddCase(const Expression: string): TPasImplCaseStatement;
function AddCase(const Expression: TPasExpr): TPasImplCaseStatement;
function AddElse: TPasImplCaseElse;
public
Expression: string;
@ -989,9 +989,9 @@ type
constructor Create(const AName: string; AParent: TPasElement); override;
destructor Destroy; override;
procedure AddElement(Element: TPasImplElement); override;
procedure AddExpression(const Expr: string);
procedure AddExpression(const Expr: TPasExpr);
public
Expressions: TStrings;
Expressions: TFPList;
Body: TPasImplElement;
end;
@ -2770,7 +2770,7 @@ begin
inherited AddElement(Element);
end;
function TPasImplCaseOf.AddCase(const Expression: string
function TPasImplCaseOf.AddCase(const Expression: TPasExpr
): TPasImplCaseStatement;
begin
Result:=TPasImplCaseStatement.Create('',Self);
@ -2791,11 +2791,17 @@ constructor TPasImplCaseStatement.Create(const AName: string;
AParent: TPasElement);
begin
inherited Create(AName, AParent);
Expressions:=TStringList.Create;
Expressions:=TFPList.Create;
end;
destructor TPasImplCaseStatement.Destroy;
Var
I : integer;
begin
For I:=0 to Expressions.Count-1 do
TPasExpr(Expressions[i]).Free;
FreeAndNil(Expressions);
if Assigned(Body) then
Body.Release;
@ -2812,7 +2818,7 @@ begin
end
end;
procedure TPasImplCaseStatement.AddExpression(const Expr: string);
procedure TPasImplCaseStatement.AddExpression(const Expr: TPasExpr);
begin
Expressions.Add(Expr);
end;

28
packages/fcl-passrc/src/pparser.pp
View File

@ -53,6 +53,7 @@ resourcestring
SParserExpectedIdentifier = 'Identifier expected';
SParserNotAProcToken = 'Not a procedure or function token';
SRangeExpressionExpected = 'Range expression expected';
SParserExpectCase = 'Case label expression expected';
SLogStartImplementation = 'Start parsing implementation section.';
SLogStartInterface = 'Start parsing interface section';
@ -3181,7 +3182,11 @@ begin
//writeln(i,'CASE OF Token=',CurTokenText);
case CurToken of
tkend:
begin
if CurBlock.Elements.Count=0 then
ParseExc(SParserExpectCase);
break; // end without else
end;
tkelse:
begin
// create case-else block
@ -3191,32 +3196,25 @@ begin
break;
end
else
UngetToken;
// read case values
repeat
Expr:=ParseExpression(Parent);
Left:=DoParseExpression(Parent);
//writeln(i,'CASE value="',Expr,'" Token=',CurTokenText);
NextToken;
if CurToken=tkDotDot then
begin
Expr:=Expr+'..'+ParseExpression(Parent);
NextToken;
end;
// do not miss '..'
if CurBlock is TPasImplCaseStatement then
TPasImplCaseStatement(CurBlock).Expressions.Add(Expr)
TPasImplCaseStatement(CurBlock).Expressions.Add(Left)
else
begin
el:=TPasImplCaseStatement(CreateElement(TPasImplCaseStatement,'',CurBlock));
TPasImplCaseStatement(el).AddExpression(Expr);
TPasImplCaseStatement(el).AddExpression(Left);
CurBlock.AddElement(el);
CurBlock:=TPasImplCaseStatement(el);
end;
//writeln(i,'CASE after value Token=',CurTokenText);
if CurToken=tkColon then break;
if CurToken<>tkComma then
ParseExc(Format(SParserExpectTokenError, [TokenInfos[tkComma]]));
until false;
if (CurToken=tkComma) then
NextToken
else if (CurToken<>tkColon) then
ParseExc(Format(SParserExpectTokenError, [TokenInfos[tkComma]]))
until Curtoken=tkColon;
// read statement
ParseStatement(CurBlock,SubBlock);
CloseBlock;