paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-03 21:09:36 +01:00
Code Issues Packages Projects Releases Wiki Activity

* fix array constructors that start with nil

Browse Source 
git-svn-id: trunk@6673 -
This commit is contained in:
peter 2007-02-27 17:03:31 +00:00
parent bf652ab1d2
commit 9676482f8e
3 changed files with 35 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -8049,6 +8049,7 @@ tests/webtbs/tw8264.pp svneol=native#text/plain
tests/webtbs/tw8304.pp svneol=native#text/plain
tests/webtbs/tw8312.pp svneol=native#text/plain
tests/webtbs/tw8321.pp svneol=native#text/plain
tests/webtbs/tw8371.pp svneol=native#text/plain
tests/webtbs/tw8391.pp svneol=native#text/plain
tests/webtbs/ub1873.pp svneol=native#text/plain
tests/webtbs/ub1883.pp svneol=native#text/plain

24
compiler/nld.pas
View File

@ -907,6 +907,8 @@ implementation
hp : tarrayconstructornode;
len : longint;
varia : boolean;
eq : tequaltype;
hnodetype : tnodetype;
begin
result:=nil;
@ -924,6 +926,7 @@ implementation
{ only pass left tree, right tree contains next construct if any }
hdef:=nil;
hnodetype:=errorn;
len:=0;
varia:=false;
if assigned(left) then
@ -934,10 +937,27 @@ implementation
typecheckpass(hp.left);
set_varstate(hp.left,vs_read,[vsf_must_be_valid]);
if (hdef=nil) then
hdef:=hp.left.resultdef
begin
hdef:=hp.left.resultdef;
hnodetype:=hp.left.nodetype;
end
else
begin
if (not varia) and (not equal_defs(hdef,hp.left.resultdef)) then
{ If we got a niln we don't know the type yet and need to take the
type of the next array element.
This is to handle things like [nil,tclass,tclass], see also tw8371 (PFV) }
if hnodetype=niln then
begin
eq:=compare_defs(hp.left.resultdef,hdef,hnodetype);
if eq>te_incompatible then
begin
hdef:=hp.left.resultdef;
hnodetype:=hp.left.nodetype;
end;
end
else
eq:=compare_defs(hdef,hp.left.resultdef,hp.left.nodetype);
if (not varia) and (eq<te_equal) then
begin
{ If both are integers we need to take the type that can hold both
defs }

12
tests/webtbs/tw8371.pp Normal file
View File

@ -0,0 +1,12 @@
uses
classes;
procedure testparam(aarray: array of tclass);
begin
end;
begin
testparam([nil, tlist, tstringlist]);
end.