From 8e56d311d380cbdc37a910fa96c06c6eb91973d7 Mon Sep 17 00:00:00 2001 From: Gary Dismukes Date: Fri, 18 Nov 2022 17:43:36 -0500 Subject: ada: Use the address type of a Storage_Model_Type for 'Address When an Address attribute applies to an object that is a dereference of an access value whose type has aspect Designated_Storage_Model, the attribute will now be treated as having the address type associated with the Storage_Model_Type of the access type's associated Storage_Model object instead of being of type System.Address. gcc/ada/ * sem_attr.adb (Analyze_Attribute, Attribute_Address): In the case where the attribute's prefix is a dereference of a value of an access type that has aspect Designated_Storage_Model (or a renaming of such a dereference), set the attribute's type to the corresponding Storage_Model_Type's associated address type rather than System.Address. --- gcc/ada/sem_attr.adb | 29 ++++++++++++++++++++++++++++- 1 file changed, 28 insertions(+), 1 deletion(-) diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 4c76b93..cca6f6f 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -3430,7 +3430,34 @@ package body Sem_Attr is Check_E0; Address_Checks; Check_Not_Incomplete_Type; - Set_Etype (N, RTE (RE_Address)); + + -- If the prefix is a dereference of a value whose associated access + -- type has been specified with aspect Designated_Storage_Model, then + -- use the associated Storage_Model_Type's address type as the type + -- of the attribute. Otherwise we use System.Address as usual. This + -- isn't normally legit for a predefined attribute, but this is for + -- our own extension to addressing and currently requires extensions + -- to be enabled (such as with -gnatX0). + + declare + Prefix_Obj : constant Node_Id := Get_Referenced_Object (P); + Addr_Type : Entity_Id := RTE (RE_Address); + begin + if Nkind (Prefix_Obj) = N_Explicit_Dereference then + declare + P_Type : constant Entity_Id := Etype (Prefix (Prefix_Obj)); + + use Storage_Model_Support; + begin + if Has_Designated_Storage_Model_Aspect (P_Type) then + Addr_Type := Storage_Model_Address_Type + (Storage_Model_Object (P_Type)); + end if; + end; + end if; + + Set_Etype (N, Addr_Type); + end; ------------------ -- Address_Size -- -- cgit v1.1