[gcc r13-4441] ada: Use the address type of a Storage_Model_Type for 'Address

[gcc r13-4441] ada: Use the address type of a Storage_Model_Type for 'Address

[Marc Poulhi?s]

https://gcc.gnu.org/g:8e56d311d380cbdc37a910fa96c06c6eb91973d7

commit r13-4441-g8e56d311d380cbdc37a910fa96c06c6eb91973d7
Author: Gary Dismukes <dismukes@adacore.com>
Date:   Fri Nov 18 17:43:36 2022 -0500

    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.

Diff:
---
 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 4c76b9344c2..cca6f6f8c7d 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 --