[Ada] Incorrect attachment point for address clause alignment check

Submitted by Arnaud Charlet on Jan. 3, 2013, 11:05 a.m.


Message ID 20130103110545.GA22552@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Jan. 3, 2013, 11:05 a.m.
The alignment check for an address clause must be inserted after the
object has been elaborated in the GIGI sense, but before any initialization
operation occur. This change fixes both the spec and implementation
of Apply_Address_Clause_Check to this effect (previously they disagreed,
and were both incorrect: following the spec would have cause the check
to occur too early, before the alignment of the object can be accurately
determined, while the implementation would insert it too late, after
initialization is done).

The following compilation must be accepted quietly and produce the
indicated exception occurrence:

$ gnatmake -q -gnatws addr_init_misaligned
$ ./addr_init_misaligned

raised PROGRAM_ERROR : addr_init_misaligned.adb:23 misaligned address value

with System.Storage_Elements;
with Ada.Text_IO; use Ada.Text_IO;

procedure Addr_Init_Misaligned is
   Misaligned : constant System.Address :=
                  System.Storage_Elements.To_Address (1);

   function F return Integer is
      Put_Line ("must not be called!");
      return 666;
   end F;

   type R is record
      Comp_I : Integer := F;
      comp_S : String (1 .. 10);
   end record;

   X : R;
   --  The init proc should never be evaluated because the address clause
   --  is misaligned.

   for X'Address use Misaligned;

   Put_Line ("must not be executed (PE raised)");

Tested on x86_64-pc-linux-gnu, committed on trunk

2013-01-03  Thomas Quinot  <quinot@adacore.com>

	* checks.adb, checks.ads (Apply_Address_Clause_Check): The check must
	be generated at the start of the freeze actions for the entity, not
	before (or after) the freeze node.

Patch hide | download patch | download mbox

Index: checks.adb
--- checks.adb	(revision 194841)
+++ checks.adb	(working copy)
@@ -575,6 +575,8 @@ 
    procedure Apply_Address_Clause_Check (E : Entity_Id; N : Node_Id) is
+      pragma Assert (Nkind (N) = N_Freeze_Entity);
       AC   : constant Node_Id    := Address_Clause (E);
       Loc  : constant Source_Ptr := Sloc (AC);
       Typ  : constant Entity_Id  := Etype (E);
@@ -734,7 +736,11 @@ 
             Remove_Side_Effects (Expr);
          end if;
-         Insert_After_And_Analyze (N,
+         if No (Actions (N)) then
+            Set_Actions (N, New_List);
+         end if;
+         Prepend_To (Actions (N),
            Make_Raise_Program_Error (Loc,
              Condition =>
                Make_Op_Ne (Loc,
@@ -745,11 +751,11 @@ 
                          (RTE (RE_Integer_Address), Expr),
                      Right_Opnd =>
                        Make_Attribute_Reference (Loc,
-                         Prefix => New_Occurrence_Of (E, Loc),
+                         Prefix         => New_Occurrence_Of (E, Loc),
                          Attribute_Name => Name_Alignment)),
                  Right_Opnd => Make_Integer_Literal (Loc, Uint_0)),
-             Reason => PE_Misaligned_Address_Value),
-           Suppress => All_Checks);
+             Reason => PE_Misaligned_Address_Value));
+         Analyze (First (Actions (N)), Suppress => All_Checks);
       end if;
Index: checks.ads
--- checks.ads	(revision 194841)
+++ checks.ads	(working copy)
@@ -131,8 +131,11 @@ 
    --  are enabled, then this procedure generates a check that the specified
    --  address has an alignment consistent with the alignment of the object,
    --  raising PE if this is not the case. The resulting check (if one is
-   --  generated) is inserted before node N. check is also made for the case of
-   --  a clear overlay situation that the size of the overlaying object is not
+   --  generated) is prepended to the Actions list of N_Freeze_Entity node N.
+   --  Note that the check references E'Alignment, so it cannot be emitted
+   --  before N (its freeze node), otherwise this would cause an illegal
+   --  access before elaboration error in GIGI. For the case of a clear overlay
+   --  situation, we also check that the size of the overlaying object is not
    --  larger than the overlaid object.
    procedure Apply_Arithmetic_Overflow_Check (N : Node_Id);