Changeset 2550

Timestamp:

11/19/07 23:20:47 (1 year ago)

Author:

maxr

Message:

Inherit subprograms from types in interface_list

Files:

• branches/ada-2005/tendra/src/producers/ada/asis/asis-gela-inheritance.adb (modified) (3 diffs)

branches/ada-2005/tendra/src/producers/ada/asis/asis-gela-inheritance.adb

@@ -29 +29 @@
-      Tipe   : Classes.Type_Info;
-      Parent : Classes.Type_Info);
+
+   function Get_Parents (Decl  : Asis.Declaration) return Asis.Name_List;
-
-   type Cloner is new Asis.Cloner with record
@@ -165 +167 @@
-      return Nil_Element_List;
-   end Get_Declarative_Items;
+
+   -----------------
+   -- Get_Parents --
+   -----------------
+
+   function Get_Parents (Decl  : Asis.Declaration) return Asis.Name_List is
+   begin
+      case Asis.Elements.Declaration_Kind (Decl) is
+         when An_Ordinary_Type_Declaration =>
+            declare
+               Def  : constant Asis.Definition :=
+                 Asis.Declarations.Type_Declaration_View (Decl);
+            begin
+               case Asis.Elements.Type_Kind (Def) is
+                  when A_Derived_Type_Definition =>
+                     declare
+                        use Asis.Definitions;
+                        Ind  : constant Asis.Subtype_Indication :=
+                          Parent_Subtype_Indication (Def);
+                        Mark : constant  Asis.Expression :=
+                          Asis.Definitions.Subtype_Mark (Ind);
+                     begin
+                        return (1 => Mark);
+                     end;
+
+                  when A_Derived_Record_Extension_Definition =>
+                     declare
+                        use Asis.Definitions;
+                        Ind  : constant Asis.Subtype_Indication :=
+                          Parent_Subtype_Indication (Def);
+                        Mark : constant  Asis.Expression :=
+                          Asis.Definitions.Subtype_Mark (Ind);
+                     begin
+                        return Mark & Progenitor_List (Def);
+                     end;
+                  when An_Interface_Type_Definition =>
+                     return Asis.Definitions.Progenitor_List (Def);
+                  when others =>
+                     null;
+               end case;
+            end;
+         when A_Task_Type_Declaration | A_Protected_Type_Declaration =>
+            return Asis.Declarations.Progenitor_List (Decl);
+         when A_Private_Extension_Declaration =>
+            declare
+               Def  : constant Asis.Definition :=
+                 Asis.Declarations.Type_Declaration_View (Decl);
+               Ind  : constant Asis.Subtype_Indication :=
+                 Asis.Definitions.Ancestor_Subtype_Indication (Def);
+               Mark : constant  Asis.Expression :=
+                 Asis.Definitions.Subtype_Mark (Ind);
+            begin
+               return Mark & Asis.Declarations.Progenitor_List (Decl);
+            end;
+         -- when A_Formal_Type_Definition =>
+         when others =>
+            null;
+      end case;
+
+      return Asis.Nil_Element_List;
+   end Get_Parents;
-
-   ---------------------------
@@ -260 +323 @@
-   is
-      Tipe   : Classes.Type_Info := Classes.Type_From_Declaration (Decl, Decl);
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-   end Make_Inherited_Subprograms;
-