From ff1bedacc81800f47632971f6474e4e2f9cfb86f Mon Sep 17 00:00:00 2001 From: Yannick Moy Date: Tue, 26 May 2015 10:40:39 +0000 Subject: [PATCH] sem_aux.adb, [...] (Get_Low_Bound): Use Type_Low_Bound. 2015-05-26 Yannick Moy * sem_aux.adb, sem_aux.ads (Get_Low_Bound): Use Type_Low_Bound. (Package_Body, Package_Spec): New queries moved here from GNATprove. (Package_Specification): Simplify query to remove use of loop. * sem_util.adb, sem_util.ads (Enclosing_Declaration, Enclosing_Package_Or_Subprogram, Is_Attribute_Update): New queries moved here from GNATprove. From-SVN: r223681 --- gcc/ada/ChangeLog | 10 +++++ gcc/ada/sem_aux.adb | 79 ++++++++++++++++++++++++++++--------- gcc/ada/sem_aux.ads | 15 +++++-- gcc/ada/sem_util.adb | 93 +++++++++++++++++++++++++++++++++++--------- gcc/ada/sem_util.ads | 24 ++++++++---- 5 files changed, 174 insertions(+), 47 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e1384aeda78..ee194fcd79d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2015-05-26 Yannick Moy + + * sem_aux.adb, sem_aux.ads (Get_Low_Bound): Use Type_Low_Bound. + (Package_Body, Package_Spec): New queries moved + here from GNATprove. + (Package_Specification): Simplify query to remove use of loop. + * sem_util.adb, sem_util.ads (Enclosing_Declaration, + Enclosing_Package_Or_Subprogram, Is_Attribute_Update): New + queries moved here from GNATprove. + 2015-05-26 Bob Duff * einfo.adb, einfo.ads, sprint.adb, lib-xref.ads: Minor cleanup: Remove diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb index 94238de10fd..fc83eb78ba9 100644 --- a/gcc/ada/sem_aux.adb +++ b/gcc/ada/sem_aux.adb @@ -481,8 +481,7 @@ package body Sem_Aux is if Ekind (E) = E_String_Literal_Subtype then return String_Literal_Low_Bound (E); else - -- Why is this not Type_Low_Bound (E)??? - return Low_Bound (Scalar_Range (E)); + return Type_Low_Bound (E); end if; end Get_Low_Bound; @@ -964,9 +963,9 @@ package body Sem_Aux is end if; end Is_By_Reference_Type; - --------------------------- + ------------------------- -- Is_Definite_Subtype -- - --------------------------- + ------------------------- function Is_Definite_Subtype (T : Entity_Id) return Boolean is pragma Assert (Is_Type (T)); @@ -1440,22 +1439,60 @@ 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 + N : Node_Id; + + begin + if Ekind (E) = E_Package_Body then + N := Parent (E); + + if Nkind (N) = N_Defining_Program_Unit_Name then + N := Parent (N); + end if; + + else + N := Package_Spec (E); + + if Present (Corresponding_Body (N)) then + N := Parent (Corresponding_Body (N)); + + if Nkind (N) = N_Defining_Program_Unit_Name then + N := Parent (N); + end if; + else + N := Empty; + end if; + end if; + + return N; + end Package_Body; + + ------------------ + -- Package_Spec -- + ------------------ + + function Package_Spec (E : Entity_Id) return Node_Id is + begin + return Parent (Package_Specification (E)); + end Package_Spec; + --------------------------- -- Package_Specification -- --------------------------- - function Package_Specification (Pack_Id : Entity_Id) return Node_Id is + function Package_Specification (E : Entity_Id) return Node_Id is N : Node_Id; begin - N := Parent (Pack_Id); - while Nkind (N) /= N_Package_Specification loop - N := Parent (N); + N := Parent (E); - if No (N) then - raise Program_Error; - end if; - end loop; + if Nkind (N) = N_Defining_Program_Unit_Name then + N := Parent (N); + end if; return N; end Package_Specification; @@ -1489,13 +1526,19 @@ package body Sem_Aux is -- If this declaration is not a subprogram body, then it must be a -- subprogram declaration, from which we can retrieve the entity for - -- the corresponding subprogram body if any. + -- the corresponding subprogram body if any, or an abstract subprogram + -- declaration, for which we return Empty. - if Nkind (N) = N_Subprogram_Body then - return E; - else - return Corresponding_Body (N); - end if; + case Nkind (N) is + when N_Subprogram_Body => + return E; + + when N_Subprogram_Declaration => + return Corresponding_Body (N); + + when others => + return Empty; + end case; end Subprogram_Body_Entity; --------------------- diff --git a/gcc/ada/sem_aux.ads b/gcc/ada/sem_aux.ads index 0120cc67123..a3e5e656682 100644 --- a/gcc/ada/sem_aux.ads +++ b/gcc/ada/sem_aux.ads @@ -390,10 +390,17 @@ package Sem_Aux is -- derived type, and the subtype is not an unconstrained array subtype -- (RM 3.3(23.10/3)). - function Package_Specification (Pack_Id : Entity_Id) return Node_Id; - -- Given an entity for a package or generic package, return corresponding - -- package specification. Simplifies handling of child units, and better - -- than the old idiom: Specification (Unit_Declaration_Node (Pack_Id)). + function Package_Body (E : Entity_Id) return Node_Id; + -- Given an entity for a package (spec or body), 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. + + function Package_Specification (E : Entity_Id) return Node_Id; + -- Given an entity for a package, return the corresponding package + -- specification. function Subprogram_Body (E : Entity_Id) return Node_Id; -- Given an entity for a subprogram (spec or body), return the diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 8ffcdf72915..4a74acf7f7e 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -5674,24 +5674,6 @@ package body Sem_Util is end if; end Enclosing_Comp_Unit_Node; - ----------------------------- - -- Enclosing_Lib_Unit_Node -- - ----------------------------- - - function Enclosing_Lib_Unit_Node (N : Node_Id) return Node_Id is - Encl_Unit : Node_Id; - - begin - Encl_Unit := Enclosing_Comp_Unit_Node (N); - while Present (Encl_Unit) - and then Nkind (Unit (Encl_Unit)) = N_Subunit - loop - Encl_Unit := Library_Unit (Encl_Unit); - end loop; - - return Encl_Unit; - end Enclosing_Lib_Unit_Node; - -------------------------- -- Enclosing_CPP_Parent -- -------------------------- @@ -5714,6 +5696,25 @@ package body Sem_Util is return Parent_Typ; end Enclosing_CPP_Parent; + --------------------------- + -- Enclosing_Declaration -- + --------------------------- + + function Enclosing_Declaration (N : Node_Id) return Node_Id is + Decl : Node_Id := N; + + begin + while Present (Decl) + and then not (Nkind (Decl) in N_Declaration + or else + Nkind (Decl) in N_Later_Decl_Item) + loop + Decl := Parent (Decl); + end loop; + + return Decl; + end Enclosing_Declaration; + ---------------------------- -- Enclosing_Generic_Body -- ---------------------------- @@ -5815,6 +5816,24 @@ package body Sem_Util is return Unit_Entity; end Enclosing_Lib_Unit_Entity; + ----------------------------- + -- Enclosing_Lib_Unit_Node -- + ----------------------------- + + function Enclosing_Lib_Unit_Node (N : Node_Id) return Node_Id is + Encl_Unit : Node_Id; + + begin + Encl_Unit := Enclosing_Comp_Unit_Node (N); + while Present (Encl_Unit) + and then Nkind (Unit (Encl_Unit)) = N_Subunit + loop + Encl_Unit := Library_Unit (Encl_Unit); + end loop; + + return Encl_Unit; + end Enclosing_Lib_Unit_Node; + ----------------------- -- Enclosing_Package -- ----------------------- @@ -5839,6 +5858,34 @@ package body Sem_Util is end if; end Enclosing_Package; + ------------------------------------- + -- Enclosing_Package_Or_Subprogram -- + ------------------------------------- + + function Enclosing_Package_Or_Subprogram (E : Entity_Id) return Entity_Id is + S : Entity_Id; + + begin + S := Scope (E); + while Present (S) loop + if Is_Package_Or_Generic_Package (S) + or else Ekind (S) = E_Package_Body + then + return S; + + elsif Is_Subprogram_Or_Generic_Subprogram (S) + or else Ekind (S) = E_Subprogram_Body + then + return S; + + else + S := Scope (S); + end if; + end loop; + + return Empty; + end Enclosing_Package_Or_Subprogram; + -------------------------- -- Enclosing_Subprogram -- -------------------------- @@ -10484,6 +10531,16 @@ package body Sem_Util is and then Attribute_Name (N) = Name_Result; end Is_Attribute_Result; + ------------------------- + -- Is_Attribute_Update -- + ------------------------- + + function Is_Attribute_Update (N : Node_Id) return Boolean is + begin + return Nkind (N) = N_Attribute_Reference + and then Attribute_Name (N) = Name_Update; + end Is_Attribute_Update; + ------------------------------------ -- Is_Body_Or_Package_Declaration -- ------------------------------------ diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 99f7e45d8f3..0cc27b130af 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -532,16 +532,12 @@ package Sem_Util is -- Returns the enclosing N_Compilation_Unit node that is the root of a -- subtree containing N. - function Enclosing_Lib_Unit_Node (N : Node_Id) return Node_Id; - -- Returns the N_Compilation_Unit node of the library unit that is directly - -- or indirectly (through a subunit) at the root of a subtree containing - -- N. This may be either the same as Enclosing_Comp_Unit_Node, or if - -- Enclosing_Comp_Unit_Node returns a subunit, then the corresponding - -- library unit. If no such item is found, returns Empty??? - function Enclosing_CPP_Parent (Typ : Entity_Id) return Entity_Id; -- Returns the closest ancestor of Typ that is a CPP type. + function Enclosing_Declaration (N : Node_Id) return Node_Id; + -- Returns the declaration node enclosing N, if any, or Empty otherwise + function Enclosing_Generic_Body (N : Node_Id) return Node_Id; -- Returns the Node_Id associated with the innermost enclosing generic @@ -559,10 +555,21 @@ package Sem_Util is -- caller is responsible for ensuring this condition) or other specified -- entity. + function Enclosing_Lib_Unit_Node (N : Node_Id) return Node_Id; + -- Returns the N_Compilation_Unit node of the library unit that is directly + -- or indirectly (through a subunit) at the root of a subtree containing + -- N. This may be either the same as Enclosing_Comp_Unit_Node, or if + -- Enclosing_Comp_Unit_Node returns a subunit, then the corresponding + -- library unit. If no such item is found, returns Empty. + function Enclosing_Package (E : Entity_Id) return Entity_Id; -- Utility function to return the Ada entity of the package enclosing -- the entity E, if any. Returns Empty if no enclosing package. + function Enclosing_Package_Or_Subprogram (E : Entity_Id) return Entity_Id; + -- Returns the entity of the package or subprogram enclosing E, if any. + -- Returns Empty if no enclosing package or subprogram. + function Enclosing_Subprogram (E : Entity_Id) return Entity_Id; -- Utility function to return the Ada entity of the subprogram enclosing -- the entity E, if any. Returns Empty if no enclosing subprogram. @@ -1190,6 +1197,9 @@ package Sem_Util is function Is_Attribute_Result (N : Node_Id) return Boolean; -- Determine whether node N denotes attribute 'Result + function Is_Attribute_Update (N : Node_Id) return Boolean; + -- Determine whether node N denotes attribute 'Update + function Is_Body_Or_Package_Declaration (N : Node_Id) return Boolean; -- Determine whether node N denotes a body or a package declaration -- 2.30.2