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

* casting of classes to interface fixed when the interface was

Browse Source 
implemented by a parent class
This commit is contained in:
florian 2002-08-12 20:39:17 +00:00
parent 8af1cb19ee
commit 4b659ab4b2
2 changed files with 41 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
compiler/defbase.pas
View File

@ -1328,6 +1328,7 @@ implementation
b : byte;
hd1,hd2 : tdef;
hct : tconverttype;
hd3 : tobjectdef;
begin
{ safety check }
if not(assigned(def_from) and assigned(def_to)) then
@ -1764,11 +1765,20 @@ implementation
{ classes can be assigned to interfaces }
else if is_interface(def_to) and
is_class(def_from) and
assigned(tobjectdef(def_from).implementedinterfaces) and
(tobjectdef(def_from).implementedinterfaces.searchintf(def_to)<>-1) then
assigned(tobjectdef(def_from).implementedinterfaces) then
begin
doconv:=tc_class_2_intf;
b:=1;
{ we've to search in parent classes as well }
hd3:=tobjectdef(def_from);
while assigned(hd3) do
begin
if hd3.implementedinterfaces.searchintf(def_to)<>-1 then
begin
doconv:=tc_class_2_intf;
b:=1;
break;
end;
hd3:=hd3.childof;
end;
end
{ Interface 2 GUID handling }
else if (def_to=tdef(rec_tguid)) and
@ -1893,7 +1903,11 @@ implementation
end.
{
$Log$
Revision 1.4 2002-08-12 14:17:56 florian
Revision 1.5 2002-08-12 20:39:17 florian
* casting of classes to interface fixed when the interface was
implemented by a parent class
Revision 1.4 2002/08/12 14:17:56 florian
* nil is now recognized as being compatible with a dynamic array
Revision 1.3 2002/08/05 18:27:48 carl

27
compiler/ncgcnv.pas
View File

@ -326,6 +326,7 @@ interface
var
l1 : tasmlabel;
hr : treference;
hd : tobjectdef;
begin
location_reset(location,LOC_REGISTER,OS_ADDR);
objectlibrary.getlabel(l1);
@ -352,6 +353,7 @@ interface
procedure tcgtypeconvnode.second_class_to_intf;
var
l1 : tasmlabel;
hd : tobjectdef;
begin
location_reset(location,LOC_REGISTER,OS_ADDR);
case left.location.loc of
@ -374,10 +376,21 @@ interface
end;
objectlibrary.getlabel(l1);
cg.a_cmp_const_reg_label(exprasmlist,OS_ADDR,OC_EQ,0,location.register,l1);
cg.a_op_const_reg(exprasmlist,OP_ADD,aword(
tobjectdef(left.resulttype.def).implementedinterfaces.ioffsets(
tobjectdef(left.resulttype.def).implementedinterfaces.searchintf(
resulttype.def))^),location.register);
hd:=tobjectdef(left.resulttype.def);
while assigned(hd) do
begin
if hd.implementedinterfaces.searchintf(resulttype.def)<>-1 then
begin
cg.a_op_const_reg(exprasmlist,OP_ADD,aword(
hd.implementedinterfaces.ioffsets(
hd.implementedinterfaces.searchintf(
resulttype.def))^),location.register);
break;
end;
hd:=hd.childof;
end;
if hd=nil then
internalerror(2002081301);
cg.a_label(exprasmlist,l1);
end;
@ -490,7 +503,11 @@ end.
{
$Log$
Revision 1.23 2002-08-11 14:32:26 peter
Revision 1.24 2002-08-12 20:39:17 florian
* casting of classes to interface fixed when the interface was
implemented by a parent class
Revision 1.23 2002/08/11 14:32:26 peter
* renamed current_library to objectlibrary
Revision 1.22 2002/08/11 13:24:11 peter