paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 08:27:02 +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; b : byte;
hd1,hd2 : tdef; hd1,hd2 : tdef;
hct : tconverttype; hct : tconverttype;
hd3 : tobjectdef;
begin begin
{ safety check } { safety check }
if not(assigned(def_from) and assigned(def_to)) then if not(assigned(def_from) and assigned(def_to)) then
@ -1764,11 +1765,20 @@ implementation
{ classes can be assigned to interfaces } { classes can be assigned to interfaces }
else if is_interface(def_to) and else if is_interface(def_to) and
is_class(def_from) and is_class(def_from) and
assigned(tobjectdef(def_from).implementedinterfaces) and assigned(tobjectdef(def_from).implementedinterfaces) then
(tobjectdef(def_from).implementedinterfaces.searchintf(def_to)<>-1) then
begin begin
doconv:=tc_class_2_intf; { we've to search in parent classes as well }
b:=1; 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 end
{ Interface 2 GUID handling } { Interface 2 GUID handling }
else if (def_to=tdef(rec_tguid)) and else if (def_to=tdef(rec_tguid)) and
@ -1893,7 +1903,11 @@ implementation
end. end.
{ {
$Log$ $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 * nil is now recognized as being compatible with a dynamic array
Revision 1.3 2002/08/05 18:27:48 carl Revision 1.3 2002/08/05 18:27:48 carl

27
compiler/ncgcnv.pas
View File

@ -326,6 +326,7 @@ interface
var var
l1 : tasmlabel; l1 : tasmlabel;
hr : treference; hr : treference;
hd : tobjectdef;
begin begin
location_reset(location,LOC_REGISTER,OS_ADDR); location_reset(location,LOC_REGISTER,OS_ADDR);
objectlibrary.getlabel(l1); objectlibrary.getlabel(l1);
@ -352,6 +353,7 @@ interface
procedure tcgtypeconvnode.second_class_to_intf; procedure tcgtypeconvnode.second_class_to_intf;
var var
l1 : tasmlabel; l1 : tasmlabel;
hd : tobjectdef;
begin begin
location_reset(location,LOC_REGISTER,OS_ADDR); location_reset(location,LOC_REGISTER,OS_ADDR);
case left.location.loc of case left.location.loc of
@ -374,10 +376,21 @@ interface
end; end;
objectlibrary.getlabel(l1); objectlibrary.getlabel(l1);
cg.a_cmp_const_reg_label(exprasmlist,OS_ADDR,OC_EQ,0,location.register,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( hd:=tobjectdef(left.resulttype.def);
tobjectdef(left.resulttype.def).implementedinterfaces.ioffsets( while assigned(hd) do
tobjectdef(left.resulttype.def).implementedinterfaces.searchintf( begin
resulttype.def))^),location.register); 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); cg.a_label(exprasmlist,l1);
end; end;
@ -490,7 +503,11 @@ end.
{ {
$Log$ $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 * renamed current_library to objectlibrary
Revision 1.22 2002/08/11 13:24:11 peter Revision 1.22 2002/08/11 13:24:11 peter