From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1914) id 0DD363858C50; Mon, 16 May 2022 08:44:13 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 0DD363858C50 MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Pierre-Marie de Rodat To: gcc-cvs@gcc.gnu.org Subject: [gcc r13-490] [Ada] Revise Storage_Model_Support operations to do checks and take objects and types X-Act-Checkin: gcc X-Git-Author: Gary Dismukes X-Git-Refname: refs/heads/master X-Git-Oldrev: ae745a0de34892d0d1e7157292628c375a94221f X-Git-Newrev: 21f8b410511d1ee9a46b7a902a368762f6256ea0 Message-Id: <20220516084413.0DD363858C50@sourceware.org> Date: Mon, 16 May 2022 08:44:13 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Mon, 16 May 2022 08:44:13 -0000 https://gcc.gnu.org/g:21f8b410511d1ee9a46b7a902a368762f6256ea0 commit r13-490-g21f8b410511d1ee9a46b7a902a368762f6256ea0 Author: Gary Dismukes 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;