public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r13-490] [Ada] Revise Storage_Model_Support operations to do checks and take objects and types
@ 2022-05-16  8:44 Pierre-Marie de Rodat
  0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2022-05-16  8:44 UTC (permalink / raw)
  To: gcc-cvs

https://gcc.gnu.org/g:21f8b410511d1ee9a46b7a902a368762f6256ea0

commit r13-490-g21f8b410511d1ee9a46b7a902a368762f6256ea0
Author: Gary Dismukes <dismukes@adacore.com>
Date:   Tue Mar 8 18:21:48 2022 -0500

    [Ada] Revise Storage_Model_Support operations to do checks and take objects and types
    
    The functions in subpackage Storage_Model_Support (apart from the
    Has_*_Aspect functions) are revised to have assertions that will fail
    when passed a parameter that doesn't specify the appropriate aspect
    (either aspect Storage_Model_Type or Designated_Storage_Model), instead
    of returning Empty for bad arguments. Also, various of the functions now
    allow either a type with aspect Storage_Model_Type or an object of such
    a type.
    
    gcc/ada/
    
            * sem_util.ads (Storage_Model_Support): Revise comments on most
            operations within this nested package to reflect that they can
            now be passed either a type that has aspect Storage_Model_Type
            or an object of such a type.  Change the names of the relevant
            formals to SM_Obj_Or_Type. Also, add more precise semantic
            descriptions in some cases, and declare the subprograms in a
            more logical order.
            * sem_util.adb (Storage_Model_Support.Storage_Model_Object): Add
            an assertion that the type must specify aspect
            Designated_Storage_Model, rather than returning Empty when it
            doesn't specify that aspect.
            (Storage_Model_Support.Storage_Model_Type): Add an assertion
            that formal must be an object whose type specifies aspect
            Storage_Model_Type, rather than returning Empty for when it
            doesn't have such a type (and test Has_Storage_Model_Type_Aspect
            rather than Find_Value_Of_Aspect).
            (Storage_Model_Support.Get_Storage_Model_Type_Entity): Allow
            both objects and types, and add an assertion that the type (or
            the type of the object) has a value for aspect
            Storage_Model_Type.

Diff:
---
 gcc/ada/sem_util.adb | 151 ++++++++++++++++++++++++++++-----------------------
 gcc/ada/sem_util.ads | 112 +++++++++++++++++++++-----------------
 2 files changed, 143 insertions(+), 120 deletions(-)

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 225d76105f5..a059d1eb933 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -32302,47 +32302,6 @@ package body Sem_Util is
 
    package body Storage_Model_Support is
 
-      -----------------------------------
-      -- Get_Storage_Model_Type_Entity --
-      -----------------------------------
-
-      function Get_Storage_Model_Type_Entity
-        (Typ : Entity_Id;
-         Nam : Name_Id) return Entity_Id
-      is
-         pragma Assert
-           (Is_Type (Typ)
-            and then
-              Nam in Name_Address_Type
-                   | Name_Null_Address
-                   | Name_Allocate
-                   | Name_Deallocate
-                   | Name_Copy_From
-                   | Name_Copy_To
-                   | Name_Storage_Size);
-
-         SMT_Aspect_Value : constant Node_Id :=
-           Find_Value_Of_Aspect (Typ, Aspect_Storage_Model_Type);
-         Assoc            : Node_Id;
-
-      begin
-         if No (SMT_Aspect_Value) then
-            return Empty;
-
-         else
-            Assoc := First (Component_Associations (SMT_Aspect_Value));
-            while Present (Assoc) loop
-               if Chars (First (Choices (Assoc))) = Nam then
-                  return Entity (Expression (Assoc));
-               end if;
-
-               Next (Assoc);
-            end loop;
-
-            return Empty;
-         end if;
-      end Get_Storage_Model_Type_Entity;
-
       -----------------------------------------
       -- Has_Designated_Storage_Model_Aspect --
       -----------------------------------------
@@ -32370,13 +32329,11 @@ package body Sem_Util is
 
       function Storage_Model_Object (Typ : Entity_Id) return Entity_Id is
       begin
-         if Has_Designated_Storage_Model_Aspect (Typ) then
-            return
-              Entity
-                (Find_Value_Of_Aspect (Typ, Aspect_Designated_Storage_Model));
-         else
-            return Empty;
-         end if;
+         pragma Assert (Has_Designated_Storage_Model_Aspect (Typ));
+
+         return
+           Entity
+             (Find_Value_Of_Aspect (Typ, Aspect_Designated_Storage_Model));
       end Storage_Model_Object;
 
       ------------------------
