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

* fixed array constructor passing with type conversions

Browse Source
This commit is contained in:
peter 2001-07-30 20:52:25 +00:00
parent 53f0b4cc30
commit 27c78aa247
2 changed files with 43 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
compiler/ncal.pas
View File

@ -181,6 +181,7 @@ implementation
procedure tcallparanode.insert_typeconv(defcoll : tparaitem;do_count : boolean);
var
oldtype : ttype;
old_array_constructor : boolean;
{$ifdef extdebug}
store_count_ref : boolean;
{$endif def extdebug}
@ -249,7 +250,9 @@ implementation
else
begin
include(left.flags,nf_novariaallowed);
tarrayconstructornode(left).constructortype:=tarraydef(defcoll.paratype.def).elementtype;
{ now that the resultting type is know we can insert the required
typeconvs for the array constructor }
tarrayconstructornode(left).force_type(tarraydef(defcoll.paratype.def).elementtype);
end;
end;
@ -1485,8 +1488,16 @@ implementation
end
else if (resulttype.def.deftype=floatdef) then
begin
location.loc:=LOC_FPU;
location.loc:=LOC_FPU;
{$ifdef m68k}
if (cs_fp_emulation in aktmoduleswitches) or
(tfloatdef(resulttype.def).typ=s32real) then
registers32:=1
else
registersfpu:=1;
{$else not m68k}
registersfpu:=1;
{$endif not m68k}
end
else
location.loc:=LOC_MEM;
@ -1655,7 +1666,10 @@ begin
end.
{
$Log$
Revision 1.37 2001-07-09 21:15:40 peter
Revision 1.38 2001-07-30 20:52:25 peter
* fixed array constructor passing with type conversions
Revision 1.37 2001/07/09 21:15:40 peter
* Length made internal
* Add array support for Length

33
compiler/nld.pas
View File

@ -70,12 +70,12 @@ interface
end;
tarrayconstructornode = class(tbinarynode)
constructortype : ttype;
constructor create(l,r : tnode);virtual;
function getcopy : tnode;override;
function pass_1 : tnode;override;
function det_resulttype:tnode;override;
function docompare(p: tnode): boolean; override;
procedure force_type(tt:ttype);
end;
ttypenode = class(tnode)
@ -553,7 +553,6 @@ implementation
constructor tarrayconstructornode.create(l,r : tnode);
begin
inherited create(arrayconstructorn,l,r);
constructortype.reset;
end;
@ -562,7 +561,6 @@ implementation
n : tarrayconstructornode;
begin
n:=tarrayconstructornode(inherited getcopy);
n.constructortype:=constructortype;
result:=n;
end;
@ -587,7 +585,7 @@ implementation
end;
{ only pass left tree, right tree contains next construct if any }
htype:=constructortype;
htype.reset;
len:=0;
varia:=false;
if assigned(left) then
@ -620,6 +618,25 @@ implementation
end;
procedure tarrayconstructornode.force_type(tt:ttype);
var
hp : tarrayconstructornode;
begin
tarraydef(resulttype.def).elementtype:=tt;
tarraydef(resulttype.def).IsConstructor:=true;
tarraydef(resulttype.def).IsVariant:=false;
if assigned(left) then
begin
hp:=self;
while assigned(hp) do
begin
inserttypeconv(hp.left,tt);
hp:=tarrayconstructornode(hp.right);
end;
end;
end;
function tarrayconstructornode.pass_1 : tnode;
var
thp,
@ -715,8 +732,7 @@ implementation
function tarrayconstructornode.docompare(p: tnode): boolean;
begin
docompare :=
inherited docompare(p) and
(constructortype.def = tarrayconstructornode(p).constructortype.def);
inherited docompare(p);
end;
@ -767,7 +783,10 @@ begin
end.
{
$Log$
Revision 1.19 2001-06-04 18:07:47 peter
Revision 1.20 2001-07-30 20:52:25 peter
* fixed array constructor passing with type conversions
Revision 1.19 2001/06/04 18:07:47 peter
* remove unused typenode for procvar load. Don't know what happened why
this code was not there already with revision 1.17.