===================================================================
@@ -7103,6 +7103,7 @@
when Attribute_Bit_Order |
Attribute_Code_Address |
Attribute_Definite |
+ Attribute_Deref |
Attribute_Null_Parameter |
Attribute_Passed_By_Reference |
Attribute_Pool_Address |
===================================================================
@@ -3540,6 +3540,16 @@
Check_Floating_Point_Type_0;
Set_Etype (N, Standard_Boolean);
+ -----------
+ -- Deref --
+ -----------
+
+ when Attribute_Deref =>
+ Check_Type;
+ Check_E1;
+ Resolve (E1, RTE (RE_Address));
+ Set_Etype (N, P_Type);
+
---------------------
-- Descriptor_Size --
---------------------
@@ -9642,6 +9652,7 @@
Attribute_Count |
Attribute_Default_Bit_Order |
Attribute_Default_Scalar_Storage_Order |
+ Attribute_Deref |
Attribute_Elaborated |
Attribute_Elab_Body |
Attribute_Elab_Spec |
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -42,9 +42,9 @@
-- Implementation Dependent Attributes --
-----------------------------------------
- -- This section describes the implementation dependent attributes
- -- provided in GNAT, as well as constructing an array of flags
- -- indicating which attributes these are.
+ -- This section describes the implementation dependent attributes provided
+ -- in GNAT, as well as constructing an array of flags indicating which
+ -- attributes these are.
Attribute_Impl_Def : Attribute_Class_Array := Attribute_Class_Array'(
@@ -152,6 +152,17 @@
-- Default_Scalar_Storage_Order, or equal to Default_Bit_Order if
-- unspecified) as a System.Bit_Order value. This is a static attribute.
+ -----------
+ -- Deref --
+ -----------
+
+ Attribute_Deref => True,
+ -- typ'Deref (expr) is valid only if expr is of type System'Address.
+ -- The result is an object of type typ that is obtained by treating the
+ -- address as an access-to-typ value that points to the result. It is
+ -- basically equivalent to (atyp!expr).all where atyp is an access type
+ -- for the type.
+
---------------
-- Elab_Body --
---------------
===================================================================
@@ -845,6 +845,7 @@
Name_Definite : constant Name_Id := N + $;
Name_Delta : constant Name_Id := N + $;
Name_Denorm : constant Name_Id := N + $;
+ Name_Deref : constant Name_Id := N + $; -- GNAT
Name_Descriptor_Size : constant Name_Id := N + $;
Name_Digits : constant Name_Id := N + $;
Name_Elaborated : constant Name_Id := N + $; -- GNAT
@@ -1476,6 +1477,7 @@
Attribute_Definite,
Attribute_Delta,
Attribute_Denorm,
+ Attribute_Deref,
Attribute_Descriptor_Size,
Attribute_Digits,
Attribute_Elaborated,
This attribute is equivalent to (atyp!(address-expr)).all where atyp is a general-access-to-typ type. Right now, only the front end changes are done. The back end needs to adapt to this change too. The following is a test which should compile and run silently 1. with System; use System; 2. procedure Deref_Test is 3. X : Integer := 4; 4. Y : Address := X'Address; 5. begin 6. if Integer'Deref (Y) /= 4 then 7. raise Program_Error; 8. end if; 9. end Deref_Test; For now it will blow up with a GCC error in the back end, which does not know about this attribute yet. Tested on x86_64-pc-linux-gnu, committed on trunk 2015-03-24 Robert Dewar <dewar@adacore.com> * exp_attr.adb: Add entry for typ'Deref. * sem_attr.adb (Deref): New GNAT attribute. * sem_attr.ads: Add entry for new GNAT attribute Deref. * snames.ads-tmpl: Add entries for new attribute Deref.