]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
ada: Use the address type of a Storage_Model_Type for 'Address
authorGary Dismukes <dismukes@adacore.com>
Fri, 18 Nov 2022 22:43:36 +0000 (17:43 -0500)
committerMarc Poulhiès <poulhies@adacore.com>
Thu, 1 Dec 2022 13:53:53 +0000 (14:53 +0100)
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

index 4c76b9344c2677309b8b4ee46ea3a42882bba989..cca6f6f8c7d5fec5f2e3ab402d6d20f6bc0dc6db 100644 (file)
@@ -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 --