An address clause that overlays an object with a controlled object of a
component of a controlled object is erroneous, and the compiler replaces the
address clause with the corresponding raise statement. However, the analysis
of the address clause must not terminate prematurely, so that the back-end
can complete code generation.
Compiling and executing main,adb must yield:
main.adb:4:03: warning: in instantiation at erase_on_finalize.adb:22
main.adb:4:03: warning: cannot use overlays with controlled objects
main.adb:4:03: warning: Program_Error will be raised at run time
raised PROGRAM_ERROR : main.adb:2 finalize/adjust raised exception
---
with Erase_On_Finalize;
procedure Main is
package Sensitive_Integer is new Erase_On_Finalize (Integer);
I1: Sensitive_Integer.Object := (Sensitive_Integer.Root with 1);
I2: Sensitive_Integer.Object := (Sensitive_Integer.Root with 2);
I3: Sensitive_Integer.Object := (Sensitive_Integer.Root with 3);
begin
null;
end Main;
---
with Ada.Finalization;
generic
type Data_Type is limited private;
package Erase_On_Finalize is
subtype Root is Ada.Finalization.Limited_Controlled;
type Object is new Root with
record
Contents : Data_Type;
end record;
overriding procedure Finalize (Obj: in out Object);
-- Disallow dynamic memory allocation.
type Object_Ref is access Object with Storage_Size => 0;
end Erase_On_Finalize;
---
with System;
with Interfaces;
with GNAT.Memory_Dump;
package body Erase_On_Finalize is
subtype Byte_Type is Interfaces.Unsigned_8;
use type Byte_Type;
Erase_Pattern : constant Byte_Type := 0;
procedure Erase_Bytes (Addr: System.Address; Bytes: Natural) is
type Byte_View_Type is array (1 .. Bytes) of Byte_Type;
Byte_View : Byte_View_Type with Address => Addr, Volatile;
begin
GNAT.Memory_Dump.Dump (Addr, Bytes);
Byte_View := (others => Erase_Pattern);
end Erase_Bytes;
overriding procedure Finalize (Obj: in out Object) is
type Byte_View_Type is array (1 .. (Obj.Contents'Size + 7) / 8)
of Byte_Type;
Byte_View : Byte_View_Type with address => Obj.Contents'address,
Volatile;
begin
GNAT.Memory_Dump.Dump (Byte_View'Address, Byte_View'Length);
Byte_View := (others => Erase_Pattern);
end Finalize;
end Erase_On_Finalize;
Tested on x86_64-pc-linux-gnu, committed on trunk
2015-10-20 Ed Schonberg <schonb...@adacore.com>
* sem_ch13.adb: nalyze_Attribute_Definition_Clause, case
'Address): If either object is controlled the overlay is
erroneous, but analysis must be completed so that back-end sees
address clause and completes code generation. Improve text
of warning.
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb (revision 229071)
+++ sem_ch13.adb (working copy)
@@ -4711,20 +4711,22 @@
Find_Overlaid_Entity (N, O_Ent, Off);
- -- Overlaying controlled objects is erroneous
+ -- Overlaying controlled objects is erroneous.
+ -- Emit warning but continue analysis because program is
+ -- itself legal, and back-end must see address clause.
if Present (O_Ent)
and then (Has_Controlled_Component (Etype (O_Ent))
or else Is_Controlled (Etype (O_Ent)))
+ and then not Inside_A_Generic
then
Error_Msg_N
- ("??cannot overlay with controlled object", Expr);
+ ("??cannot use overlays with controlled objects", Expr);
Error_Msg_N
("\??Program_Error will be raised at run time", Expr);
Insert_Action (Declaration_Node (U_Ent),
Make_Raise_Program_Error (Loc,
Reason => PE_Overlaid_Controlled_Object));
- return;
elsif Present (O_Ent)
and then Ekind (U_Ent) = E_Constant
