浏览代码

Symbolic constants: don't range check on in use in typed constants

Same as 3da54dcf9f, but this type when used in type constant definitions
like record fiels
Jonas Maebe 3 年之前
父节点
当前提交
b1f85792d7
共有 3 个文件被更改,包括 74 次插入3 次删除
  1. 12 3
      compiler/ngtcon.pas
  2. 30 0
      tests/tbs/tb0693a.pp
  3. 32 0
      tests/tbs/tb0693b.pp

+ 12 - 3
compiler/ngtcon.pas

@@ -1121,17 +1121,26 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
 
 
     procedure tasmlisttypedconstbuilder.tc_emit_enumdef(def: tenumdef; var node: tnode);
+      var
+        equal: boolean;
       begin
         if node.nodetype=ordconstn then
           begin
-            if equal_defs(node.resultdef,def) or
+            equal:=equal_defs(node.resultdef,def);
+            if equal or
                is_subequal(node.resultdef,def) then
               begin
-                adaptrange(def,tordconstnode(node).value,false,false,cs_check_range in current_settings.localswitches);
-                case longint(node.resultdef.size) of
+                { if equal, the necessary range checking has already been
+                  performed; needed for handling hacks like
+                    const x = tenum(255); }
+                if not equal then
+                  adaptrange(def,tordconstnode(node).value,false,false,cs_check_range in current_settings.localswitches);
+                case node.resultdef.size of
                   1 : ftcb.emit_tai(Tai_const.Create_8bit(Byte(tordconstnode(node).value.svalue)),def);
                   2 : ftcb.emit_tai(Tai_const.Create_16bit(Word(tordconstnode(node).value.svalue)),def);
                   4 : ftcb.emit_tai(Tai_const.Create_32bit(Longint(tordconstnode(node).value.svalue)),def);
+                  else
+                    internalerror(2022040301);
                 end;
               end
             else

+ 30 - 0
tests/tbs/tb0693a.pp

@@ -0,0 +1,30 @@
+{ %norun }
+
+program T001;
+{$MODE DELPHI}
+{$R-}
+type
+  TLanguages = (
+    lOne,
+    lTwo,
+    lThree,
+    lFour
+  );
+ 
+const
+  LANGUAGE_NONE = TLanguages(255);
+ 
+type
+ TLanguage = record
+   Index : TLanguages;
+ end;
+ 
+var
+  Lang: TLanguages;
+  CurrentLanguage: TLanguage = (
+    Index:  LANGUAGE_NONE
+  );
+ 
+begin
+  Lang := LANGUAGE_NONE;
+end.

+ 32 - 0
tests/tbs/tb0693b.pp

@@ -0,0 +1,32 @@
+{ %fail }
+
+program T001;
+{$MODE DELPHI}
+{$R-}
+type
+  TLanguages = (
+    lOne,
+    lTwo,
+    lThree,
+    lFour
+  );
+
+  TLanguagesSub = lOne..lTwo;
+ 
+const
+  LANGUAGE_NONE = TLanguages(255);
+ 
+type
+ TLanguage = record
+   Index : TLanguagesSub;
+ end;
+ 
+var
+  Lang: TLanguages;
+  CurrentLanguage: TLanguage = (
+    Index:  LANGUAGE_NONE
+  );
+ 
+begin
+  Lang := LANGUAGE_NONE;
+end.