@@ -32385,76 +32342,132 @@ package body Sem_Util is
 
       function Storage_Model_Type (Obj : Entity_Id) return Entity_Id is
       begin
-         if Present
-              (Find_Value_Of_Aspect (Etype (Obj), Aspect_Storage_Model_Type))
-         then
-            return Etype (Obj);
-         else
-            return Empty;
-         end if;
+         pragma Assert (Has_Storage_Model_Type_Aspect (Etype (Obj)));
+
+         return Etype (Obj);
       end Storage_Model_Type;
 
+      -----------------------------------
+      -- Get_Storage_Model_Type_Entity --
+      -----------------------------------
+
+      function Get_Storage_Model_Type_Entity
+        (SM_Obj_Or_Type : Entity_Id;
+         Nam            : Name_Id) return Entity_Id
+      is
+         Typ : constant Entity_Id := (if Is_Object (SM_Obj_Or_Type) then
+                                         Storage_Model_Type (SM_Obj_Or_Type)
+                                      else
+                                         SM_Obj_Or_Type);
+         pragma Assert
+           (Is_Type (Typ)
+             and then
+               Nam in Name_Address_Type
+                    | Name_Null_Address
+                    | Name_Allocate
+                    | Name_Deallocate
+                    | Name_Copy_From
+                    | Name_Copy_To
+                    | Name_Storage_Size);
+
+         Assoc            : Node_Id;
+         SMT_Aspect_Value : constant Node_Id :=
+           Find_Value_Of_Aspect (Typ, Aspect_Storage_Model_Type);
+
+      begin
+         pragma Assert (Present (SMT_Aspect_Value));
+
+         Assoc := First (Component_Associations (SMT_Aspect_Value));
+         while Present (Assoc) loop
+            if Chars (First (Choices (Assoc))) = Nam then
+               return Entity (Expression (Assoc));
+            end if;
+
+            Next (Assoc);
+         end loop;
+
+         return Empty;
+      end Get_Storage_Model_Type_Entity;
+
       --------------------------------
       -- Storage_Model_Address_Type --
       --------------------------------
 
-      function Storage_Model_Address_Type (Typ : Entity_Id) return Entity_Id is
+      function Storage_Model_Address_Type
+        (SM_Obj_Or_Type : Entity_Id) return Entity_Id
+      is
       begin
-         return Get_Storage_Model_Type_Entity (Typ, Name_Address_Type);
+         return
+           Get_Storage_Model_Type_Entity (SM_Obj_Or_Type, Name_Address_Type);
       end Storage_Model_Address_Type;
 
       --------------------------------
       -- Storage_Model_Null_Address --
       --------------------------------
 
-      function Storage_Model_Null_Address (Typ : Entity_Id) return Entity_Id is
+      function Storage_Model_Null_Address
+        (SM_Obj_Or_Type : Entity_Id) return Entity_Id
+      is
       begin
-         return Get_Storage_Model_Type_Entity (Typ, Name_Null_Address);
+         return
+           Get_Storage_Model_Type_Entity (SM_Obj_Or_Type, Name_Null_Address);
       end Storage_Model_Null_Address;
 
       ----------------------------
       -- Storage_Model_Allocate --
       ----------------------------
 
-      function Storage_Model_Allocate (Typ : Entity_Id) return Entity_Id is
+      function Storage_Model_Allocate
+        (SM_Obj_Or_Type : Entity_Id) return Entity_Id
+      is
       begin
-         return Get_Storage_Model_Type_Entity (Typ, Name_Allocate);
+         return Get_Storage_Model_Type_Entity (SM_Obj_Or_Type, Name_Allocate);
       end Storage_Model_Allocate;
 
       ------------------------------
       -- Storage_Model_Deallocate --
       ------------------------------
 
-      function Storage_Model_Deallocate (Typ : Entity_Id) return Entity_Id is
+      function Storage_Model_Deallocate
+        (SM_Obj_Or_Type : Entity_Id) return Entity_Id
+      is
       begin
-         return Get_Storage_Model_Type_Entity (Typ, Name_Deallocate);
+         return
+           Get_Storage_Model_Type_Entity (SM_Obj_Or_Type, Name_Deallocate);
       end Storage_Model_Deallocate;
 
       -----------------------------
       -- Storage_Model_Copy_From --
       -----------------------------
 
