paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-07 05:19:32 +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 public
destructor Destroy; override; destructor Destroy; override;
procedure AddElement(Element: TPasImplElement); override; procedure AddElement(Element: TPasImplElement); override;
function AddCase(const Expression: string): TPasImplCaseStatement; function AddCase(const Expression: TPasExpr): TPasImplCaseStatement;
function AddElse: TPasImplCaseElse; function AddElse: TPasImplCaseElse;
public public
Expression: string; Expression: string;
@ -989,9 +989,9 @@ type
constructor Create(const AName: string; AParent: TPasElement); override; constructor Create(const AName: string; AParent: TPasElement); override;
destructor Destroy; override; destructor Destroy; override;
procedure AddElement(Element: TPasImplElement); override; procedure AddElement(Element: TPasImplElement); override;
procedure AddExpression(const Expr: string); procedure AddExpression(const Expr: TPasExpr);
public public
Expressions: TStrings; Expressions: TFPList;
Body: TPasImplElement; Body: TPasImplElement;
end; end;
@ -2770,7 +2770,7 @@ begin
inherited AddElement(Element); inherited AddElement(Element);
end; end;
function TPasImplCaseOf.AddCase(const Expression: string function TPasImplCaseOf.AddCase(const Expression: TPasExpr
): TPasImplCaseStatement; ): TPasImplCaseStatement;
begin begin
Result:=TPasImplCaseStatement.Create('',Self); Result:=TPasImplCaseStatement.Create('',Self);
@ -2791,11 +2791,17 @@ constructor TPasImplCaseStatement.Create(const AName: string;
AParent: TPasElement); AParent: TPasElement);
begin begin
inherited Create(AName, AParent); inherited Create(AName, AParent);
Expressions:=TStringList.Create; Expressions:=TFPList.Create;
end; end;
destructor TPasImplCaseStatement.Destroy; destructor TPasImplCaseStatement.Destroy;
Var
I : integer;
begin begin
For I:=0 to Expressions.Count-1 do
TPasExpr(Expressions[i]).Free;
FreeAndNil(Expressions); FreeAndNil(Expressions);
if Assigned(Body) then if Assigned(Body) then
Body.Release; Body.Release;
@ -2812,7 +2818,7 @@ begin
end end
end; end;
procedure TPasImplCaseStatement.AddExpression(const Expr: string); procedure TPasImplCaseStatement.AddExpression(const Expr: TPasExpr);
begin begin
Expressions.Add(Expr); Expressions.Add(Expr);
end; end;

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

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