* 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 -
This commit is contained in:
Jonas Maebe 2018-01-07 18:51:53 +00:00
parent 8d3cf05b73
commit a2217cedd5
4 changed files with 67 additions and 4 deletions

1
.gitattributes vendored
View File

@ -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

View File

@ -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

View File

@ -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);

24
tests/webtbs/tw24318.pp Normal file
View File

@ -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.