From 4b659ab4b2f57e89873119e279c61d4d2b662bad Mon Sep 17 00:00:00 2001
From: florian <florian@freepascal.org>
Date: Mon, 12 Aug 2002 20:39:17 +0000
Subject: [PATCH]   * casting of classes to interface fixed when the interface
 was     implemented by a parent class

---
 compiler/defbase.pas | 24 +++++++++++++++++++-----
 compiler/ncgcnv.pas  | 27 ++++++++++++++++++++++-----
 2 files changed, 41 insertions(+), 10 deletions(-)

diff --git a/compiler/defbase.pas b/compiler/defbase.pas
index 631450e927..82b1009a65 100644
--- a/compiler/defbase.pas
+++ b/compiler/defbase.pas
@@ -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
diff --git a/compiler/ncgcnv.pas b/compiler/ncgcnv.pas
index 9a7b36f43e..3ed865f62a 100644
--- a/compiler/ncgcnv.pas
+++ b/compiler/ncgcnv.pas
@@ -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