* report range errors for assigning out-of-range constants to enums in

Delphi mode (mantis #35671)
  * always give an error (rather than only a warning in case range checking
    is disabled) when assigning an out-of-range constant to an ordinal variable
    whose type does not span the entire range that its bits can hold (because
    the result is undefined and FPC's optimisers rely on variables only
    holding values that are valid for the type)

git-svn-id: trunk@42272 -

.gitattributes

@@ -14917,6 +14917,7 @@ tests/webtbf/tw35149a.pp svneol=native#text/plain
 tests/webtbf/tw35348.pp svneol=native#text/pascal
 tests/webtbf/tw3553.pp svneol=native#text/plain
 tests/webtbf/tw3562.pp svneol=native#text/plain
+tests/webtbf/tw35671.pp svneol=native#text/plain
 tests/webtbf/tw3583.pp svneol=native#text/plain
 tests/webtbf/tw3626.pp svneol=native#text/plain
 tests/webtbf/tw3631.pp svneol=native#text/plain

compiler/defutil.pas

@@ -68,6 +68,9 @@ interface
 
     procedure int_to_type(const v:TConstExprInt;var def:tdef);
 
+    {# Return true if the type (orddef or enumdef) spans its entire bitrange }
+    function spans_entire_range(def: tdef): boolean;
+
     {# Returns true, if definition defines an integer type }
     function is_integer(def : tdef) : boolean;
 
@@ -551,6 +554,47 @@ implementation
       end;
 
 
+    function spans_entire_range(def: tdef): boolean;
+      var
+         lv, hv: Tconstexprint;
+         mask: qword;
+         size: longint;
+      begin
+        case def.typ of
+          orddef,
+          enumdef:
+            getrange(def,lv,hv);
+          else
+            internalerror(2019062203);
+        end;
+        size:=def.size;
+        case size of
+          1: mask:=$ff;
+          2: mask:=$ffff;
+          4: mask:=$ffffffff;
+          8: mask:=qword(-1);
+          else
+            internalerror(2019062204);
+        end;
+        result:=false;
+        if is_signed(def) then
+          begin
+            if (lv.uvalue and mask)<>(qword(1) shl (size*8-1)) then
+              exit;
+            if (hv.uvalue and mask)<>(mask shr 1) then
+              exit;
+          end
+        else
+          begin
+            if lv<>0 then
+              exit;
+            if hv.uvalue<>mask then
+              exit;
+          end;
+        result:=true;
+      end;
+
+
     { true if p is an integer }
     function is_integer(def : tdef) : boolean;
       begin
@@ -1053,12 +1097,10 @@ implementation
            begin
              if not explicit then
                begin
-                 if ((todef.typ=enumdef) and
-                     { delphi allows range check errors in
-                      enumeration type casts FK }
-                     not(m_delphi in current_settings.modeswitches)) or
-                    (cs_check_range in current_settings.localswitches) or
-                    forcerangecheck then
+                 if (cs_check_range in current_settings.localswitches) or
+                    forcerangecheck or
+                    (not is_pasbool(todef) and
+                     not spans_entire_range(todef)) then
                    Message3(type_e_range_check_error_bounds,tostr(l),tostr(lv),tostr(hv))
                  else
                    Message3(type_w_range_check_error_bounds,tostr(l),tostr(lv),tostr(hv));

tests/webtbf/tw35671.pp

@@ -0,0 +1,15 @@
+{ %fail }
+program Project1;
+
+{$mode delphi}
+
+type
+  TSuit = (suHeart, suDiamond, suClub, suSpade);
+  TRedSuit = suHeart..suDiamond;
+
+var
+  Suit: TRedSuit;
+begin
+  // This should generate an error, but {$mode delphi} allows it
+  Suit := suClub;
+end.