diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb index bce7c387ae3..dcced7e40e6 100644 --- a/gcc/ada/sem_aux.adb +++ b/gcc/ada/sem_aux.adb @@ -1401,6 +1401,31 @@ package body Sem_Aux is and then Has_Discriminants (Typ)); end Object_Type_Has_Constrained_Partial_View; + ------------------ + -- Package_Body -- + ------------------ + + function Package_Body (E : Entity_Id) return Node_Id is + Body_Decl : Node_Id; + Body_Id : constant Opt_E_Package_Body_Id := + Corresponding_Body (Package_Spec (E)); + + begin + if Present (Body_Id) then + Body_Decl := Parent (Body_Id); + + if Nkind (Body_Decl) = N_Defining_Program_Unit_Name then + Body_Decl := Parent (Body_Decl); + end if; + + pragma Assert (Nkind (Body_Decl) = N_Package_Body); + + return Body_Decl; + else + return Empty; + end if; + end Package_Body; + ------------------ -- Package_Spec -- ------------------ diff --git a/gcc/ada/sem_aux.ads b/gcc/ada/sem_aux.ads index 810e2d8854b..3adaee416b2 100644 --- a/gcc/ada/sem_aux.ads +++ b/gcc/ada/sem_aux.ads @@ -377,6 +377,10 @@ package Sem_Aux is -- derived type, and the subtype is not an unconstrained array subtype -- (RM 3.3(23.10/3)). + function Package_Body (E : Entity_Id) return Node_Id; + -- Given an entity for a package, return the corresponding package body, if + -- any, or else Empty. + function Package_Spec (E : Entity_Id) return Node_Id; -- Given an entity for a package spec, return the corresponding package -- spec if any, or else Empty. diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index f6edcac2c02..7635ae180d2 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -2070,7 +2070,7 @@ package body Sem_Elab is -- Change the status of the elaboration phase of the compiler to Status procedure Spec_And_Body_From_Entity - (Id : Node_Id; + (Id : Entity_Id; Spec_Decl : out Node_Id; Body_Decl : out Node_Id); pragma Inline (Spec_And_Body_From_Entity); @@ -15835,7 +15835,7 @@ package body Sem_Elab is ------------------------------- procedure Spec_And_Body_From_Entity - (Id : Node_Id; + (Id : Entity_Id; Spec_Decl : out Node_Id; Body_Decl : out Node_Id) is