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 <de...@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.
Index: exp_attr.adb
===================================================================
--- exp_attr.adb (revision 221624)
+++ exp_attr.adb (working copy)
@@ -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 |
Index: sem_attr.adb
===================================================================
--- sem_attr.adb (revision 221624)
+++ sem_attr.adb (working copy)
@@ -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 |
Index: sem_attr.ads
===================================================================
--- sem_attr.ads (revision 221624)
+++ sem_attr.ads (working copy)
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
+-- 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 --
---------------
Index: snames.ads-tmpl
===================================================================
--- snames.ads-tmpl (revision 221624)
+++ snames.ads-tmpl (working copy)
@@ -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,
