Browse Source

fcl-passrc: started range check for tpasrangetype

git-svn-id: trunk@36246 -
Mattias Gaertner 8 years ago
parent
commit
7cca09e2dd

+ 487 - 13
packages/fcl-passrc/src/pasresolver.pp

@@ -137,6 +137,15 @@ Works:
 - dotted unitnames
 - dotted unitnames
 
 
 ToDo:
 ToDo:
+- range checking:
+  - nil,
+  - true, false
+  - integer ranges
+  - boolean ranges
+  - enum ranges
+  - char ranges
+  - +, -, *, div, mod, /, shl, shr, or, and, xor, not,
+  - ord(), low(), high(), pred(), succ(), length()
 - @@
 - @@
 - fail to write a loop var inside the loop
 - fail to write a loop var inside the loop
 - warn: create class with abstract methods
 - warn: create class with abstract methods
@@ -267,6 +276,7 @@ const
   nSymbolXIsDeprecated = 3062;
   nSymbolXIsDeprecated = 3062;
   nSymbolXIsDeprecatedY = 3063;
   nSymbolXIsDeprecatedY = 3063;
   nRangeCheckError = 3064;
   nRangeCheckError = 3064;
+  nHighRangeLimitLTLowRangeLimit = 3065;
 
 
 // resourcestring patterns of messages
 // resourcestring patterns of messages
 resourcestring
 resourcestring
@@ -334,6 +344,7 @@ resourcestring
   sSymbolXIsDeprecated = 'Symbol "%s" is deprecated';
   sSymbolXIsDeprecated = 'Symbol "%s" is deprecated';
   sSymbolXIsDeprecatedY = 'Symbol "%s" is deprecated: %s';
   sSymbolXIsDeprecatedY = 'Symbol "%s" is deprecated: %s';
   sRangeCheckError = 'Range check error';
   sRangeCheckError = 'Range check error';
+  sHighRangeLimitLTLowRangeLimit = 'High range limit < low range limit';
 
 
 type
 type
   TResolverBaseType = (
   TResolverBaseType = (
@@ -566,6 +577,7 @@ type
     property PasElement: TPasElement read FPasElement write SetPasElement; // can be nil!
     property PasElement: TPasElement read FPasElement write SetPasElement; // can be nil!
   end;
   end;
 
 
+type
   { TResolveData - base class for data stored in TPasElement.CustomData }
   { TResolveData - base class for data stored in TPasElement.CustomData }
 
 
   TResolveData = Class(TPasElementBase)
   TResolveData = Class(TPasElementBase)
@@ -882,6 +894,8 @@ type
     );
     );
   TResolvedReferenceFlags = set of TResolvedReferenceFlag;
   TResolvedReferenceFlags = set of TResolvedReferenceFlag;
 
 
+type
+
   { TResolvedRefContext }
   { TResolvedRefContext }
 
 
   TResolvedRefContext = Class
   TResolvedRefContext = Class
@@ -929,6 +943,7 @@ type
     );
     );
   TPasResolverResultFlags = set of TPasResolverResultFlag;
   TPasResolverResultFlags = set of TPasResolverResultFlag;
 
 
+type
   { TPasResolverResult }
   { TPasResolverResult }
 
 
   TPasResolverResult = record
   TPasResolverResult = record
@@ -941,6 +956,87 @@ type
   end;
   end;
   PPasResolvedElement = ^TPasResolverResult;
   PPasResolvedElement = ^TPasResolverResult;
 
 
