Fix bug ID #31871

git-svn-id: trunk@36684 -

packages/fcl-passrc/src/pparser.pp

@@ -76,6 +76,7 @@ const
   nParserExpectedTypeButGot = 2049;
   nParserPropertyArgumentsCanNotHaveDefaultValues = 2050;
   nParserExpectedExternalClassName = 2051;
+  nParserNoConstRangeAllowed = 2052;
 
 // resourcestring patterns of messages
 resourcestring
@@ -130,6 +131,7 @@ resourcestring
   SParserExpectedTypeButGot = 'Expected type, but got %s';
   SParserPropertyArgumentsCanNotHaveDefaultValues = 'Property arguments can not have default values';
   SParserExpectedExternalClassName = 'Expected external class name';
+  SParserNoConstRangeAllowed = 'Const ranges are not allowed';
 
 type
   TPasScopeType = (
@@ -3339,6 +3341,8 @@ begin
     ExpectToken(tkEqual);
     NextToken;
     Result.Expr:=DoParseConstValueExpression(Result);
+    if (Result.VarType=Nil) and (Result.Expr.Kind=pekRange) then
+      ParseExc(nParserNoConstRangeAllowed, SParserNoConstRangeAllowed );
     UngetToken;
     CheckHint(Result,True);
     ok:=true;

packages/fcl-passrc/tests/tconstparser.pas

@@ -5,7 +5,7 @@ unit tconstparser;
 interface
 
 uses
-  Classes, SysUtils, fpcunit, pastree, pscanner, tcbaseparser, testregistry;
+  Classes, SysUtils, fpcunit, pastree, pscanner, tcbaseparser, testregistry, pparser;
 
 Type
     { TTestConstParser }
@@ -16,6 +16,7 @@ Type
     FExpr: TPasExpr;
     FHint : string;
     FTyped: String;
+    procedure DoParseConstUnTypedRange;
   Protected
     Function ParseConst(ASource : String) : TPasConst;
     Procedure CheckExprNameKindClass(AKind : TPasExprKind; AClass : TClass);
@@ -78,6 +79,7 @@ Type
     Procedure TestRecordConst;
     Procedure TestArrayConst;
     Procedure TestRangeConst;
+    Procedure TestRangeConstUnTyped;
     Procedure TestArrayOfRangeConst;
   end;
 
@@ -518,6 +520,17 @@ begin
   AssertExpression('Float const', TheExpr,pekNumber,'1');
 end;
 
+procedure TTestConstParser.DoParseConstUnTypedRange;
+
+begin
+  ParseConst('1..2');
+end;
+
+procedure TTestConstParser.TestRangeConstUnTyped;
+begin
+  AssertException('Range const is not allowed',EParserError,@DoParseConstUnTypedRange);
+end;
+
 procedure TTestConstParser.TestArrayOfRangeConst;
 Var
   R : TArrayValues;

packages/fcl-passrc/tests/testpassrc.lpi

@@ -27,7 +27,7 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
-        <CommandLineParams Value="--suite=TTestExpressions.TestArrayAccess"/>
+        <CommandLineParams Value="--suite=TestHelperOnLiteral"/>
       </local>
     </RunParams>
     <RequiredPackages Count="1">