diff mbox series

[COMMITTED] ada: Use the address type of a Storage_Model_Type for 'Address

Message ID 20221201135532.458039-1-poulhies@adacore.com
State Repeat Merge
Headers
Series [COMMITTED] ada: Use the address type of a Storage_Model_Type for 'Address |

Checks

Context Check Description
snail/gcc-patch-check warning Git am fail log

Commit Message

Marc Poulhiès Dec. 1, 2022, 1:55 p.m. UTC 
  From: Gary Dismukes <dismukes@adacore.com>

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.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_attr.adb | 29 ++++++++++++++++++++++++++++-
 1 file changed, 28 insertions(+), 1 deletion(-)
diff mbox series

Patch

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 --