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

* fixed calculation of high parameter for arrays with non-integer bounds

Browse Source 
(mantis #32645)

git-svn-id: trunk@37928 -
This commit is contained in:
Jonas Maebe 2018-01-07 13:01:14 +00:00
parent ae087b92d7
commit 53bef8d202
4 changed files with 39 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -15930,6 +15930,8 @@ tests/webtbs/tw3257.pp svneol=native#text/plain
tests/webtbs/tw3259.pp svneol=native#text/plain
tests/webtbs/tw3261.pp svneol=native#text/plain
tests/webtbs/tw3263.pp svneol=native#text/plain
tests/webtbs/tw32645.pp -text svneol=native#text/plain
tests/webtbs/tw32645a.pp -text svneol=native#text/plain
tests/webtbs/tw3265.pp svneol=native#text/plain
tests/webtbs/tw3272.pp svneol=native#text/plain
tests/webtbs/tw3272b.pp svneol=native#text/pascal

10
compiler/ncal.pas
View File

@ -2104,7 +2104,7 @@ implementation
begin
{Array slice using slice builtin function.}
l:=Tcallparanode(right).left;
hightree:=caddnode.create(subn,l,genintconstnode(1));
hightree:=caddnode.create(subn,geninlinenode(in_ord_x,false,l),genintconstnode(1));
Tcallparanode(right).left:=nil;
{Remove the inline node.}
@ -2120,8 +2120,8 @@ implementation
{Array slice using .. operator.}
with Trangenode(Tvecnode(p).right) do
begin
l:=left; {Get lower bound.}
r:=right; {Get upper bound.}
l:=geninlinenode(in_ord_x,false,left); {Get lower bound.}
r:=geninlinenode(in_ord_x,false,right); {Get upper bound.}
end;
{In the procedure the array range is 0..(upper_bound-lower_bound).}
hightree:=caddnode.create(subn,r,l);
@ -2149,10 +2149,10 @@ implementation
else
begin
maybe_load_in_temp(p);
hightree:=geninlinenode(in_high_x,false,p.getcopy);
hightree:=geninlinenode(in_ord_x,false,geninlinenode(in_high_x,false,p.getcopy));
typecheckpass(hightree);
{ only substract low(array) if it's <> 0 }
temp:=geninlinenode(in_low_x,false,p.getcopy);
temp:=geninlinenode(in_ord_x,false,geninlinenode(in_low_x,false,p.getcopy));
typecheckpass(temp);
if (temp.nodetype <> ordconstn) or
(tordconstnode(temp).value <> 0) then

16
tests/webtbs/tw32645.pp Normal file
View File

@ -0,0 +1,16 @@
{$mode objfpc}
var myarray : array ['a'..'z'] of integer; //operator is not overloaded 'char' - 'char'
//var myarray : array ['a'..'zz'] of integer; //signal 291
//var myarray : array ['a'..'z'*5] of integer; //signal 291
procedure myproc (myarray: array of integer);
begin
if high(myarray)<>25 then
halt(1);
end;
begin
myproc(myarray);
end.

16
tests/webtbs/tw32645a.pp Normal file
View File

@ -0,0 +1,16 @@
{ %fail }
{$mode objfpc}
var myarray : array ['a'..'zz'] of integer; //signal 291
procedure myproc (myarray: array of integer);
begin
if high(myarray)<>25 then
halt(1);
end;
begin
myproc(myarray);
end.