* always force range checking for the upper and lower bounds of for-loops if

    they are constants (instead of only on 32 bit systems), and always use the
    actual upper/lower bound of the loop variable instead of hardcoding the
    bounds of longint (mantis #17646)

git-svn-id: trunk@16213 -

.gitattributes

@@ -9958,6 +9958,7 @@ tests/webtbf/tw1681.pp svneol=native#text/plain
 tests/webtbf/tw17455.pp svneol=native#text/plain
 tests/webtbf/tw1754.pp svneol=native#text/plain
 tests/webtbf/tw1754b.pp svneol=native#text/plain
+tests/webtbf/tw17646a.pp svneol=native#text/plain
 tests/webtbf/tw1782.pp svneol=native#text/plain
 tests/webtbf/tw1827.pp svneol=native#text/plain
 tests/webtbf/tw1830.pp svneol=native#text/plain
@@ -10714,6 +10715,7 @@ tests/webtbs/tw1755.pp svneol=native#text/plain
 tests/webtbs/tw17550.pp svneol=native#text/plain
 tests/webtbs/tw1758.pp svneol=native#text/plain
 tests/webtbs/tw17604.pp svneol=native#text/plain
+tests/webtbs/tw17646.pp svneol=native#text/plain
 tests/webtbs/tw1765.pp svneol=native#text/plain
 tests/webtbs/tw17675.pp svneol=native#text/plain
 tests/webtbs/tw17675a.pp svneol=native#text/plain

compiler/defutil.pas

@@ -223,7 +223,7 @@ interface
     {# If @var(l) isn't in the range of todef a range check error (if not explicit) is generated and
       the value is placed within the range
     }
-    procedure testrange(todef : tdef;var l : tconstexprint;explicit:boolean);
+    procedure testrange(todef : tdef;var l : tconstexprint;explicit,forcerangecheck:boolean);
 
     {# Returns the range of def, where @var(l) is the low-range and @var(h) is
       the high-range.
@@ -751,7 +751,7 @@ implementation
 
     { if l isn't in the range of todef a range check error (if not explicit) is generated and
       the value is placed within the range }
-    procedure testrange(todef : tdef;var l : tconstexprint;explicit:boolean);
+    procedure testrange(todef : tdef;var l : tconstexprint;explicit,forcerangecheck:boolean);
       var
          lv,hv: TConstExprInt;
       begin
@@ -766,7 +766,8 @@ implementation
                      { 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) then
+                    (cs_check_range in current_settings.localswitches) or
+                    forcerangecheck then
                    Message(parser_e_range_check_error)
                  else
                    Message(parser_w_range_check_error);

compiler/ncnv.pas

@@ -2266,7 +2266,7 @@ implementation
 {$endif VER2_2}
                      end
                    else
-                     testrange(resultdef,tordconstnode(left).value,(nf_explicit in flags));
+                     testrange(resultdef,tordconstnode(left).value,(nf_explicit in flags),false);
                    left.resultdef:=resultdef;
                    tordconstnode(left).typedef:=resultdef;
                    result:=left;

compiler/ncon.pas

@@ -669,7 +669,7 @@ implementation
         { only do range checking when explicitly asked for it
           and if the type can be range checked, see tests/tbs/tb0539.pp }
         if (resultdef.typ in [orddef,enumdef]) then
-           testrange(resultdef,value,not rangecheck)
+           testrange(resultdef,value,not rangecheck,false)
       end;
 
     function tordconstnode.pass_1 : tnode;

compiler/ninl.pas

@@ -1996,9 +1996,9 @@ implementation
                  (index.left.nodetype = ordconstn) and
                  not is_special_array(unpackedarraydef) then
                 begin
-                  testrange(unpackedarraydef,tordconstnode(index.left).value,false);
+                  testrange(unpackedarraydef,tordconstnode(index.left).value,false,false);
                   tempindex := tordconstnode(index.left).value + packedarraydef.highrange-packedarraydef.lowrange;
-                  testrange(unpackedarraydef,tempindex,false);
+                  testrange(unpackedarraydef,tempindex,false,false);
                 end;
             end;
 

compiler/pstatmnt.pas

@@ -205,8 +205,8 @@ implementation
                        CGMessage(parser_e_case_lower_less_than_upper_bound);
                      if not casedeferror then
                        begin
-                         testrange(casedef,hl1,false);
-                         testrange(casedef,hl2,false);
+                         testrange(casedef,hl1,false,false);
+                         testrange(casedef,hl2,false,false);
                        end;
                    end
                  else
@@ -234,7 +234,7 @@ implementation
                    begin
                      hl1:=get_ordinal_value(p);
                      if not casedeferror then
-                       testrange(casedef,hl1,false);
+                       testrange(casedef,hl1,false,false);
                      casenode.addlabel(blockid,hl1,hl1);
                    end;
                end;
@@ -321,20 +321,11 @@ implementation
 
     function for_statement : tnode;
 
-        procedure check_range(hp:tnode);
+        procedure check_range(hp:tnode; fordef: tdef);
           begin
-  {$ifndef cpu64bitaddr}
-            if hp.nodetype=ordconstn then
-              begin
-                if (tordconstnode(hp).value<int64(low(longint))) or
-                   (tordconstnode(hp).value>high(longint)) then
-                  begin
-                    CGMessage(parser_e_range_check_error);
-                    { recover, prevent more warnings/errors }
-                    tordconstnode(hp).value:=0;
-                  end;
-              end;
-  {$endif not cpu64bitaddr}
+            if (hp.nodetype=ordconstn) and
+               (fordef.typ<>errordef) then
+              testrange(fordef,tordconstnode(hp).value,false,true);
           end;
 
         function for_loop_create(hloopvar: tnode): tnode;
@@ -447,8 +438,8 @@ implementation
              consume(_DO);
 
              { Check if the constants fit in the range }
-             check_range(hfrom);
-             check_range(hto);
+             check_range(hfrom,hloopvar.resultdef);
+             check_range(hto,hloopvar.resultdef);
 
              { first set the varstate for from and to, so
                uses of loopvar in those expressions will also

compiler/ptconst.pas

@@ -251,7 +251,7 @@ implementation
                 begin
                    if is_constintnode(n) then
                      begin
-                       testrange(def,tordconstnode(n).value,false);
+                       testrange(def,tordconstnode(n).value,false,false);
                        case def.size of
                          1 :
                            list.concat(Tai_const.Create_8bit(byte(tordconstnode(n).value.svalue)));

tests/webtbf/tw17646a.pp

@@ -0,0 +1,14 @@
+{ %fail }
+
+program forrangecheck;
+
+var
+  i1: Word;
+  i2: LongWord;
+  i3: QWord;
+  cnt: longint;
+begin
+  cnt:=0;
+  for i1 :=  High(longword)-2 to High(longword) do
+    inc(cnt);
+end.

tests/webtbs/tw17646.pp

@@ -0,0 +1,68 @@
+program forrangecheck;
+
+var
+  i1: Word;
+  i2: LongWord;
+  i3: QWord;
+  cnt: longint;
+begin
+  cnt:=0;
+  for i1 :=  High(i1)-2 to High(i1) do
+    inc(cnt);
+  if cnt<>3 then
+    halt(1);
+
+  cnt:=0;
+  for i2 := high(i2)-2 to High(i2) do
+    inc(cnt);
+  if cnt<>3 then
+    halt(2);
+
+{$ifdef cpu64}
+  cnt:=0;
+  for i3 := high(i3)-2 to High(i3) do
+    inc(cnt);
+  if cnt<>3 then
+    halt(3);
+{$endif}
+
+  cnt:=0;
+  for i1 := high(word)-2 to High(Word) do
+    inc(cnt);
+  if cnt<>3 then
+    halt(4);
+
+  cnt:=0;
+  for i2 := high(longword)-2 to High(LongWord) do
+    inc(cnt);
+  if cnt<>3 then
+    halt(5);
+
+{$ifdef cpu64}
+  cnt:=0;
+  for i3 := high(qword)-2 to High(QWord) do
+    inc(cnt);
+  if cnt<>3 then
+    halt(6);
+{$endif}
+
+  cnt:=0;
+  for i1 := word($ffff)-2 to Word($FFFF) do
+    inc(cnt);
+  if cnt<>3 then
+    halt(7);
+
+  cnt:=0;
+  for i2 := longword($ffffffff)-2 to LongWord($FFFFFFFF) do
+    inc(cnt);
+  if cnt<>3 then
+    halt(8);
+
+{$ifdef cpu64}
+  cnt:=0;
+  for i3 := QWord($FFFFFFFFFFFFFFFF)-2 to QWord($FFFFFFFFFFFFFFFF) do
+    inc(cnt);
+  if cnt<>3 then
+    halt(9);
+{$endif}
+end.