-      function Storage_Model_Copy_From (Typ : Entity_Id) return Entity_Id is
+      function Storage_Model_Copy_From
+        (SM_Obj_Or_Type : Entity_Id) return Entity_Id
+      is
       begin
-         return Get_Storage_Model_Type_Entity (Typ, Name_Copy_From);
+         return Get_Storage_Model_Type_Entity (SM_Obj_Or_Type, Name_Copy_From);
       end Storage_Model_Copy_From;
 
       ---------------------------
       -- Storage_Model_Copy_To --
       ---------------------------
 
-      function Storage_Model_Copy_To (Typ : Entity_Id) return Entity_Id is
+      function Storage_Model_Copy_To
+        (SM_Obj_Or_Type : Entity_Id) return Entity_Id
+      is
       begin
-         return Get_Storage_Model_Type_Entity (Typ, Name_Copy_To);
+         return Get_Storage_Model_Type_Entity (SM_Obj_Or_Type, Name_Copy_To);
       end Storage_Model_Copy_To;
 
       --------------------------------
       -- Storage_Model_Storage_Size --
       --------------------------------
 
-      function Storage_Model_Storage_Size (Typ : Entity_Id) return Entity_Id is
+      function Storage_Model_Storage_Size
+        (SM_Obj_Or_Type : Entity_Id) return Entity_Id
+      is
       begin
-         return Get_Storage_Model_Type_Entity (Typ, Name_Storage_Size);
+         return
+           Get_Storage_Model_Type_Entity (SM_Obj_Or_Type, Name_Storage_Size);
       end Storage_Model_Storage_Size;
 
    end Storage_Model_Support;
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 3ce2233645e..6f28fe0b652 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -3591,68 +3591,78 @@ package Sem_Util is
       --  for the Storage_Model feature. These functions provide an interface
       --  that the compiler (in particular back-end phases such as gigi and
       --  GNAT-LLVM) can use to easily obtain entities and operations that
-      --  are specified for types in the aspects Storage_Model_Type and
+      --  are specified for types that have aspects Storage_Model_Type or
       --  Designated_Storage_Model.
 
-      function Get_Storage_Model_Type_Entity
-        (Typ : Entity_Id;
-         Nam : Name_Id) return Entity_Id;
-      --  Given type Typ with aspect Storage_Model_Type, returns the Entity_Id
-      --  corresponding to the entity associated with Nam in the aspect. If the
-      --  type does not specify the aspect, or such an entity is not present,
-      --  then returns Empty. (Note: This function is modeled on function
-      --  Get_Iterable_Type_Primitive.)
+      function Has_Storage_Model_Type_Aspect (Typ : Entity_Id) return Boolean;
+      --  Returns True iff Typ specifies aspect Storage_Model_Type
 
       function Has_Designated_Storage_Model_Aspect
         (Typ : Entity_Id) return Boolean;
       --  Returns True iff Typ specifies aspect Designated_Storage_Model
 
-      function Has_Storage_Model_Type_Aspect (Typ : Entity_Id) return Boolean;
-      --  Returns True iff Typ specifies aspect Storage_Model_Type
-
       function Storage_Model_Object (Typ : Entity_Id) return Entity_Id;
-      --  Given an access type with aspect Designated_Storage_Model, returns
-      --  the storage-model object associated with that type; returns Empty
-      --  if there is no associated object.
+      --  Given an access type Typ with aspect Designated_Storage_Model,
+      --  returns the storage-model object associated with that type.
+      --  The object Entity_Ids returned by this function can be passed
+      --  other functions declared in this interface to retrieve operations
+      --  associated with Storage_Model_Type aspect of the object's type.
 
       function Storage_Model_Type (Obj : Entity_Id) return Entity_Id;
       --  Given an object Obj of a type specifying aspect Storage_Model_Type,
