Browse Source

+ range check assignments of constant sets, resolves #41132

florian 2 tháng trước cách đây
mục cha
commit
9bcb1b6f21
4 tập tin đã thay đổi với 59 bổ sung0 xóa
  1. 3 0
      compiler/ncnv.pas
  2. 35 0
      compiler/ncon.pas
  3. 10 0
      tests/tbs/tb0721.pp
  4. 11 0
      tests/webtbf/tw41132.pp

+ 3 - 0
compiler/ncnv.pas

@@ -1764,6 +1764,9 @@ implementation
         { constant sets can be converted by changing the type only }
         if (left.nodetype=setconstn) then
          begin
+           if (cs_check_range in current_settings.localswitches) and (tsetconstnode(left).elements>0) and ((tsetconstnode(left).low<tsetdef(resultdef).setlow) or (tsetconstnode(left).high>tsetdef(resultdef).setmax)) then
+             Message(parser_e_range_check_error);
+
            left.resultdef:=resultdef;
            result:=left;
            left:=nil;

+ 35 - 0
compiler/ncon.pas

@@ -173,6 +173,8 @@ interface
           function pass_typecheck:tnode;override;
           function docompare(p: tnode) : boolean; override;
           function elements : AInt;
+          function low : AInt;
+          function high : AInt;
           function emit_data(tcb:ttai_typedconstbuilder):sizeint;
        end;
        tsetconstnodeclass = class of tsetconstnode;
@@ -1458,6 +1460,39 @@ implementation
           result:=result+ PopCnt(Psetbytes(value_set)^[i]);
       end;
 
+
+    function tsetconstnode.low: AInt;
+      var
+        i: AInt;
+      begin
+        result:=0;
+        if not(assigned(value_set)) then
+          exit;
+        for i:=0 to tsetdef(resultdef).setmax do
+          if i in value_set^ then
+            begin
+              result:=i;
+              exit;
+            end;
+      end;
+
+
+    function tsetconstnode.high: AInt;
+      var
+        i: AInt;
+      begin
+        result:=0;
+        if not(assigned(value_set)) then
+          exit;
+        for i:=tsetdef(resultdef).setmax downto tsetdef(resultdef).setbase do
+          if i in value_set^ then
+            begin
+              result:=i;
+              exit;
+            end;
+      end;
+
+
     function tsetconstnode.emit_data(tcb:ttai_typedconstbuilder):sizeint;
       type
         setbytes=array[0..31] of byte;

+ 10 - 0
tests/tbs/tb0721.pp

@@ -0,0 +1,10 @@
+{$mode objfpc}{$H+}
+type
+  TmyRange = 1..10;
+var
+  x: integer;
+  Mark: set of TmyRange;
+begin
+  Mark := [5,11]; { don't throw a range check error here if range checking is off }
+  for x in Mark do write(x,' IN Mark');
+end.

+ 11 - 0
tests/webtbf/tw41132.pp

@@ -0,0 +1,11 @@
+{ %fail }
+{$mode objfpc}{$H+}{$R+}
+type
+  TmyRange = 1..10;
+var
+  x: integer;
+  Mark: set of TmyRange;
+begin
+  Mark := [5,11];{<-Why doesn't 11 cause a range check error?}
+  for x in Mark do write(x,' IN Mark');
+end.