paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-16 04:59:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

* don't check array ranges for being constant in generic declarations, resolves #20028

Browse Source 
git-svn-id: trunk@19500 -
This commit is contained in:
florian 2011-10-15 21:28:19 +00:00
parent 2887065c9d
commit 80b5100bf6
3 changed files with 57 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -11895,6 +11895,7 @@ tests/webtbs/tw20003.pp svneol=native#text/pascal
tests/webtbs/tw20005.pp svneol=native#text/pascal
tests/webtbs/tw2001.pp svneol=native#text/plain
tests/webtbs/tw2002.pp svneol=native#text/plain
tests/webtbs/tw20028.pp svneol=native#text/pascal
tests/webtbs/tw20035a.pp svneol=native#text/pascal
tests/webtbs/tw20035b.pp svneol=native#text/pascal
tests/webtbs/tw20035c.pp svneol=native#text/pascal

60
compiler/ptype.pas
View File

@ -1241,38 +1241,42 @@ implementation
setdefdecl(pt.resultdef)
else
begin
if (pt.nodetype=rangen) then
if pt.nodetype=rangen then
begin
if (trangenode(pt).left.nodetype=ordconstn) and
(trangenode(pt).right.nodetype=ordconstn) then
{ check the expression only if we are not in a generic declaration }
if not(parse_generic) then
begin
{ make both the same type or give an error. This is not
done when both are integer values, because typecasting
between -3200..3200 will result in a signed-unsigned
conflict and give a range check error (PFV) }
if not(is_integer(trangenode(pt).left.resultdef) and is_integer(trangenode(pt).left.resultdef)) then
inserttypeconv(trangenode(pt).left,trangenode(pt).right.resultdef);
lowval:=tordconstnode(trangenode(pt).left).value;
highval:=tordconstnode(trangenode(pt).right).value;
if highval<lowval then
begin
Message(parser_e_array_lower_less_than_upper_bound);
highval:=lowval;
end
else if (lowval<int64(low(asizeint))) or
(highval>high(asizeint)) then
if (trangenode(pt).left.nodetype=ordconstn) and
(trangenode(pt).right.nodetype=ordconstn) then
begin
Message(parser_e_array_range_out_of_bounds);
lowval :=0;
highval:=0;
end;
if is_integer(trangenode(pt).left.resultdef) then
range_to_type(lowval,highval,indexdef)
{ make both the same type or give an error. This is not
done when both are integer values, because typecasting
between -3200..3200 will result in a signed-unsigned
conflict and give a range check error (PFV) }
if not(is_integer(trangenode(pt).left.resultdef) and is_integer(trangenode(pt).left.resultdef)) then
inserttypeconv(trangenode(pt).left,trangenode(pt).right.resultdef);
lowval:=tordconstnode(trangenode(pt).left).value;
highval:=tordconstnode(trangenode(pt).right).value;
if highval<lowval then
begin
Message(parser_e_array_lower_less_than_upper_bound);
highval:=lowval;
end
else if (lowval<int64(low(asizeint))) or
(highval>high(asizeint)) then
begin
Message(parser_e_array_range_out_of_bounds);
lowval :=0;
highval:=0;
end;
if is_integer(trangenode(pt).left.resultdef) then
range_to_type(lowval,highval,indexdef)
else
indexdef:=trangenode(pt).left.resultdef;
end
else
indexdef:=trangenode(pt).left.resultdef;
end
else
Message(type_e_cant_eval_constant_expr);
Message(type_e_cant_eval_constant_expr);
end;
end
else
Message(sym_e_error_in_type_def)

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

@ -0,0 +1,24 @@
program project1;
{$mode objfpc}{$H+}
type
TConstHolder = class
public
const
C = 10;
end;
TSimple = class
Arr: array [0..TConstHolder.C] of Integer; //this works
end;
generic TGeneric <T> = class
Arr: array [0..T.C] of Integer; //but here is error
// Can't evaluate constant expression
end;
begin
end.