git-svn-id: trunk@36684 -
This commit is contained in:
michael 2017-07-08 16:56:51 +00:00
parent 0a73f141a4
commit e787cb1ff3
3 changed files with 19 additions and 2 deletions
packages/fcl-passrc

View File

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

View File

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

View File

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