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

git-svn-id: trunk@39020 -

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

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;

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