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

Fix for Mantis #22154:

Browse Source 
* ptype.pas, read_named_type, array_dec: 
  allow border checks if both range elements are orddefs; for normal arrays
  using e.g. "0..15" this will allow to declare the correct amount of
  elements in the initialization while for generic arrays (e.g. "0..SizeOf(T)") 
  this will mean that only one element can be declared, which was already the 
  case before this change (maybe in such cases a constant initialization should 
  be forbidden in the future...)
+ added test

git-svn-id: trunk@21690 -
This commit is contained in:
svenbarth 2012-06-24 10:43:28 +00:00
parent cc65ac20c5
commit f9211271d5
3 changed files with 50 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -12659,6 +12659,7 @@ tests/webtbs/tw2198.pp svneol=native#text/plain
tests/webtbs/tw2210.pp svneol=native#text/plain
tests/webtbs/tw22133.pp svneol=native#text/plain
tests/webtbs/tw2214.pp svneol=native#text/plain
tests/webtbs/tw22154.pp svneol=native#text/pascal
tests/webtbs/tw2220.pp svneol=native#text/plain
tests/webtbs/tw2226.pp svneol=native#text/plain
tests/webtbs/tw2229.pp svneol=native#text/plain

62
compiler/ptype.pas
View File

@ -1163,40 +1163,40 @@ implementation
begin
if pt.nodetype=rangen then
begin
{ check the expression only if we are not in a generic declaration }
if not(parse_generic) then
{ pure ordconstn expressions can be checked for
generics as well, but don't give an error in case
of parsing a generic if that isn't yet the case }
if (trangenode(pt).left.nodetype=ordconstn) and
(trangenode(pt).right.nodetype=ordconstn) then
begin
if (trangenode(pt).left.nodetype=ordconstn) and
(trangenode(pt).right.nodetype=ordconstn) then
{ 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
{ 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
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
Message(type_e_cant_eval_constant_expr);
end;
indexdef:=trangenode(pt).left.resultdef;
end
else
if not parse_generic then
Message(type_e_cant_eval_constant_expr);
end
else
Message(sym_e_error_in_type_def)

18
tests/webtbs/tw22154.pp Normal file
View File

@ -0,0 +1,18 @@
program tw22154;
{$MODE DELPHI}
type
TWrapper<T> = class
procedure Z;
end;
procedure TWrapper<T>.Z;
const
A0: array [0..0] of Integer = (0); { OK }
A1: array [0..1] of Integer = (0, 1); { Comma not exepcted }
begin
end;
begin
end.