-      --  returns that type; otherwise returns Empty.
-
-      function Storage_Model_Address_Type (Typ : Entity_Id) return Entity_Id;
-      --  Given a type Typ that specifies aspect Storage_Model_Type, returns
-      --  the type specified for the Address_Type choice in that aspect;
-      --  returns Empty if the aspect or the type isn't specified.
-
-      function Storage_Model_Null_Address (Typ : Entity_Id) return Entity_Id;
-      --  Given a type Typ that specifies aspect Storage_Model_Type, returns
-      --  constant specified for Null_Address choice in that aspect; returns
-      --  Empty if the aspect or the constant object isn't specified.
-
-      function Storage_Model_Allocate (Typ : Entity_Id) return Entity_Id;
-      --  Given a type Typ that specifies aspect Storage_Model_Type, returns
-      --  procedure specified for the Allocate choice in that aspect; returns
-      --  Empty if the aspect or the procedure isn't specified.
-
-      function Storage_Model_Deallocate (Typ : Entity_Id) return Entity_Id;
-      --  Given a type Typ that specifies aspect Storage_Model_Type, returns
-      --  procedure specified for the Deallocate choice in that aspect; returns
-      --  Empty if the aspect or the procedure isn't specified.
-
-      function Storage_Model_Copy_From (Typ : Entity_Id) return Entity_Id;
-      --  Given a type Typ that specifies aspect Storage_Model_Type, returns
-      --  procedure specified for the Copy_From choice in that aspect; returns
-      --  Empty if the aspect or the procedure isn't specified.
-
-      function Storage_Model_Copy_To (Typ : Entity_Id) return Entity_Id;
-      --  Given a type Typ that specifies aspect Storage_Model_Type, returns
-      --  procedure specified for the Copy_To choice in that aspect; returns
-      --  Empty if the aspect or the procedure isn't specified.
-
-      function Storage_Model_Storage_Size (Typ : Entity_Id) return Entity_Id;
-      --  Given a type Typ that specifies aspect Storage_Model_Type, returns
-      --  function specified for Storage_Size choice in that aspect; returns
-      --  Empty if the aspect or the procedure isn't specified.
+      --  returns that type.
+
+      function Get_Storage_Model_Type_Entity
+        (SM_Obj_Or_Type : Entity_Id;
+         Nam            : Name_Id) return Entity_Id;
+      --  Given a type with aspect Storage_Model_Type or an object of such a
+      --  type, and Nam denoting the name of one of the argument kinds allowed
+      --  for that aspect, returns the Entity_Id corresponding to the entity
+      --  associated with Nam in the aspect. If such an entity is not present,
+      --  then returns Empty. (Note: This function is modeled on function
+      --  Get_Iterable_Type_Primitive.)
+
+      function Storage_Model_Address_Type
+        (SM_Obj_Or_Type : Entity_Id) return Entity_Id;
+      --  Given a type with aspect Storage_Model_Type or an object of such a
+      --  type, returns the type specified for the Address_Type choice in that
+      --  aspect; returns Empty if the type isn't specified.
+
+      function Storage_Model_Null_Address
+        (SM_Obj_Or_Type : Entity_Id) return Entity_Id;
+      --  Given a type with aspect Storage_Model_Type or an object of such a
+      --  type, returns the constant specified for the Null_Address choice in
+      --  that aspect; returns Empty if the constant object isn't specified.
+
+      function Storage_Model_Allocate
+        (SM_Obj_Or_Type : Entity_Id) return Entity_Id;
+      --  Given a type with aspect Storage_Model_Type or an object of such a
+      --  type, returns the procedure specified for the Allocate choice in that
+      --  aspect; returns Empty if the procedure isn't specified.
+
+      function Storage_Model_Deallocate
+        (SM_Obj_Or_Type : Entity_Id) return Entity_Id;
+      --  Given a type with aspect Storage_Model_Type or an object of such a
+      --  type, returns the procedure specified for the Deallocate choice in
+      --  that aspect; returns Empty if the procedure isn't specified.
+
+      function Storage_Model_Copy_From
+        (SM_Obj_Or_Type : Entity_Id) return Entity_Id;
+      --  Given a type with aspect Storage_Model_Type or an object of such a
+      --  type, returns the procedure specified for the Copy_From choice in
+      --  that aspect; returns Empty if the procedure isn't specified.
+
+      function Storage_Model_Copy_To
+        (SM_Obj_Or_Type : Entity_Id) return Entity_Id;
+      --  Given a type with aspect Storage_Model_Type or an object of such a
+      --  type, returns the procedure specified for the Copy_To choice in that
+      --  aspect; returns Empty if the procedure isn't specified.
+
+      function Storage_Model_Storage_Size
+        (SM_Obj_Or_Type : Entity_Id) return Entity_Id;
+      --  Given a type with aspect Storage_Model_Type or an object of such a
+      --  type, returns the function specified for the Storage_Size choice in
+      --  that aspect; returns Empty if the procedure isn't specified.
 
    end Storage_Model_Support;


^ permalink raw reply	[flat|nested] only message in thread

only message in thread, other threads:[~2022-05-16  8:44 UTC | newest]

Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-05-16  8:44 [gcc r13-490] [Ada] Revise Storage_Model_Support operations to do checks and take objects and types Pierre-Marie de Rodat

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).