+  { TResEvalValue }
+
+  TREVKind = (
+    revkNone,
+    revkCustom,
+    revkNil,
+    revkBool,
+    revkInt,
+    revkUInt,
+    revkExtended,
+    revkString,
+    revkUnicodeString,
+    revkEnum,
+    revkSet
+    );
+  TResEvalSimpleValue = record
+    case TREVKind of
+    revkBool: (Bool: boolean);
+    revkInt: (Int: int64);
+    revkUInt: (UInt: qword);
+    revkExtended: (Ext: extended);
+  end;
+
+  TResEvalValue = class(TResolveData)
+  public
+    Kind: TREVKind;
+    Value: TResEvalSimpleValue;
+    IdentEl: TPasElement;
+    Expr: TPasExpr;
+    function Clone: TResEvalValue; virtual;
+    function AsString: string; virtual;
+  end;
+  TResEvalValueClass = class of TResEvalValue;
+
+  { TResEvalString - Kind=revkComplex }
+
+  TResEvalString = class(TResEvalValue)
+  public
+    S: String;
+    function Clone: TResEvalValue; override;
+    function AsString: string; override;
+  end;
+
+  { TResEvalUTF16 - Kind=revkComplex }
+
+  TResEvalUTF16 = class(TResEvalValue)
+  public
+    S: UnicodeString;
+    function Clone: TResEvalValue; override;
+    function AsString: string; override;
+  end;
+
+  { TResEvalEnum - Kind=revkComplex, Value.Int, IdentEl is TPasEnumValue }
+
+  TResEvalEnum = class(TResEvalValue)
+  public
+    function AsString: string; override;
+  end;
+
+  TResEvalSetItem = record
+    RangeStart, RangeEnd: int64;// ToDo: qword
+  end;
+  TResEvalSetItems = array of TResEvalSetItem;
+
+  { TResEvalSet - Kind=revkComplex, IdentEl is TPasEnumType }
+
+  TResEvalSet = class(TResEvalValue)
+  public
+    Ranges: TResEvalSetItems;
+    function Clone: TResEvalValue; override;
+    function AsString: string; override;
+  end;
+
+  TResEvalFlag = (
+    refStore, // store result in CustomData
+    refConst, // computing a const, error is a value is not const
+    refSet  // computing a set, allow ranges
+    );
+  TResEvalFlags = set of TResEvalFlag;
+
+type
   TPasResolverComputeFlag = (
   TPasResolverComputeFlag = (
     rcSkipTypeAlias,
     rcSkipTypeAlias,
     rcSetReferenceFlags,  // set flags of references while computing type, used by Resolve* methods
     rcSetReferenceFlags,  // set flags of references while computing type, used by Resolve* methods
@@ -1147,6 +1243,8 @@ type
     procedure FinishSetType(El: TPasSetType); virtual;
     procedure FinishSetType(El: TPasSetType); virtual;
     procedure FinishSubElementType(Parent: TPasElement; El: TPasType); virtual;
     procedure FinishSubElementType(Parent: TPasElement; El: TPasType); virtual;
     procedure FinishRangeType(El: TPasRangeType); virtual;
     procedure FinishRangeType(El: TPasRangeType); virtual;
+    procedure FinishConstRangeExpr(Left, Right: TPasExpr;
+      out LeftResolved, RightResolved: TPasResolverResult);
     procedure FinishRecordType(El: TPasRecordType); virtual;
     procedure FinishRecordType(El: TPasRecordType); virtual;
     procedure FinishClassType(El: TPasClassType); virtual;
     procedure FinishClassType(El: TPasClassType); virtual;
     procedure FinishClassOfType(El: TPasClassOfType); virtual;
     procedure FinishClassOfType(El: TPasClassOfType); virtual;
@@ -1190,8 +1288,6 @@ type
     function CheckTypeCastClassInstanceToClass(
     function CheckTypeCastClassInstanceToClass(
       const FromClassRes, ToClassRes: TPasResolverResult;
       const FromClassRes, ToClassRes: TPasResolverResult;
       ErrorEl: TPasElement): integer; virtual;
       ErrorEl: TPasElement): integer; virtual;
-    procedure CheckRangeExpr(Left, Right: TPasExpr;
-      out LeftResolved, RightResolved: TPasResolverResult);
     procedure CheckSetLitElCompatible(Left, Right: TPasExpr;
     procedure CheckSetLitElCompatible(Left, Right: TPasExpr;
       const LHS, RHS: TPasResolverResult);
       const LHS, RHS: TPasResolverResult);
     function CheckIsOrdinal(const ResolvedEl: TPasResolverResult;
     function CheckIsOrdinal(const ResolvedEl: TPasResolverResult;
@@ -1206,6 +1302,9 @@ type
       MaxCount: integer; RaiseOnError: boolean): integer;
       MaxCount: integer; RaiseOnError: boolean): integer;
     function CheckRaiseTypeArgNo(id: int64; ArgNo: integer; Param: TPasExpr;
     function CheckRaiseTypeArgNo(id: int64; ArgNo: integer; Param: TPasExpr;
       const ParamResolved: TPasResolverResult; Expected: string; RaiseOnError: boolean): integer;
       const ParamResolved: TPasResolverResult; Expected: string; RaiseOnError: boolean): integer;
+  protected
+    function Eval(Expr: TPasExpr; Flags: TResEvalFlags; ErrorEl: TPasElement = nil): TResEvalValue;
+  protected
     // custom types (added by descendant resolvers)
     // custom types (added by descendant resolvers)
     function CheckAssignCompatibilityCustom(
     function CheckAssignCompatibilityCustom(
       const LHS, RHS: TPasResolverResult; ErrorEl: TPasElement;
       const LHS, RHS: TPasResolverResult; ErrorEl: TPasElement;
@@ -1362,6 +1461,7 @@ type
     procedure RaiseIdentifierNotFound(id: int64; Identifier: string; El: TPasElement);
     procedure RaiseIdentifierNotFound(id: int64; Identifier: string; El: TPasElement);
     procedure RaiseXExpectedButYFound(id: int64; const X,Y: string; El: TPasElement);
     procedure RaiseXExpectedButYFound(id: int64; const X,Y: string; El: TPasElement);
     procedure RaiseConstantExprExp(id: int64; ErrorEl: TPasElement);
     procedure RaiseConstantExprExp(id: int64; ErrorEl: TPasElement);
+    procedure RaiseRangeCheck(id: int64; ErrorEl: TPasElement);
     procedure RaiseIncompatibleTypeDesc(id: int64; MsgNumber: integer;
     procedure RaiseIncompatibleTypeDesc(id: int64; MsgNumber: integer;
       const Args: array of const; const GotDesc, ExpDesc: String; ErrorEl: TPasElement);
       const Args: array of const; const GotDesc, ExpDesc: String; ErrorEl: TPasElement);
     procedure RaiseIncompatibleType(id: int64; MsgNumber: integer;
     procedure RaiseIncompatibleType(id: int64; MsgNumber: integer;
@@ -1526,6 +1626,8 @@ procedure SetResolverValueExpr(out ResolvedType: TPasResolverResult;
   BaseType: TResolverBaseType; TypeEl: TPasType; ExprEl: TPasExpr;
   BaseType: TResolverBaseType; TypeEl: TPasType; ExprEl: TPasExpr;
   Flags: TPasResolverResultFlags); overload;
   Flags: TPasResolverResultFlags); overload;
 
 
+procedure ReleaseEvalValue(var Value: TResEvalValue);
+
 function ProcNeedsImplProc(Proc: TPasProcedure): boolean;
 function ProcNeedsImplProc(Proc: TPasProcedure): boolean;
 function ChompDottedIdentifier(const Identifier: string): string;
 function ChompDottedIdentifier(const Identifier: string): string;
 function FirstDottedIdentifier(const Identifier: string): string;
 function FirstDottedIdentifier(const Identifier: string): string;
@@ -1537,6 +1639,7 @@ function IsValidIdent(const Ident: string; AllowDots: Boolean = False; StrictDot
 function dbgs(const Flags: TPasResolverComputeFlags): string; overload;
 function dbgs(const Flags: TPasResolverComputeFlags): string; overload;
 function dbgs(const a: TResolvedRefAccess): string;
 function dbgs(const a: TResolvedRefAccess): string;
 function dbgs(const Flags: TResolvedReferenceFlags): string; overload;
 function dbgs(const Flags: TResolvedReferenceFlags): string; overload;
+function dbgs(const Flags: TResEvalFlags): string; overload;
 
 
 implementation
 implementation
 
 
@@ -1790,6 +1893,14 @@ begin
   ResolvedType.Flags:=Flags;
   ResolvedType.Flags:=Flags;
 end;
 end;
 
 
+procedure ReleaseEvalValue(var Value: TResEvalValue);
+begin
+  if Value=nil then exit;
+  if Value.Element<>nil then exit;
+  Value.Free;
+  Value:=nil;
+end;
+
 function ProcNeedsImplProc(Proc: TPasProcedure): boolean;
 function ProcNeedsImplProc(Proc: TPasProcedure): boolean;
 begin
 begin
   Result:=true;
   Result:=true;
@@ -1916,6 +2027,106 @@ begin
   Result:='['+Result+']';
   Result:='['+Result+']';
 end;
 end;
 
 
+function dbgs(const Flags: TResEvalFlags): string;
+var
+  s: string;
+  f: TResEvalFlag;
+begin
+  Result:='';
+  for f in Flags do
+    if f in Flags then
+      begin
+      if Result<>'' then Result:=Result+',';
+      str(f,s);
+      Result:=Result+s;
+      end;
+  Result:='['+Result+']';
+end;
+
+{ TResEvalEnum }
+
+function TResEvalEnum.AsString: string;
+begin
+  Result:=inherited AsString+'='+IdentEl.Name+'='+IntToStr(Value.Int);
+end;
+
+{ TResEvalSet }
+
+function TResEvalSet.Clone: TResEvalValue;
+var
+  RS: TResEvalSet;
+  i: Integer;
+begin
+  Result:=inherited Clone;
+  RS:=TResEvalSet(Result);
+  SetLength(RS.Ranges,length(Ranges));
+  for i:=0 to length(Ranges)-1 do
+    RS.Ranges[i]:=Ranges[i];
+end;
+
+function TResEvalSet.AsString: string;
+var
+  i: Integer;
+begin
+  Result:=inherited AsString+'[';
+  for i:=0 to length(Ranges)-1 do
+    begin
+    if i>0 then Result:=Result+',';
+    Result:=Result+IntToStr(Ranges[i].RangeStart);
+    if Ranges[i].RangeStart<>Ranges[i].RangeEnd then
+      Result:=Result+'..'+IntToStr(Ranges[i].RangeEnd);
+    end;
+  Result:=Result+']';
+end;
+
+{ TResEvalUTF16 }
+
+function TResEvalUTF16.Clone: TResEvalValue;
+begin
+  Result:=inherited Clone;
+  TResEvalUTF16(Result).S:=S;
+end;
+
+function TResEvalUTF16.AsString: string;
+begin
+  Result:=inherited AsString+'='''+String(S)+'''';
+end;
+
+{ TResEvalString }
+
+function TResEvalString.Clone: TResEvalValue;
+begin
+  Result:=inherited Clone;
+  TResEvalString(Result).S:=S;
+end;
+
+function TResEvalString.AsString: string;
+begin
+  Result:=inherited AsString+'='''+S+'''';
+end;
+
+{ TResEvalValue }
+
+function TResEvalValue.Clone: TResEvalValue;
+begin
+  Result:=TResEvalValueClass(ClassType).Create;
+  Result.Kind:=Kind;
+  Result.Value:=Value;
+  Result.IdentEl:=IdentEl;
+  Result.Expr:=Expr;
+end;
+
+function TResEvalValue.AsString: string;
+begin
+  str(Kind,Result);
+  case Kind of
+    revkBool: Result:=Result+'='+BoolToStr(Value.Bool,true);
+    revkInt: Result:=Result+'='+IntToStr(Value.Int);
+    revkUInt: Result:=Result+'='+IntToStr(Value.UInt);
+    revkExtended: Result:=Result+'='+FloatToStr(Value.Ext);
+  end;
+end;
+
 { TPasPropertyScope }
 { TPasPropertyScope }
 
 
 destructor TPasPropertyScope.Destroy;
 destructor TPasPropertyScope.Destroy;
@@ -3454,7 +3665,7 @@ begin
     begin
     begin
     RangeExpr:=TPasRangeType(EnumType).RangeExpr;
     RangeExpr:=TPasRangeType(EnumType).RangeExpr;
     if RangeExpr.Parent=El then
     if RangeExpr.Parent=El then
-      CheckRangeExpr(RangeExpr.left,RangeExpr.right,StartResolved,EndResolved);
+      FinishConstRangeExpr(RangeExpr.left,RangeExpr.right,StartResolved,EndResolved);
     FinishSubElementType(El,EnumType);
     FinishSubElementType(El,EnumType);
     exit;
     exit;
     end
     end
@@ -3511,7 +3722,81 @@ var
 begin
 begin
   ResolveExpr(El.RangeExpr.left,rraRead);
   ResolveExpr(El.RangeExpr.left,rraRead);
   ResolveExpr(El.RangeExpr.right,rraRead);
   ResolveExpr(El.RangeExpr.right,rraRead);
-  CheckRangeExpr(El.RangeExpr.left,El.RangeExpr.right,StartResolved,EndResolved);
+  FinishConstRangeExpr(El.RangeExpr.left,El.RangeExpr.right,StartResolved,EndResolved);
+end;
+
+procedure TPasResolver.FinishConstRangeExpr(Left, Right: TPasExpr; out LeftResolved,
+  RightResolved: TPasResolverResult);
+{$IFDEF EnablePasResRangeCheck}
+var
+  LeftValue, RightValue: TResEvalValue;
+{$ENDIF}
+begin
+  {$IFDEF VerbosePasResEval}
+  writeln('TPasResolver.FinishConstRangeExpr Left=',GetObjName(Left),' Right=',GetObjName(Right));
+  {$ENDIF}
+  // check type compatibility
+  ComputeElement(Left,LeftResolved,[rcSkipTypeAlias,rcConstant]);
+  ComputeElement(Right,RightResolved,[rcSkipTypeAlias,rcConstant]);
+  CheckSetLitElCompatible(Left,Right,LeftResolved,RightResolved);
+
+  {$IFDEF EnablePasResRangeCheck}
+  // check value
+  LeftValue:=nil;
+  RightValue:=nil;
+  try
+    LeftValue:=Eval(Left,[refStore,refConst]);
+    RightValue:=Eval(Right,[refStore,refConst]);
+    {$IFDEF VerbosePasResEval}
+    writeln('TPasResolver.FinishConstRangeExpr Left=',LeftValue.AsString,' Right=',RightValue.AsString);
+    {$ENDIF}
+    case LeftValue.Kind of
+    revkInt,revkUInt:
+      begin
+      if not (RightValue.Kind in [revkInt,revkUInt]) then
+        RaiseRangeCheck(20170518222812,Right);
+      if LeftValue.Kind=revkInt then
+        begin
+        if RightValue.Kind=revkInt then
+          begin
+          if LeftValue.Value.Int>RightValue.Value.Int then
+            RaiseMsg(20170518222939,nHighRangeLimitLTLowRangeLimit,
+              sHighRangeLimitLTLowRangeLimit,[],Right);
+          end
+        else
+          begin
+          if LeftValue.Value.Int>RightValue.Value.UInt then
+            RaiseMsg(20170519000235,nHighRangeLimitLTLowRangeLimit,
+              sHighRangeLimitLTLowRangeLimit,[],Right);
+          end;
+        end
+      else
+        begin
+        if RightValue.Kind=revkInt then
+          begin
+          if LeftValue.Value.UInt>RightValue.Value.Int then
+            RaiseMsg(20170519000238,nHighRangeLimitLTLowRangeLimit,
+              sHighRangeLimitLTLowRangeLimit,[],Right);
+          end
+        else
+          begin
+          if LeftValue.Value.UInt>RightValue.Value.UInt then
+            RaiseMsg(20170519000240,nHighRangeLimitLTLowRangeLimit,
+              sHighRangeLimitLTLowRangeLimit,[],Right);
+          end;
+        end;
+      end;
+    else
+      {$IFDEF EnablePasResRangeCheck}
+      writeln('TPasResolver.FinishConstRangeExpr Left=',GetObjName(Left),' LeftValue.Kind=',LeftValue.Kind);
+      RaiseNotYetImplemented(20170518221103,Left);
+      {$ENDIF}
+    end;
+  finally
+    ReleaseEvalValue(LeftValue);
+    ReleaseEvalValue(RightValue);
+  end;
+  {$ENDIF}
 end;
 end;
 
 
 procedure TPasResolver.FinishRecordType(El: TPasRecordType);
 procedure TPasResolver.FinishRecordType(El: TPasRecordType);
@@ -7127,14 +7412,6 @@ begin
   Result:=cIncompatible;
   Result:=cIncompatible;
 end;
 end;
 
 
-procedure TPasResolver.CheckRangeExpr(Left, Right: TPasExpr; out LeftResolved,
-  RightResolved: TPasResolverResult);
-begin
-  ComputeElement(Left,LeftResolved,[rcSkipTypeAlias,rcConstant]);
-  ComputeElement(Right,RightResolved,[rcSkipTypeAlias,rcConstant]);
-  CheckSetLitElCompatible(Left,Right,LeftResolved,RightResolved);
-end;
-
 procedure TPasResolver.CheckSetLitElCompatible(Left, Right: TPasExpr;
 procedure TPasResolver.CheckSetLitElCompatible(Left, Right: TPasExpr;
   const LHS, RHS: TPasResolverResult);
   const LHS, RHS: TPasResolverResult);
 var
 var
@@ -7428,6 +7705,198 @@ begin
   Result:=cIncompatible;
   Result:=cIncompatible;
 end;
 end;
 
 
+function TPasResolver.Eval(Expr: TPasExpr; Flags: TResEvalFlags;
+  ErrorEl: TPasElement): TResEvalValue;
+// Important: Caller must free result if (Result<>nil) and (Result.Element=nil)
+var
+  C: TClass;
+  Int: int64;
+  UInt: QWord;
+  Ext: Extended;
+  Code: integer;
+  Ref: TResolvedReference;
+  Decl: TPasElement;
+begin
+  Result:=nil;
+  if Expr.CustomData is TResEvalValue then
+    begin
+    Result:=TResEvalValue(Expr.CustomData);
+    exit;
+    end;
+  if ErrorEl=nil then
+    ErrorEl:=Expr;
+  if (refStore in Flags) and (Expr.CustomData=nil) then
+    begin
+    Result:=Eval(Expr,Flags-[refStore],ErrorEl);
+    if Result.Element<>nil then
+      exit; // already stored
+    AddResolveData(Expr,Result,lkModule);
+    exit;
+    end;
+
+  {$IFDEF VerbosePasResEval}
+  writeln('TPasResolver.Eval Expr=',GetObjName(Expr),' Flags=',dbgs(Flags));
+  {$ENDIF}
+  C:=Expr.ClassType;
+  if C=TPrimitiveExpr then
+    begin
+    case TPrimitiveExpr(Expr).Kind of
+      pekIdent:
+        begin
+        if not (Expr.CustomData is TResolvedReference) then
+          RaiseNotYetImplemented(20170518203134,Expr);
+        Ref:=TResolvedReference(Expr.CustomData);
+        Decl:=Ref.Declaration;
+        C:=Decl.ClassType;
+        if C=TPasConst then
+          begin
+          if (TPasConst(Decl).Expr<>nil)
+              and (TPasConst(Decl).IsConst or (TPasConst(Decl).VarType=nil)) then
+            begin
+            Result:=Eval(TPasConst(Decl).Expr,Flags,ErrorEl);
+            Result.IdentEl:=Decl;
+            exit;
+            end;
+          if refConst in Flags then
+            RaiseConstantExprExp(20170518214928,ErrorEl);
+          end
+        else if Decl is TPasType then
+          begin
+          Decl:=ResolveAliasType(TPasType(Decl));
+          C:=Decl.ClassType;
+          if C=TPasRangeType then
+            begin
+            if refSet in Flags then
+              begin
+              Result:=Eval(TPasRangeType(Decl).RangeExpr,Flags,ErrorEl);
+              Result.IdentEl:=Ref.Declaration;
+              exit;
+              end;
+            end;
+          end;
+        if refConst in Flags then
+          RaiseConstantExprExp(20170518213616,ErrorEl);
+        end;
+      pekNumber:
+        begin
+        // try int64
+        val(TPrimitiveExpr(Expr).Value,Int,Code);
+        if Code=0 then
+          begin
+          Result:=TResEvalValue.Create;
+          Result.Kind:=revkInt;
+          Result.Value.Int:=Int;
+          Result.Expr:=Expr;
+          exit;
+          end;
+        // try qword
+        val(TPrimitiveExpr(Expr).Value,UInt,Code);
+        if Code=0 then
+          begin
+          Result:=TResEvalValue.Create;
+          Result.Kind:=revkUInt;
+          Result.Value.UInt:=UInt;
+          Result.Expr:=Expr;
+          exit;
+          end;
+        // try extended
+        val(TPrimitiveExpr(Expr).Value,Ext,Code);
+        if Code=0 then
+          begin
+          Result:=TResEvalValue.Create;
+          Result.Kind:=revkExtended;
+          Result.Value.Ext:=Ext;
+          Result.Expr:=Expr;
+          exit;
+          end;
+        RaiseRangeCheck(20170518202252,Expr);
+        end;
+      pekString:
+        begin
+        Result:=TResEvalString.Create;
+        Result.Kind:=revkString;
+        Result.Expr:=Expr;
+        TResEvalString(Result).S:=TPrimitiveExpr(Expr).Value;
+        exit;
+        end;
+    else
+      RaiseNotYetImplemented(20170518200951,Expr);
+    end;
+    end
+  else if C=TNilExpr then
+    begin
+    Result:=TResEvalValue.Create;
+    Result.Kind:=revkNil;
+    Result.Expr:=Expr;
+    end
+  else if C=TBoolConstExpr then
+    begin
+    Result:=TResEvalValue.Create;
+    Result.Kind:=revkBool;
+    Result.Expr:=Expr;
+    Result.Value.Bool:=TBoolConstExpr(Expr).Value;
+    end
+  else if C=TUnaryExpr then
+    begin
+    Result:=Eval(TUnaryExpr(Expr).Operand,Flags,ErrorEl);
+    if Result=nil then exit;
+    case TUnaryExpr(Expr).OpCode of
+      eopAdd: ;
+      eopSubtract:
+        case Result.Kind of
+        revkInt:
+          begin
+          if Result.Value.Int=0 then exit;
+          if Result.Element<>nil then
+            Result:=Result.Clone;
+          Result.Value.Int:=-Result.Value.Int;
+          end;
+        revkUInt:
+          begin
+          if Result.Value.UInt=0 then exit;
+          if Result.Element<>nil then
+            Result:=Result.Clone;
+          Result.Value.UInt:=-Result.Value.UInt;
+          end
+        else
+          begin
+          if Result.Element=nil then
+            Result.Free;
+          RaiseNotYetImplemented(20170518230738,Expr);
+          end;
+        end;
+      eopNot:
+        case Result.Kind of
+        revkBool:
+          begin
+          if Result.Element<>nil then
+            Result:=Result.Clone;
+          Result.Value.Bool:=not Result.Value.Bool;
+          end
+        else
+          begin
+          if Result.Element=nil then
+            Result.Free;
+          RaiseNotYetImplemented(20170518232804,Expr);
+          end;
+        end;
+      eopAddress:
+        begin
+        if Result.Element=nil then
+          Result.Free;
+        // @ operator requires a compiler -> return nil
+        Result:=TResEvalString.Create;
+        Result.Kind:=revkNil;
+        Result.Expr:=Expr;
+        end
+      else
+        RaiseNotYetImplemented(20170518232823,Expr);
+      end;
+    end
+  else if refConst in Flags then
+    RaiseConstantExprExp(20170518213800,ErrorEl);
+end;
+
 function TPasResolver.CheckAssignCompatibilityCustom(const LHS,
 function TPasResolver.CheckAssignCompatibilityCustom(const LHS,
   RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean;
   RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean;
   var Handled: boolean): integer;
   var Handled: boolean): integer;
@@ -9600,6 +10069,11 @@ begin
   RaiseMsg(id,nConstantExpressionExpected,sConstantExpressionExpected,[],ErrorEl);
   RaiseMsg(id,nConstantExpressionExpected,sConstantExpressionExpected,[],ErrorEl);
 end;
 end;
 
 
+procedure TPasResolver.RaiseRangeCheck(id: int64; ErrorEl: TPasElement);
+begin
+  RaiseMsg(id,nRangeCheckError,sRangeCheckError,[],ErrorEl);
+end;
+
 procedure TPasResolver.RaiseIncompatibleTypeDesc(id: int64; MsgNumber: integer;
 procedure TPasResolver.RaiseIncompatibleTypeDesc(id: int64; MsgNumber: integer;
   const Args: array of const; const GotDesc, ExpDesc: String; ErrorEl: TPasElement);
   const Args: array of const; const GotDesc, ExpDesc: String; ErrorEl: TPasElement);
 
 
@@ -12615,7 +13089,7 @@ begin
       Result:=btQWord;
       Result:=btQWord;
     if BaseTypes[Result]<>nil then exit;
     if BaseTypes[Result]<>nil then exit;
     end;
     end;
-  RaiseMsg(20170420100336,nRangeCheckError,sRangeCheckError,[],ErrorEl);
+  RaiseRangeCheck(20170420100336,ErrorEl);
 end;
 end;
 
 
 function TPasResolver.GetCombinedChar(const Char1, Char2: TPasResolverResult;
 function TPasResolver.GetCombinedChar(const Char1, Char2: TPasResolverResult;

+ 1 - 0
packages/fcl-passrc/src/pastree.pp

@@ -848,6 +848,7 @@ type
 
 
   TPasConst = class(TPasVariable)
   TPasConst = class(TPasVariable)
   public
   public
+    IsConst: boolean; // e.g. $WritableConst off
     function ElementTypeName: string; override;
     function ElementTypeName: string; override;
   end;
   end;
 
 

+ 18 - 0
packages/fcl-passrc/tests/tcresolver.pas

@@ -185,6 +185,7 @@ type
     Procedure TestVarExternal;
     Procedure TestVarExternal;
     Procedure TestVarNoSemicolonBeginFail;
     Procedure TestVarNoSemicolonBeginFail;
     Procedure TestIntegerRange;
     Procedure TestIntegerRange;
+    Procedure TestIntegerRangeHighLowerLowFail;
 
 
     // strings
     // strings
     Procedure TestChar_Ord;
     Procedure TestChar_Ord;
@@ -2117,8 +2118,25 @@ begin
   Add('const');
   Add('const');
   Add('  MinInt = -1;');
   Add('  MinInt = -1;');
   Add('  MaxInt = +1;');
   Add('  MaxInt = +1;');
+  Add('type');
   Add('  {#TMyInt}TMyInt = MinInt..MaxInt;');
   Add('  {#TMyInt}TMyInt = MinInt..MaxInt;');
   Add('begin');
   Add('begin');
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestIntegerRangeHighLowerLowFail;
+begin
+  StartProgram(false);
+  Add('const');
+  Add('  MinInt = -1;');
+  Add('  MaxInt = +1;');
+  Add('type');
+  Add('  {#TMyInt}TMyInt = MaxInt..MinInt;');
+  Add('begin');
+  {$IFDEF EnablePasResRangeCheck}
+  CheckResolverException(sHighRangeLimitLTLowRangeLimit,
+    nHighRangeLimitLTLowRangeLimit);
+  {$ENDIF}
 end;
 end;
 
 
 procedure TTestResolver.TestChar_Ord;
 procedure TTestResolver.TestChar_Ord;