* Case statement labels are now expressions

git-svn-id: trunk@22051 -

packages/fcl-passrc/src/pastree.pp

@@ -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;

packages/fcl-passrc/src/pparser.pp

@@ -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;