paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-19 03:59:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: resolver: case-of and external const

Browse Source 
git-svn-id: trunk@39020 -
This commit is contained in:
Mattias Gaertner 2018-05-18 09:11:46 +00:00
parent 7fc9871cbe
commit f45cebf724
3 changed files with 39 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
packages/fcl-passrc/src/pasresolver.pp
View File

@ -6943,12 +6943,19 @@ begin
ConvertRangeToElement(OfExprResolved);
CheckEqualResCompatibility(CaseExprResolved,OfExprResolved,OfExpr,true);
Value:=Eval(OfExpr,[refConst]);
Value:=Eval(OfExpr,[]); // allow external const, no refConst
if Value<>nil then
begin
if not AddValue(Value,Values,ValueSet,OfExpr) then
RaiseIncompatibleTypeRes(20180424210815,nIncompatibleTypesGotExpected,
[],OfExprResolved,CaseExprResolved,OfExpr);
ReleaseEvalValue(Value);
ReleaseEvalValue(Value);
end
else if (OfExprResolved.IdentEl is TPasConst)
and (TPasConst(OfExprResolved.IdentEl).Expr=nil) then
// externl const
else
RaiseMsg(20180518102047,nConstantExpressionExpected,sConstantExpressionExpected,[],OfExpr);
end;
ResolveImplElement(Stat.Body);
end

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

@ -3680,6 +3680,7 @@ begin
and TPasClassType(Parent).IsExternal
and (TPasClassType(Parent).ObjKind=okClass) then
// typed const without expression is allowed in external class
Result.IsConst:=true
else if CurToken=tkSemicolon then
begin
NextToken;
@ -3702,6 +3703,7 @@ begin
if not (CurToken in [tkChar,tkString,tkIdentifier]) then
ParseExcTokenError(TokenInfos[tkString]);
Result.ExportName:=DoParseExpression(Parent);
Result.IsConst:=true; // external const is readonly
end
else if CurToken=tkSemicolon then
// external;

28
packages/fcl-passrc/tests/tcresolver.pas
View File

@ -203,6 +203,7 @@ type
Procedure TestVarNoSemicolonBeginFail;
Procedure TestConstIntOperators;
Procedure TestConstBitwiseOps;
Procedure TestConstExternal;
Procedure TestIntegerTypeCast;
Procedure TestConstFloatOperators;
Procedure TestFloatTypeCast;
@ -317,6 +318,7 @@ type
Procedure TestForLoop_PassVarFail;
Procedure TestStatements;
Procedure TestCaseOfInt;
Procedure TestCaseOfIntExtConst;
Procedure TestCaseIntDuplicateFail;
Procedure TestCaseOfStringDuplicateFail;
Procedure TestCaseOfStringRangeDuplicateFail;
@ -2584,6 +2586,15 @@ begin
CheckResolverUnexpectedHints;
end;
procedure TTestResolver.TestConstExternal;
begin
Parser.Options:=Parser.Options+[po_ExtConstWithoutExpr];
StartProgram(false);
Add('const NaN: double; external name ''Global.Nan'';');
Add('begin');
ParseProgram;
end;
procedure TTestResolver.TestIntegerTypeCast;
begin
StartProgram(false);
@ -4585,6 +4596,23 @@ begin
ParseProgram;
end;
procedure TTestResolver.TestCaseOfIntExtConst;
begin
Parser.Options:=Parser.Options+[po_ExtConstWithoutExpr];
StartProgram(false);
Add([
'const e: longint; external;',
'var i: longint;',
'begin',
' case i of',
' 2: ;',
' e: ;',
' 1: ;',
' end;',
'']);
ParseProgram;
end;
procedure TTestResolver.TestCaseIntDuplicateFail;
begin
StartProgram(false);