Browse Source

fcl-passrc: resolver: eval const set of char, int, bool

git-svn-id: trunk@36734 -
Mattias Gaertner 8 years ago
parent
commit
64a6eaf91a

+ 277 - 134
packages/fcl-passrc/src/pasresolveeval.pas

@@ -47,6 +47,7 @@ Works:
   - error on duplicate in const set
   - error on duplicate in const set
 
 
 ToDo:
 ToDo:
+- set of 1..7
 - arrays
 - arrays
   - length(), low(), high(), []
   - length(), low(), high(), []
 }
 }
@@ -375,7 +376,7 @@ type
 
 
   TRESetElKind = (
   TRESetElKind = (
     revskNone,
     revskNone,
-    revskEnum, // IdentEl is TPasEnumType
+    revskEnum, // ElType is TPasEnumType
     revskInt,
     revskInt,
     revskChar,
     revskChar,
     revskBool
     revskBool
@@ -387,11 +388,13 @@ type
   public
   public
     ElKind: TRESetElKind;
     ElKind: TRESetElKind;
     RangeStart, RangeEnd: MaxPrecInt;
     RangeStart, RangeEnd: MaxPrecInt;
+    ElType: TPasType; // revskEnum: TPasEnumType
     constructor Create; override;
     constructor Create; override;
-    constructor CreateValue(const aElKind: TRESetElKind;
+    constructor CreateValue(const aElKind: TRESetElKind; aElType: TPasType;
       const aRangeStart, aRangeEnd: MaxPrecInt);
       const aRangeStart, aRangeEnd: MaxPrecInt);
     function Clone: TResEvalValue; override;
     function Clone: TResEvalValue; override;
     function AsString: string; override;
     function AsString: string; override;
+    function AsDebugString: string; override;
     function ElementAsString(El: MaxPrecInt): string;
     function ElementAsString(El: MaxPrecInt): string;
   end;
   end;
 
 
@@ -419,6 +422,7 @@ type
   public
   public
     ElKind: TRESetElKind;
     ElKind: TRESetElKind;
     Ranges: TItems; // disjunct, sorted ascending
     Ranges: TItems; // disjunct, sorted ascending
+    ElType: TPasType; // revskEnum: TPasEnumType
     constructor Create; override;
     constructor Create; override;
     constructor CreateEmpty(aSet: TResEvalSet);
     constructor CreateEmpty(aSet: TResEvalSet);
     function Clone: TResEvalValue; override;
     function Clone: TResEvalValue; override;
@@ -504,6 +508,10 @@ type
     constructor Create;
     constructor Create;
     function Eval(Expr: TPasExpr; Flags: TResEvalFlags): TResEvalValue;
     function Eval(Expr: TPasExpr; Flags: TResEvalFlags): TResEvalValue;
     function IsInRange(Expr, RangeExpr: TPasExpr; EmitHints: boolean): boolean;
     function IsInRange(Expr, RangeExpr: TPasExpr; EmitHints: boolean): boolean;
+    function IsInRange(Value: TResEvalValue; ValueExpr: TPasExpr;
+      RangeValue: TResEvalValue; RangeExpr: TPasExpr; EmitHints: boolean): boolean;
+    function IsSetCompatible(Value: TResEvalValue; ValueExpr: TPasExpr;
+      RangeValue: TResEvalValue; EmitHints: boolean): boolean;
     function IsConst(Expr: TPasExpr): boolean;
     function IsConst(Expr: TPasExpr): boolean;
     function IsSimpleExpr(Expr: TPasExpr): boolean; // true = no need to store result
     function IsSimpleExpr(Expr: TPasExpr): boolean; // true = no need to store result
     procedure EmitRangeCheckConst(id: int64; const aValue, MinVal, MaxVal: String;
     procedure EmitRangeCheckConst(id: int64; const aValue, MinVal, MaxVal: String;
@@ -1070,7 +1078,7 @@ begin
       if LeftInt>RightInt then
       if LeftInt>RightInt then
         RaiseMsg(20170714133540,nHighRangeLimitLTLowRangeLimit,
         RaiseMsg(20170714133540,nHighRangeLimitLTLowRangeLimit,
            sHighRangeLimitLTLowRangeLimit,[],Expr.Right);
            sHighRangeLimitLTLowRangeLimit,[],Expr.Right);
-      Result:=TResEvalRangeInt.CreateValue(revskBool,LeftInt,RightInt);
+      Result:=TResEvalRangeInt.CreateValue(revskBool,nil,LeftInt,RightInt);
       exit;
       exit;
       end;
       end;
   revkInt:
   revkInt:
@@ -1081,7 +1089,7 @@ begin
       if LeftInt>RightInt then
       if LeftInt>RightInt then
         RaiseMsg(20170518222939,nHighRangeLimitLTLowRangeLimit,
         RaiseMsg(20170518222939,nHighRangeLimitLTLowRangeLimit,
           sHighRangeLimitLTLowRangeLimit,[],Expr.Right);
           sHighRangeLimitLTLowRangeLimit,[],Expr.Right);
-      Result:=TResEvalRangeInt.CreateValue(revskInt,LeftInt,RightInt);
+      Result:=TResEvalRangeInt.CreateValue(revskInt,nil,LeftInt,RightInt);
       exit;
       exit;
       end
       end
     else if RightValue.Kind=revkUInt then
     else if RightValue.Kind=revkUInt then
@@ -1092,7 +1100,7 @@ begin
         if TResEvalInt(LeftValue).Int>TResEvalUInt(RightValue).UInt then
         if TResEvalInt(LeftValue).Int>TResEvalUInt(RightValue).UInt then
           RaiseMsg(20170519000235,nHighRangeLimitLTLowRangeLimit,
           RaiseMsg(20170519000235,nHighRangeLimitLTLowRangeLimit,
             sHighRangeLimitLTLowRangeLimit,[],Expr.Right);
             sHighRangeLimitLTLowRangeLimit,[],Expr.Right);
-        Result:=TResEvalRangeInt.CreateValue(revskInt,
+        Result:=TResEvalRangeInt.CreateValue(revskInt,nil,
            TResEvalInt(LeftValue).Int,MaxPrecInt(TResEvalUInt(RightValue).UInt));
            TResEvalInt(LeftValue).Int,MaxPrecInt(TResEvalUInt(RightValue).UInt));
         exit;
         exit;
         end
         end
@@ -1125,7 +1133,7 @@ begin
       else if TResEvalUInt(LeftValue).UInt>TResEvalInt(RightValue).Int then
       else if TResEvalUInt(LeftValue).UInt>TResEvalInt(RightValue).Int then
         RaiseMsg(20170522152804,nHighRangeLimitLTLowRangeLimit,
         RaiseMsg(20170522152804,nHighRangeLimitLTLowRangeLimit,
           sHighRangeLimitLTLowRangeLimit,[],Expr.Right);
           sHighRangeLimitLTLowRangeLimit,[],Expr.Right);
-      Result:=TResEvalRangeInt.CreateValue(revskInt,
+      Result:=TResEvalRangeInt.CreateValue(revskInt,nil,
         MaxPrecInt(TResEvalUInt(LeftValue).UInt),TResEvalInt(RightValue).Int);
         MaxPrecInt(TResEvalUInt(LeftValue).UInt),TResEvalInt(RightValue).Int);
       exit;
       exit;
       end
       end
@@ -1151,8 +1159,8 @@ begin
     else
     else
       begin
       begin
       Result:=TResEvalRangeInt.CreateValue(revskEnum,
       Result:=TResEvalRangeInt.CreateValue(revskEnum,
+        TResEvalEnum(LeftValue).IdentEl.Parent as TPasEnumType,
         TResEvalEnum(LeftValue).Index,TResEvalEnum(RightValue).Index);
         TResEvalEnum(LeftValue).Index,TResEvalEnum(RightValue).Index);
-      Result.IdentEl:=LeftValue.IdentEl.Parent as TPasEnumType;
       exit;
       exit;
       end;
       end;
   revkString,revkUnicodeString:
   revkString,revkUnicodeString:
@@ -1164,7 +1172,7 @@ begin
       if LeftInt>RightInt then
       if LeftInt>RightInt then
         RaiseMsg(20170523151508,nHighRangeLimitLTLowRangeLimit,
         RaiseMsg(20170523151508,nHighRangeLimitLTLowRangeLimit,
           sHighRangeLimitLTLowRangeLimit,[],Expr.Right);
           sHighRangeLimitLTLowRangeLimit,[],Expr.Right);
-      Result:=TResEvalRangeInt.CreateValue(revskChar,LeftInt,RightInt);
+      Result:=TResEvalRangeInt.CreateValue(revskChar,nil,LeftInt,RightInt);
       exit;
       exit;
       end
       end
     else
     else
@@ -2733,6 +2741,7 @@ var
   Param0: TPasExpr;
   Param0: TPasExpr;
   MaxIndex: Integer;
   MaxIndex: Integer;
 begin
 begin
+  Result:=nil;
   ArrayValue:=Eval(Expr.Value,Flags);
   ArrayValue:=Eval(Expr.Value,Flags);
   if ArrayValue=nil then
   if ArrayValue=nil then
     begin
     begin
@@ -2887,11 +2896,11 @@ begin
         if Result.ElKind=revskNone then
         if Result.ElKind=revskNone then
           begin
           begin
           Result.ElKind:=revskEnum;
           Result.ElKind:=revskEnum;
-          Result.IdentEl:=Value.IdentEl.Parent;
+          Result.ElType:=Value.IdentEl.Parent as TPasEnumType;
           end
           end
         else if Result.ElKind<>revskEnum then
         else if Result.ElKind<>revskEnum then
           RaiseNotYetImplemented(20170713143559,El)
           RaiseNotYetImplemented(20170713143559,El)
-        else if Result.IdentEl<>Value.IdentEl.Parent then
+        else if Result.ElType<>Value.IdentEl.Parent then
           RaiseNotYetImplemented(20170713201021,El);
           RaiseNotYetImplemented(20170713201021,El);
         RangeStart:=TResEvalEnum(Value).Index;
         RangeStart:=TResEvalEnum(Value).Index;
         RangeEnd:=RangeStart;
         RangeEnd:=RangeStart;
@@ -2902,7 +2911,7 @@ begin
           begin
           begin
           Result.ElKind:=TResEvalRangeInt(Value).ElKind;
           Result.ElKind:=TResEvalRangeInt(Value).ElKind;
           if Result.ElKind=revskEnum then
           if Result.ElKind=revskEnum then
-            Result.IdentEl:=Value.IdentEl;
+            Result.ElType:=TResEvalRangeInt(Value).ElType;
           end
           end
         else if Result.ElKind<>TResEvalRangeInt(Value).ElKind then
         else if Result.ElKind<>TResEvalRangeInt(Value).ElKind then
           RaiseNotYetImplemented(20170714101910,El);
           RaiseNotYetImplemented(20170714101910,El);
@@ -3261,7 +3270,10 @@ begin
     begin
     begin
     case TPrimitiveExpr(Expr).Kind of
     case TPrimitiveExpr(Expr).Kind of
       pekIdent:
       pekIdent:
+        begin
         Result:=OnEvalIdentifier(Self,TPrimitiveExpr(Expr),Flags);
         Result:=OnEvalIdentifier(Self,TPrimitiveExpr(Expr),Flags);
+        writeln('TResExprEvaluator.Eval primitiv result=',Result<>nil,' ',dbgs(Result));
+        end;
       pekNumber:
       pekNumber:
         begin
         begin
         // try MaxPrecInt
         // try MaxPrecInt
@@ -3295,6 +3307,7 @@ begin
     else
     else
       RaiseNotYetImplemented(20170518200951,Expr);
       RaiseNotYetImplemented(20170518200951,Expr);
     end;
     end;
+    writeln('TResExprEvaluator.Eval primitiv end result=',Result<>nil,' ',dbgs(Result));
     end
     end
   else if C=TNilExpr then
   else if C=TNilExpr then
     Result:=TResEvalValue.CreateKind(revkNil)
     Result:=TResEvalValue.CreateKind(revkNil)
@@ -3308,158 +3321,235 @@ begin
     Result:=EvalParamsExpr(TParamsExpr(Expr),Flags)
     Result:=EvalParamsExpr(TParamsExpr(Expr),Flags)
   else if refConst in Flags then
   else if refConst in Flags then
     RaiseConstantExprExp(20170518213800,Expr);
     RaiseConstantExprExp(20170518213800,Expr);
+  writeln('TResExprEvaluator.Eval END result=',Result<>nil,' ',dbgs(Result));
 end;
 end;
 
 
 function TResExprEvaluator.IsInRange(Expr, RangeExpr: TPasExpr;
 function TResExprEvaluator.IsInRange(Expr, RangeExpr: TPasExpr;
   EmitHints: boolean): boolean;
   EmitHints: boolean): boolean;
 var
 var
-  ExprValue, RangeValue: TResEvalValue;
-  RgInt: TResEvalRangeInt;
-  RgUInt: TResEvalRangeUInt;
-  CharIndex: LongWord;
+  Value, RangeValue: TResEvalValue;
 begin
 begin
-  Result:=false;
-  ExprValue:=Eval(Expr,[refAutoConst]);
-  if ExprValue=nil then
+  Value:=Eval(Expr,[refAutoConst]);
+  if Value=nil then
     exit(true); // a variable -> ok
     exit(true); // a variable -> ok
   RangeValue:=nil;
   RangeValue:=nil;
   try
   try
     RangeValue:=Eval(RangeExpr,[]);
     RangeValue:=Eval(RangeExpr,[]);
-    {$IFDEF VerbosePasResEval}
-    //writeln('TResExprEvaluator.IsInRange ExprValue=',dbgs(ExprValue),' RangeValue=',dbgs(RangeValue));
-    {$ENDIF}
     if RangeValue=nil then
     if RangeValue=nil then
       RaiseNotYetImplemented(20170522171226,RangeExpr);
       RaiseNotYetImplemented(20170522171226,RangeExpr);
-    case RangeValue.Kind of
-    revkRangeInt:
-      begin
-      RgInt:=TResEvalRangeInt(RangeValue);
-      case RgInt.ElKind of
-        revskBool:
-          if ExprValue.Kind=revkBool then
-            exit(true)
-          else
-            RaiseNotYetImplemented(20170522220104,Expr);
-        revskEnum:
+    Result:=IsInRange(Value,Expr,RangeValue,RangeExpr,EmitHints);
+  finally
+    ReleaseEvalValue(Value);
+    ReleaseEvalValue(RangeValue);
+  end;
+end;
+
+function TResExprEvaluator.IsInRange(Value: TResEvalValue; ValueExpr: TPasExpr;
+  RangeValue: TResEvalValue; RangeExpr: TPasExpr; EmitHints: boolean): boolean;
+var
+  RgInt: TResEvalRangeInt;
+  RgUInt: TResEvalRangeUInt;
+  CharIndex: LongWord;
+begin
+  Result:=false;
+  {$IFDEF VerbosePasResEval}
+  //writeln('TResExprEvaluator.IsInRange ExprValue=',dbgs(Value),' RangeValue=',dbgs(RangeValue));
+  {$ENDIF}
+  case RangeValue.Kind of
+  revkRangeInt:
+    begin
+    RgInt:=TResEvalRangeInt(RangeValue);
+    case RgInt.ElKind of
+      revskBool:
+        if Value.Kind=revkBool then
+          exit(true)
+        else
+          RaiseNotYetImplemented(20170522220104,ValueExpr);
+      revskEnum:
+        begin
+        if Value.Kind<>revkEnum then
+          RaiseInternalError(20170522172754)
+        else if TResEvalEnum(Value).IdentEl<>RgInt.ElType then
+          RaiseInternalError(20170522174028)
+        else if (TResEvalEnum(Value).Index<RgInt.RangeStart)
+            or (TResEvalEnum(Value).Index>RgInt.RangeEnd) then
+          begin
+          if EmitHints then
+            EmitRangeCheckConst(20170522174406,Value.AsString,
+              RgInt.ElementAsString(RgInt.RangeStart),
+              RgInt.ElementAsString(RgInt.RangeEnd),
+              ValueExpr);
+          exit(false);
+          end
+        else
+          exit(true);
+        end;
+      revskInt: // int..int
+        if Value.Kind=revkInt then
           begin
           begin
-          if ExprValue.Kind<>revkEnum then
-            RaiseInternalError(20170522172754)
-          else if ExprValue.IdentEl<>RgInt.IdentEl then
-            RaiseInternalError(20170522174028)
-          else if (TResEvalEnum(ExprValue).Index<RgInt.RangeStart)
-              or (TResEvalEnum(ExprValue).Index>RgInt.RangeEnd) then
+          // int in int..int
+          if (TResEvalInt(Value).Int<RgInt.RangeStart)
+              or (TResEvalInt(Value).Int>RgInt.RangeEnd) then
             begin
             begin
             if EmitHints then
             if EmitHints then
-              EmitRangeCheckConst(20170522174406,ExprValue.AsString,
+              EmitRangeCheckConst(20170522174958,Value.AsString,
                 RgInt.ElementAsString(RgInt.RangeStart),
                 RgInt.ElementAsString(RgInt.RangeStart),
                 RgInt.ElementAsString(RgInt.RangeEnd),
                 RgInt.ElementAsString(RgInt.RangeEnd),
-                Expr);
+                ValueExpr);
             exit(false);
             exit(false);
             end
             end
           else
           else
             exit(true);
             exit(true);
-          end;
-        revskInt: // int..int
-          if ExprValue.Kind=revkInt then
-            begin
-            // int in int..int
-            if (TResEvalInt(ExprValue).Int<RgInt.RangeStart)
-                or (TResEvalInt(ExprValue).Int>RgInt.RangeEnd) then
-              begin
-              if EmitHints then
-                EmitRangeCheckConst(20170522174958,ExprValue.AsString,
-                  RgInt.ElementAsString(RgInt.RangeStart),
-                  RgInt.ElementAsString(RgInt.RangeEnd),
-                  Expr);
-              exit(false);
-              end
-            else
-              exit(true);
-            end
-          else if ExprValue.Kind=revkUInt then
+          end
+        else if Value.Kind=revkUInt then
+          begin
+          // uint in int..int
+          if (TResEvalUInt(Value).UInt>HighIntAsUInt)
+              or (MaxPrecInt(TResEvalUInt(Value).UInt)<RgInt.RangeStart)
+              or (MaxPrecInt(TResEvalUInt(Value).UInt)>RgInt.RangeEnd) then
             begin
             begin
-            // uint in int..int
-            if (TResEvalUInt(ExprValue).UInt>HighIntAsUInt)
-                or (MaxPrecInt(TResEvalUInt(ExprValue).UInt)<RgInt.RangeStart)
-                or (MaxPrecInt(TResEvalUInt(ExprValue).UInt)>RgInt.RangeEnd) then
-              begin
-              if EmitHints then
-                EmitRangeCheckConst(20170522215852,ExprValue.AsString,
-                  RgInt.ElementAsString(RgInt.RangeStart),
-                  RgInt.ElementAsString(RgInt.RangeEnd),
-                  Expr);
-              exit(false);
-              end
-            else
-              exit(true);
+            if EmitHints then
+              EmitRangeCheckConst(20170522215852,Value.AsString,
+                RgInt.ElementAsString(RgInt.RangeStart),
+                RgInt.ElementAsString(RgInt.RangeEnd),
+                ValueExpr);
+            exit(false);
             end
             end
           else
           else
-            RaiseNotYetImplemented(20170522215906,Expr);
-        revskChar:
-          if ExprValue.Kind in [revkString,revkUnicodeString] then
+            exit(true);
+          end
+        else
+          begin
+          {$IF defined(VerbosePasResEval) or defined(VerbosePasResolver)}
+          writeln('TResExprEvaluator.IsInRange Kind=',Value.Kind,' ',Value.AsDebugString);
+          {$ENDIF}
+          RaiseNotYetImplemented(20170522215906,ValueExpr);
+          end;
+      revskChar:
+        if Value.Kind in [revkString,revkUnicodeString] then
+          begin
+          // string in char..char
+          CharIndex:=ExprStringToOrd(Value,ValueExpr);
+          if (CharIndex<RgInt.RangeStart) or (CharIndex>RgInt.RangeEnd) then
             begin
             begin
-            // string in char..char
-            CharIndex:=ExprStringToOrd(ExprValue,Expr);
-            if (CharIndex<RgInt.RangeStart) or (CharIndex>RgInt.RangeEnd) then
-              begin
-              if EmitHints then
-                EmitRangeCheckConst(20170522221709,ExprValue.AsString,
-                  RgInt.ElementAsString(RgInt.RangeStart),
-                  RgInt.ElementAsString(RgInt.RangeEnd),
-                  Expr);
-              exit(false);
-              end
-            else
-              exit(true);
+            if EmitHints then
+              EmitRangeCheckConst(20170522221709,Value.AsString,
+                RgInt.ElementAsString(RgInt.RangeStart),
+                RgInt.ElementAsString(RgInt.RangeEnd),
+                ValueExpr);
+            exit(false);
             end
             end
           else
           else
-            RaiseNotYetImplemented(20170522220210,Expr);
-      else
-        RaiseInternalError(20170522172630);
-      end;
-      end;
-    revkRangeUInt:
-      if ExprValue.Kind=revkInt then
-        begin
-        // int in uint..uint
-        RgUInt:=TResEvalRangeUInt(RangeValue);
-        if (TResEvalInt(ExprValue).Int<0)
-            or (MaxPrecUInt(TResEvalInt(ExprValue).Int)<RgUInt.RangeStart)
-            or (MaxPrecUInt(TResEvalInt(ExprValue).Int)>RgUInt.RangeEnd) then
-          begin
-          if EmitHints then
-            EmitRangeCheckConst(20170522172250,ExprValue.AsString,
-              IntToStr(RgUInt.RangeStart),
-              IntToStr(RgUInt.RangeEnd),Expr);
-          exit(false);
+            exit(true);
           end
           end
         else
         else
-          exit(true);
+          RaiseNotYetImplemented(20170522220210,ValueExpr);
+    else
+      RaiseInternalError(20170522172630);
+    end;
+    end;
+  revkRangeUInt:
+    if Value.Kind=revkInt then
+      begin
+      // int in uint..uint
+      RgUInt:=TResEvalRangeUInt(RangeValue);
+      if (TResEvalInt(Value).Int<0)
+          or (MaxPrecUInt(TResEvalInt(Value).Int)<RgUInt.RangeStart)
+          or (MaxPrecUInt(TResEvalInt(Value).Int)>RgUInt.RangeEnd) then
+        begin
+        if EmitHints then
+          EmitRangeCheckConst(20170522172250,Value.AsString,
+            IntToStr(RgUInt.RangeStart),
+            IntToStr(RgUInt.RangeEnd),ValueExpr);
+        exit(false);
         end
         end
-      else if ExprValue.Kind=revkUInt then
+      else
+        exit(true);
+      end
+    else if Value.Kind=revkUInt then
+      begin
+      // uint in uint..uint
+      RgUInt:=TResEvalRangeUInt(RangeValue);
+      if (TResEvalUInt(Value).UInt<RgUInt.RangeStart)
+          or (TResEvalUInt(Value).UInt>RgUInt.RangeEnd) then
         begin
         begin
-        // uint in uint..uint
-        RgUInt:=TResEvalRangeUInt(RangeValue);
-        if (TResEvalUInt(ExprValue).UInt<RgUInt.RangeStart)
-            or (TResEvalUInt(ExprValue).UInt>RgUInt.RangeEnd) then
-          begin
-          if EmitHints then
-            EmitRangeCheckConst(20170522172544,IntToStr(TResEvalUInt(ExprValue).UInt),
-              IntToStr(RgUInt.RangeStart),
-              IntToStr(RgUInt.RangeEnd),Expr);
-          exit(false);
-          end
-        else
-          exit(true);
+        if EmitHints then
+          EmitRangeCheckConst(20170522172544,IntToStr(TResEvalUInt(Value).UInt),
+            IntToStr(RgUInt.RangeStart),
+            IntToStr(RgUInt.RangeEnd),ValueExpr);
+        exit(false);
         end
         end
       else
       else
-        RaiseNotYetImplemented(20170522171551,Expr);
+        exit(true);
+      end
+    else
+      RaiseNotYetImplemented(20170522171551,ValueExpr);
+  else
+    RaiseNotYetImplemented(20170522171307,RangeExpr);
+  end;
+end;
+
+function TResExprEvaluator.IsSetCompatible(Value: TResEvalValue;
+  ValueExpr: TPasExpr; RangeValue: TResEvalValue; EmitHints: boolean): boolean;
+// checks if Value fits into a set of RangeValue
+var
+  RightSet: TResEvalSet;
+  LeftRange: TResEvalRangeInt;
+  MinVal, MaxVal: MaxPrecInt;
+begin
+  Result:=true;
+  case Value.Kind of
+  revkSetOfInt:
+    begin
+    RightSet:=TResEvalSet(Value);
+    if RightSet.ElKind=revskNone then
+      exit(true); // empty set always fits
+    case RangeValue.Kind of
+    revkRangeInt:
+      begin
+      LeftRange:=TResEvalRangeInt(RangeValue);
+      if (LeftRange.ElKind<>RightSet.ElKind)
+          or (LeftRange.ElType<>RightSet.ElType) then
+        begin
+        {$IF defined(VerbosePasResEval) or defined(VerbosePasResolver)}
+        writeln('TResExprEvaluator.IsSetCompatible Value=',dbgs(Value),' RangeValue=',dbgs(RangeValue));
+        {$ENDIF}
+        RaiseNotYetImplemented(20170714201425,ValueExpr);
+        end;
+      if length(RightSet.Ranges)=0 then
+        exit(true); // empty typed set fits
+      MinVal:=RightSet.Ranges[0].RangeStart;
+      MaxVal:=RightSet.Ranges[length(RightSet.Ranges)-1].RangeEnd;
+      {$IFDEF VerbosePasResEval}
+      writeln('TResExprEvaluator.IsSetCompatible Value=',dbgs(Value),' MinVal=',MinVal,' MaxVal=',MaxVal,' RangeValue=',dbgs(RangeValue));
+      {$ENDIF}
+      if (MinVal<LeftRange.RangeStart) then
+        if EmitHints then
+          EmitRangeCheckConst(20170714202813,RightSet.ElementAsString(MinVal),
+            LeftRange.ElementAsString(LeftRange.RangeStart),
+            LeftRange.ElementAsString(LeftRange.RangeEnd),ValueExpr,mtError)
+        else
+          exit(false);
+      if (MaxVal>LeftRange.RangeEnd) then
+        if EmitHints then
+          EmitRangeCheckConst(20170714203134,RightSet.ElementAsString(MaxVal),
+            LeftRange.ElementAsString(LeftRange.RangeStart),
+            LeftRange.ElementAsString(LeftRange.RangeEnd),ValueExpr,mtError)
+        else
+          exit(false);
+      end;
     else
     else
-      RaiseNotYetImplemented(20170522171307,RangeExpr);
+      {$IF defined(VerbosePasResEval) or defined(VerbosePasResolver)}
+      writeln('TResExprEvaluator.IsSetCompatible Value=',dbgs(Value),' RangeValue=',dbgs(RangeValue));
+      {$ENDIF}
+      RaiseNotYetImplemented(20170714201121,ValueExpr);
     end;
     end;
-  finally
-    ReleaseEvalValue(ExprValue);
-    ReleaseEvalValue(RangeValue);
+    end
+  else
+    {$IF defined(VerbosePasResEval) or defined(VerbosePasResolver)}
+    writeln('TResExprEvaluator.IsSetCompatible Value=',Value.Kind,' ',dbgs(RangeValue));
+    {$ENDIF}
+    RaiseNotYetImplemented(20170714195815,ValueExpr);
   end;
   end;
 end;
 end;
 
 
@@ -4117,10 +4207,11 @@ begin
 end;
 end;
 
 
 constructor TResEvalRangeInt.CreateValue(const aElKind: TRESetElKind;
 constructor TResEvalRangeInt.CreateValue(const aElKind: TRESetElKind;
-  const aRangeStart, aRangeEnd: MaxPrecInt);
+  aElType: TPasType; const aRangeStart, aRangeEnd: MaxPrecInt);
 begin
 begin
   Create;
   Create;
   ElKind:=aElKind;
   ElKind:=aElKind;
+  ElType:=aElType;
   RangeStart:=aRangeStart;
   RangeStart:=aRangeStart;
   RangeEnd:=aRangeEnd;
   RangeEnd:=aRangeEnd;
 end;
 end;
@@ -4138,16 +4229,29 @@ begin
   Result:=ElementAsString(RangeStart)+'..'+ElementAsString(RangeEnd);
   Result:=ElementAsString(RangeStart)+'..'+ElementAsString(RangeEnd);
 end;
 end;
 
 
+function TResEvalRangeInt.AsDebugString: string;
+var
+  s: string;
+begin
+  str(Kind,Result);
+  str(ElKind,s);
+  Result:=Result+'/'+s+':'+GetObjName(ElType)+'='+AsString;
+end;
+
 function TResEvalRangeInt.ElementAsString(El: MaxPrecInt): string;
 function TResEvalRangeInt.ElementAsString(El: MaxPrecInt): string;
 var
 var
   EnumValue: TPasEnumValue;
   EnumValue: TPasEnumValue;
   EnumType: TPasEnumType;
   EnumType: TPasEnumType;
 begin
 begin
   case ElKind of
   case ElKind of
-    revskBool: if El=0 then Result:='false' else Result:='true';
+    revskBool:
+      if El=0 then
+        Result:='false'
+      else
+        Result:='true';
     revskEnum:
     revskEnum:
       begin
       begin
-      EnumType:=IdentEl as TPasEnumType;
+      EnumType:=ElType as TPasEnumType;
       EnumValue:=TPasEnumValue(EnumType.Values[El]);
       EnumValue:=TPasEnumValue(EnumType.Values[El]);
       Result:=EnumValue.Name;
       Result:=EnumValue.Name;
       end;
       end;
@@ -4170,8 +4274,10 @@ end;
 
 
 constructor TResEvalSet.CreateEmpty(aSet: TResEvalSet);
 constructor TResEvalSet.CreateEmpty(aSet: TResEvalSet);
 begin
 begin
-  ElKind:=aSet.ElKind;
+  Create;
   IdentEl:=aSet.IdentEl;
   IdentEl:=aSet.IdentEl;
+  ElKind:=aSet.ElKind;
+  ElType:=aSet.ElType;
 end;
 end;
 
 
 function TResEvalSet.Clone: TResEvalValue;
 function TResEvalSet.Clone: TResEvalValue;
@@ -4180,8 +4286,9 @@ var
   i: Integer;
   i: Integer;
 begin
 begin
   Result:=inherited Clone;
   Result:=inherited Clone;
-  TResEvalSet(Result).ElKind:=ElKind;
   RS:=TResEvalSet(Result);
   RS:=TResEvalSet(Result);
+  RS.ElKind:=ElKind;
+  RS.ElType:=ElType;
   SetLength(RS.Ranges,length(Ranges));
   SetLength(RS.Ranges,length(Ranges));
   for i:=0 to length(Ranges)-1 do
   for i:=0 to length(Ranges)-1 do
     RS.Ranges[i]:=Ranges[i];
     RS.Ranges[i]:=Ranges[i];
@@ -4203,9 +4310,22 @@ begin
 end;
 end;
 
 
 function TResEvalSet.ElementAsString(El: MaxPrecInt): string;
 function TResEvalSet.ElementAsString(El: MaxPrecInt): string;
+var
+  EnumType: TPasEnumType;
+  EnumValue: TPasEnumValue;
 begin
 begin
   case ElKind of
   case ElKind of
-    revskEnum: Result:=TPasEnumValue(TPasEnumType(IdentEl).Values[El]).Name;
+    revskEnum:
+      begin
+      {$IFDEF VerbosePasResEval}
+      if not (ElType is TPasEnumType) then
+        writeln('TResEvalSet.ElementAsString ',ElKind,' expected TPasEnumType, but got ',GetObjName(ElType));
+      {$ENDIF}
+      EnumType:=ElType as TPasEnumType;
+      //writeln('TResEvalSet.ElementAsString EnumType=',GetObjName(EnumType),' Values.Count=',EnumType.Values.Count,' El=',El);
+      EnumValue:=TPasEnumValue(EnumType.Values[El]);
+      Result:=EnumValue.Name;
+      end;
     revskInt: Result:=IntToStr(El);
     revskInt: Result:=IntToStr(El);
     revskChar:
     revskChar:
       if El<=$ff then
       if El<=$ff then
@@ -4221,6 +4341,29 @@ begin
 end;
 end;
 
 
 function TResEvalSet.Add(RangeStart, RangeEnd: MaxPrecInt): boolean;
 function TResEvalSet.Add(RangeStart, RangeEnd: MaxPrecInt): boolean;
+
+  {$IF FPC_FULLVERSION<30101}
+  procedure Insert(const Item: TItem; var Items: TItems; Index: integer);
+  var
+    i: Integer;
+  begin
+    Setlength(Items,length(Items)+1);
+    for i:=length(Items)-1 downto Index+1 do
+      Items[i]:=Items[i-1];
+    Items[Index]:=Item;
+  end;
+
+  procedure Delete(var Items: TItems; Start, Size: integer);
+  var
+    i: Integer;
+  begin
+    if Size=0 then exit;
+    for i:=Start+Size to length(Items)-1 do
+      Items[i-Size]:=Items[i];
+    Setlength(Items,length(Items)-Size);
+  end;
+  {$ENDIF}
+
 var
 var
   StartIndex, l, EndIndex: Integer;
   StartIndex, l, EndIndex: Integer;
   Item: TItem;
   Item: TItem;

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

@@ -7435,11 +7435,11 @@ begin
             TResEvalRangeInt(Result).RangeEnd:=$ffff;
             TResEvalRangeInt(Result).RangeEnd:=$ffff;
           end;
           end;
         btAnsiChar:
         btAnsiChar:
-          Result:=TResEvalRangeInt.CreateValue(revskChar,0,$ff);
+          Result:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ff);
         btWideChar:
         btWideChar:
-          Result:=TResEvalRangeInt.CreateValue(revskChar,0,$ffff);
+          Result:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ffff);
         btBoolean,btByteBool,btWordBool,btQWordBool:
         btBoolean,btByteBool,btWordBool,btQWordBool:
-          Result:=TResEvalRangeInt.CreateValue(revskBool,0,1);
+          Result:=TResEvalRangeInt.CreateValue(revskBool,nil,0,1);
         btByte,
         btByte,
         btShortInt,
         btShortInt,
         btWord,
         btWord,
@@ -7463,6 +7463,9 @@ begin
         end;
         end;
       end;
       end;
     end;
     end;
+  {$IFDEF VerbosePasResEval}
+  writeln('TPasResolver.OnExprEvalIdentifier END Result=',dbgs(Result),' refConst=',refConst in Flags);
+  {$ENDIF}
   if refConst in Flags then
   if refConst in Flags then
     RaiseConstantExprExp(20170518213616,Expr);
     RaiseConstantExprExp(20170518213616,Expr);
 end;
 end;
@@ -10822,10 +10825,15 @@ end;
 
 
 procedure TPasResolver.CheckAssignExprRange(
 procedure TPasResolver.CheckAssignExprRange(
   const LeftResolved: TPasResolverResult; RHS: TPasExpr);
   const LeftResolved: TPasResolverResult; RHS: TPasExpr);
+// check if RHS fits into range LeftResolved
 var
 var
-  RValue: TResEvalValue;
+  RValue, RangeValue: TResEvalValue;
   MinVal, MaxVal: int64;
   MinVal, MaxVal: int64;
-  RgExpr: TBinaryExpr;
+  RangeExpr: TBinaryExpr;
+  Int: MaxPrecInt;
+  C: TClass;
+  EnumType: TPasEnumType;
+  bt: TResolverBaseType;
 begin
 begin
   {$IFNDEF EnablePasResRangeCheck}
   {$IFNDEF EnablePasResRangeCheck}
   exit;
   exit;
@@ -10834,13 +10842,58 @@ begin
   if RValue=nil then
   if RValue=nil then
     exit; // not a const expression
     exit; // not a const expression
   {$IFDEF VerbosePasResEval}
   {$IFDEF VerbosePasResEval}
-  writeln('TPasResolver.CheckAssignExprRange ',RValue.AsDebugString);
+  writeln('TPasResolver.CheckAssignExprRange Left=',GetResolverResultDbg(LeftResolved),' RValue=',RValue.AsDebugString);
   {$ENDIF}
   {$ENDIF}
+  RangeValue:=nil;
   try
   try
-    if LeftResolved.TypeEl is TPasRangeType then
+    if LeftResolved.BaseType=btSet then
+      begin
+      // assign to a set
+      C:=LeftResolved.TypeEl.ClassType;
+      if C=TPasRangeType then
+        begin
+        RangeExpr:=TPasRangeType(LeftResolved.TypeEl).RangeExpr;
+        RangeValue:=Eval(RangeExpr,[],false);
+        end
+      else if C=TPasEnumType then
+        begin
+        EnumType:=TPasEnumType(LeftResolved.TypeEl);
+        RangeValue:=TResEvalRangeInt.CreateValue(revskEnum,EnumType,
+          0,EnumType.Values.Count-1);
+        end
+      else if C=TPasUnresolvedSymbolRef then
+        begin
+        // set of basetype
+        if LeftResolved.TypeEl.CustomData is TResElDataBaseType then
+          begin
+          bt:=GetActualBaseType(TResElDataBaseType(LeftResolved.TypeEl.CustomData).BaseType);
+          if (bt in (btAllInteger-[btQWord]))
+              and GetIntegerRange(bt,MinVal,MaxVal) then
+            RangeValue:=TResEvalRangeInt.CreateValue(revskInt,nil,MinVal,MaxVal)
+          else if bt=btBoolean then
+            RangeValue:=TResEvalRangeInt.CreateValue(revskBool,nil,0,1)
+          else if bt=btAnsiChar then
+            RangeValue:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ff)
+          else if bt=btWideChar then
+            RangeValue:=TResEvalRangeInt.CreateValue(revskChar,nil,0,$ffff)
+          else
+            RaiseNotYetImplemented(20170714205110,RHS);
+          end
+        else
+          RaiseNotYetImplemented(20170714204803,RHS);
+        end
+      else
+        RaiseNotYetImplemented(20170714193100,RHS);
+      fExprEvaluator.IsSetCompatible(RValue,RHS,RangeValue,true);
+      end
+    else if LeftResolved.TypeEl is TPasRangeType then
       begin
       begin
-      RgExpr:=TPasRangeType(LeftResolved.TypeEl).RangeExpr;
-      fExprEvaluator.IsInRange(RHS,RgExpr,true);
+      RangeExpr:=TPasRangeType(LeftResolved.TypeEl).RangeExpr;
+      RangeValue:=Eval(RangeExpr,[],false);
+      if LeftResolved.BaseType=btSet then
+        fExprEvaluator.IsSetCompatible(RValue,RHS,RangeValue,true)
+      else
+        fExprEvaluator.IsInRange(RValue,RHS,RangeValue,RangeExpr,true);
       end
       end
     else if (LeftResolved.BaseType in (btAllInteger-[btQWord]))
     else if (LeftResolved.BaseType in (btAllInteger-[btQWord]))
         and GetIntegerRange(LeftResolved.BaseType,MinVal,MaxVal) then
         and GetIntegerRange(LeftResolved.BaseType,MinVal,MaxVal) then
@@ -10869,13 +10922,40 @@ begin
       else
       else
         RaiseNotYetImplemented(20170530094311,RHS);
         RaiseNotYetImplemented(20170530094311,RHS);
       end
       end
-    else if RValue.Kind=revkNil then
-      // simple type check is enough
-    else if RValue.Kind=revkBool then
+    else if RValue.Kind in [revkNil,revkBool] then
       // simple type check is enough
       // simple type check is enough
     else if LeftResolved.BaseType in [btSingle,btDouble] then
     else if LeftResolved.BaseType in [btSingle,btDouble] then
       // simple type check is enough
       // simple type check is enough
-      // ToDo: check if precision loss
+      // ToDo: warn if precision loss
+    else if LeftResolved.BaseType in btAllChars then
+      begin
+      case RValue.Kind of
+      revkString:
+        if length(TResEvalString(RValue).S)<>1 then
+          RaiseXExpectedButYFound(20170714171352,'char','string',RHS)
+        else
+          Int:=ord(TResEvalString(RValue).S[1]);
+      revkUnicodeString:
+        if length(TResEvalUTF16(RValue).S)<>1 then
+          RaiseXExpectedButYFound(20170714171534,'char','string',RHS)
+        else
+          Int:=ord(TResEvalUTF16(RValue).S[1]);
+      else
+        RaiseNotYetImplemented(20170714171218,RHS);
+      end;
+      case GetActualBaseType(LeftResolved.BaseType) of
+      btAnsiChar: MaxVal:=$ff;
+      btWideChar: MaxVal:=$ffff;
+      end;
+      if (Int>MaxVal) then
+        fExprEvaluator.EmitRangeCheckConst(20170714171911,
+          '#'+IntToStr(Int),'#0','#'+IntToStr(MaxVal),RHS);
+      end
+    else if LeftResolved.BaseType in btAllStrings then
+      // simple type check is enough
+      // ToDo: warn if unicode to non-utf8
+    else if LeftResolved.BaseType=btContext then
+      // simple type check is enough
     else
     else
       begin
       begin
       {$IFDEF VerbosePasResolver}
       {$IFDEF VerbosePasResolver}
@@ -10885,6 +10965,7 @@ begin
       end;
       end;
   finally
   finally
     ReleaseEvalValue(RValue);
     ReleaseEvalValue(RValue);
+    ReleaseEvalValue(RangeValue);
   end;
   end;
 end;
 end;
 
 

+ 1 - 1
packages/fcl-passrc/tests/tcresolver.pas

@@ -2666,7 +2666,7 @@ begin
   Add('  {@MyInts}MyInts:=[1,2..3];');
   Add('  {@MyInts}MyInts:=[1,2..3];');
   Add('  {@MyBools}MyBools:=[false];');
   Add('  {@MyBools}MyBools:=[false];');
   Add('  {@MyBools}MyBools:=[false,true];');
   Add('  {@MyBools}MyBools:=[false,true];');
-  Add('  {@MyBools}MyBools:=[true..false];');
+  Add('  {@MyBools}MyBools:=[false..true];');
   ParseProgram;
   ParseProgram;
 end;
 end;