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

* mark values typecasted to regular array types and indexed as non-regable,

Browse Source 
so that they aren't forced into a temporary location when passed to a
    var parameter later on (mantis #17283)

git-svn-id: trunk@15918 -
This commit is contained in:
Jonas Maebe 2010-08-29 17:19:58 +00:00
parent 1a7cbeeb88
commit 80086184d3
3 changed files with 99 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -10638,6 +10638,7 @@ tests/webtbs/tw17213.pp svneol=native#text/pascal
tests/webtbs/tw17220.pp svneol=native#text/plain
tests/webtbs/tw17220a.pp svneol=native#text/plain
tests/webtbs/tw17236.pp svneol=native#text/pascal
tests/webtbs/tw17283.pp svneol=native#text/plain
tests/webtbs/tw1735.pp svneol=native#text/plain
tests/webtbs/tw1737.pp svneol=native#text/plain
tests/webtbs/tw1744.pp svneol=native#text/plain

19
compiler/htypechk.pas
View File

@ -717,15 +717,22 @@ implementation
end;
vecn:
begin
{ arrays are currently never regable and pointers indexed like }
{ arrays do not have be made unregable, but we do need to }
{ propagate the ra_addr_taken info }
update_regable:=false;
p:=tvecnode(p).left;
{ if there's an implicit dereference, we can stop (just like
when there is an actual derefn) }
if ((tvecnode(p).left.resultdef.typ=arraydef) and
not is_special_array(tvecnode(p).left.resultdef)) or
((tvecnode(p).left.resultdef.typ=stringdef) and
(tstringdef(tvecnode(p).left.resultdef).stringtype in [st_shortstring,st_longstring])) then
p:=tvecnode(p).left
else
break;
end;
typeconvn :
begin
if (ttypeconvnode(p).resultdef.typ = recorddef) then
{ implicit dereference -> stop }
if (ttypeconvnode(p).convtype=tc_pointer_2_array) then
break;
if (ttypeconvnode(p).resultdef.typ=recorddef) then
records_only:=false;
p:=ttypeconvnode(p).left;
end;

85
tests/webtbs/tw17283.pp Normal file
View File

@ -0,0 +1,85 @@
{$mode objfpc}
program test;
type
tr_32=packed record
case integer of
1: (words: array [0..1] of word);
2: (low,high: word);
end;
procedure f_ref(var l,h:word);
begin
l:=1;
h:=2;
end;
function f_test1:longint;
begin
result:=$12345678;
f_ref(tr_32(result).words[0],tr_32(result).words[1]);
end;
function f_test2:longint;
begin
result:=$12345678;
f_ref(tr_32(result).low,tr_32(result).high);
end;
function f_test3:longint;
var
q: longint;
begin
q:=$12345678;
f_ref(tr_32(q).words[0],tr_32(q).words[1]);
result:=q;
end;
function f_test4:longint;
var
q: longint;
begin
q:=$12345678;
tr_32(q).words[0]:=1;
tr_32(q).words[1]:=2;
result:=q;
end;
var
l,q: longint;
begin
l:=f_test1;
if (tr_32(l).low<>1) or
(tr_32(l).high<>2) then
halt(1);
l:=f_test2;
if (tr_32(l).low<>1) or
(tr_32(l).high<>2) then
halt(2);
q:=$12345678;
f_ref(tr_32(q).words[0],tr_32(q).words[1]);
if (tr_32(q).low<>1) or
(tr_32(q).high<>2) then
halt(3);
q:=$12345678;
f_ref(tr_32(q).low,tr_32(q).high);
if (tr_32(q).low<>1) or
(tr_32(q).high<>2) then
halt(4);
l:=f_test3;
if (tr_32(l).low<>1) or
(tr_32(l).high<>2) then
halt(5);
l:=f_test3;
if (tr_32(l).low<>1) or
(tr_32(l).high<>2) then
halt(6);
end.