paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 10:49:09 +02:00
Code Issues Packages Projects Releases Wiki Activity

Fix bug ID #31871

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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

15
packages/fcl-passrc/tests/tconstparser.pas
View File

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

2
packages/fcl-passrc/tests/testpassrc.lpi
View File

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