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