[Ada] Add Package_Body helper routine to be used in GNATprove
gcc/ada/ * sem_aux.adb, sem_aux.ads (Package_Body): Moved from GNATprove. * sem_elab.adb (Spec_And_Body_From_Entity): Refine type of parameter.
This commit is contained in:
parent
f4f6c18d9f
commit
920e43ee21
@ -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 --
|
||||
------------------
|
||||
|
@ -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.
|
||||
|
@ -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
|
||||
|
Loading…
x
Reference in New Issue
Block a user