From a2217cedd5c422a65b23b21df4f0a434c747988b Mon Sep 17 00:00:00 2001
From: Jonas Maebe <jonas@freepascal.org>
Date: Sun, 7 Jan 2018 18:51:53 +0000
Subject: [PATCH]   * evaluate the lower and upper bounds of for-loops in ISO
 mode using the     ISO-defined range type, instead of using the type of the
 iteration     variable (mantis #24318)

git-svn-id: trunk@37934 -
---
 .gitattributes          |  1 +
 compiler/defutil.pas    | 32 ++++++++++++++++++++++++++++++++
 compiler/nflw.pas       | 14 ++++++++++----
 tests/webtbs/tw24318.pp | 24 ++++++++++++++++++++++++
 4 files changed, 67 insertions(+), 4 deletions(-)
 create mode 100644 tests/webtbs/tw24318.pp

diff --git a/.gitattributes b/.gitattributes
index 85638e1cc6..0b4818eaab 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -15425,6 +15425,7 @@ tests/webtbs/tw24197.pp svneol=native#text/plain
 tests/webtbs/tw2421.pp svneol=native#text/plain
 tests/webtbs/tw2423.pp svneol=native#text/plain
 tests/webtbs/tw2425.pp svneol=native#text/plain
+tests/webtbs/tw24318.pp svneol=native#text/plain
 tests/webtbs/tw2432.pp svneol=native#text/plain
 tests/webtbs/tw2435.pp svneol=native#text/plain
 tests/webtbs/tw2438.pp svneol=native#text/plain
diff --git a/compiler/defutil.pas b/compiler/defutil.pas
index ec55cf097c..55c58c6219 100644
--- a/compiler/defutil.pas
+++ b/compiler/defutil.pas
@@ -290,6 +290,9 @@ interface
     }
     procedure getrange(def : tdef;out l, h : TConstExprInt);
 
+    { Returns the range type of an ordinal type in the sense of ISO-10206 }
+    function get_iso_range_type(def: tdef): tdef;
+
     { type being a vector? }
     function is_vector(p : tdef) : boolean;
 
@@ -1114,6 +1117,35 @@ implementation
       end;
 
 
+    { The range-type of an ordinal-type that is a subrange-type shall be the host-type (see 6.4.2.4) of the subrange-type.
+      The range-type of an ordinal-type that is not a subrange-type shall be the ordinal-type.
+
+      The subrange-bounds shall be of compatible ordinal-types, and the range-type (see 6.4.2.1) of the ordinal-types shall
+      be designated the host-type of the subrange-type. }
+    function get_iso_range_type(def: tdef): tdef;
+      begin
+        result:=nil;
+        case def.typ of
+           orddef:
+             begin
+               if (torddef(def).low>=torddef(sinttype).low) and
+                  (torddef(def).high<=torddef(sinttype).high) then
+                 result:=sinttype
+               else
+                 range_to_type(torddef(def).low,torddef(def).high,result);
+             end;
+           enumdef:
+             begin
+               while assigned(tenumdef(def).basedef) do
+                 def:=tenumdef(def).basedef;
+               result:=def;
+             end
+           else
+             internalerror(2018010701);
+        end;
+      end;
+
+
     function is_vector(p : tdef) : boolean;
       begin
         result:=(p.typ=arraydef) and
diff --git a/compiler/nflw.pas b/compiler/nflw.pas
index 78787531cc..61dde38e2f 100644
--- a/compiler/nflw.pas
+++ b/compiler/nflw.pas
@@ -1497,6 +1497,7 @@ implementation
     function tfornode.pass_typecheck:tnode;
       var
         res : tnode;
+        rangedef: tdef;
       begin
          result:=nil;
          resultdef:=voidtype;
@@ -1529,11 +1530,16 @@ implementation
 
          { Make sure that the loop var and the
            from and to values are compatible types }
-         check_ranges(right.fileinfo,right,left.resultdef);
-         inserttypeconv(right,left.resultdef);
+         if not(m_iso in current_settings.modeswitches) then
+           rangedef:=left.resultdef
+         else
+           rangedef:=get_iso_range_type(left.resultdef);
 
-         check_ranges(t1.fileinfo,t1,left.resultdef);
-         inserttypeconv(t1,left.resultdef);
+         check_ranges(right.fileinfo,right,rangedef);
+         inserttypeconv(right,rangedef);
+
+         check_ranges(t1.fileinfo,t1,rangedef);
+         inserttypeconv(t1,rangedef);
 
          if assigned(t2) then
            typecheckpass(t2);
diff --git a/tests/webtbs/tw24318.pp b/tests/webtbs/tw24318.pp
new file mode 100644
index 0000000000..777fcd9375
--- /dev/null
+++ b/tests/webtbs/tw24318.pp
@@ -0,0 +1,24 @@
+{$MODE ISO}
+
+{$r+}
+
+program range ( output );
+
+const  ttlow = 0;   tthigh  =  800;
+
+type   ttx = ttlow .. tthigh;
+
+var    ttop : ttx;
+
+procedure p ( low : ttx );
+var  high : ttx;
+begin
+   for high := low to ttop - 1 do
+     halt(1);
+end;
+
+begin
+   writeln(sizeof(ttop));
+   ttop := 0;
+   p( 1 );
+end.