diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp index 4666b4eb44..1013db2aea 100644 --- a/packages/fcl-passrc/src/pasresolver.pp +++ b/packages/fcl-passrc/src/pasresolver.pp @@ -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 diff --git a/packages/fcl-passrc/src/pparser.pp b/packages/fcl-passrc/src/pparser.pp index e3ff306be8..8c35a9ad26 100644 --- a/packages/fcl-passrc/src/pparser.pp +++ b/packages/fcl-passrc/src/pparser.pp @@ -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; diff --git a/packages/fcl-passrc/tests/tcresolver.pas b/packages/fcl-passrc/tests/tcresolver.pas index ed6a7dbb6a..faf4e42801 100644 --- a/packages/fcl-passrc/tests/tcresolver.pas +++ b/packages/fcl-passrc/tests/tcresolver.pas @@ -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);