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
begin
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;
begin
Put_Line ("must not be executed (PE raised)");
end;
Tested on x86_64-pc-linux-gnu, committed on trunk
2013-01-03 Thomas Quinot <[email protected]>
* 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.
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);
return;
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);
