sem_aux.adb, [...] (Get_Low_Bound): Use Type_Low_Bound.

2015-05-26  Yannick Moy  <moy@adacore.com>

	* 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

5 files changed, 174 insertions, 47 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index e1384ae..ee194fc 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,13 @@
+2015-05-26  Yannick Moy  <moy@adacore.com>
+
+	* 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  <duff@adacore.com>
 
 	* 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 94238de..fc83eb7 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 0120cc6..a3e5e65 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 8ffcdf7..4a74acf 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 99f7e45..0cc27b1 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