===================================================================
@@ -4159,6 +4159,61 @@ package body Exp_Util is
end May_Generate_Large_Temp;
----------------------------
+ -- Needs_Constant_Address --
+ ----------------------------
+
+ function Needs_Constant_Address
+ (Decl : Node_Id;
+ Typ : Entity_Id) return Boolean
+ is
+ begin
+
+ -- If we have no initialization of any kind, then we don't need to
+ -- place any restrictions on the address clause, because the object
+ -- will be elaborated after the address clause is evaluated. This
+ -- happens if the declaration has no initial expression, or the type
+ -- has no implicit initialization, or the object is imported.
+
+ -- The same holds for all initialized scalar types and all access
+ -- types. Packed bit arrays of size up to 64 are represented using a
+ -- modular type with an initialization (to zero) and can be processed
+ -- like other initialized scalar types.
+
+ -- If the type is controlled, code to attach the object to a
+ -- finalization chain is generated at the point of declaration,
+ -- and therefore the elaboration of the object cannot be delayed:
+ -- the address expression must be a constant.
+
+ if No (Expression (Decl))
+ and then not Needs_Finalization (Typ)
+ and then
+ (not Has_Non_Null_Base_Init_Proc (Typ)
+ or else Is_Imported (Defining_Identifier (Decl)))
+ then
+ return False;
+
+ elsif (Present (Expression (Decl)) and then Is_Scalar_Type (Typ))
+ or else Is_Access_Type (Typ)
+ or else
+ (Is_Bit_Packed_Array (Typ)
+ and then Is_Modular_Integer_Type (Packed_Array_Type (Typ)))
+ then
+ return False;
+
+ else
+
+ -- Otherwise, we require the address clause to be constant because
+ -- the call to the initialization procedure (or the attach code) has
+ -- to happen at the point of the declaration.
+
+ -- Actually the IP call has been moved to the freeze actions
+ -- anyway, so maybe we can relax this restriction???
+
+ return True;
+ end if;
+ end Needs_Constant_Address;
+
+ ----------------------------
-- New_Class_Wide_Subtype --
----------------------------
@@ -4946,6 +5001,7 @@ package body Exp_Util is
Make_Object_Declaration (Loc,
Defining_Identifier => Def_Id,
Object_Definition => New_Reference_To (Ref_Type, Loc),
+ Constant_Present => True,
Expression => New_Exp));
end if;
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 1992-2010, 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- --
@@ -575,6 +575,13 @@ package Exp_Util is
-- caller has to check whether stack checking is actually enabled in order
-- to guide the expansion (typically of a function call).
+ function Needs_Constant_Address
+ (Decl : Node_Id;
+ Typ : Entity_Id) return Boolean;
+ -- Check whether the expression in an address clause is restricted to
+ -- consist of constants, when the object has a non-trivial initialization
+ -- or is controlled.
+
function Non_Limited_Designated_Type (T : Entity_Id) return Entity_Id;
-- An anonymous access type may designate a limited view. Check whether
-- non-limited view is available during expansion, to examine components
===================================================================
@@ -544,42 +544,7 @@ package body Freeze is
if Present (Addr) then
Expr := Expression (Addr);
- -- If we have no initialization of any kind, then we don't need to
- -- place any restrictions on the address clause, because the object
- -- will be elaborated after the address clause is evaluated. This
- -- happens if the declaration has no initial expression, or the type
- -- has no implicit initialization, or the object is imported.
-
- -- The same holds for all initialized scalar types and all access
- -- types. Packed bit arrays of size up to 64 are represented using a
- -- modular type with an initialization (to zero) and can be processed
- -- like other initialized scalar types.
-
- -- If the type is controlled, code to attach the object to a
- -- finalization chain is generated at the point of declaration,
- -- and therefore the elaboration of the object cannot be delayed:
- -- the address expression must be a constant.
-
- if (No (Expression (Decl))
- and then not Needs_Finalization (Typ)
- and then (not Has_Non_Null_Base_Init_Proc (Typ)
- or else Is_Imported (E)))
- or else (Present (Expression (Decl)) and then Is_Scalar_Type (Typ))
- or else Is_Access_Type (Typ)
- or else
- (Is_Bit_Packed_Array (Typ)
- and then Is_Modular_Integer_Type (Packed_Array_Type (Typ)))
- then
- null;
-
- -- Otherwise, we require the address clause to be constant because
- -- the call to the initialization procedure (or the attach code) has
- -- to happen at the point of the declaration.
-
- -- Actually the IP call has been moved to the freeze actions
- -- anyway, so maybe we can relax this restriction???
-
- else
+ if Needs_Constant_Address (Decl, Typ) then
Check_Constant_Address_Clause (Expr, E);
-- Has_Delayed_Freeze was set on E when the address clause was
===================================================================
@@ -127,6 +127,16 @@ package body Exp_Ch13 is
else
Set_Expression (Decl, Empty);
end if;
+
+ -- An object declaration to which an address clause applies
+ -- has a delayed freeze, but the address expression itself
+ -- must be elaborated at the point it appears. If the object
+ -- is controlled, additional checks apply elsewhere.
+
+ elsif Nkind (Decl) = N_Object_Declaration
+ and then not Needs_Constant_Address (Decl, Typ)
+ then
+ Remove_Side_Effects (Exp);
end if;
end;
If an object has an address clause, we defer its freeze point because a subsequent Import pragma for it may affect its elaboration. However, the address expression itself must not be deferred because it may have side-effects and this must appear at the proper place in the elaboration code. This patch creates a constant declaration for the expression in an address clause whenever this is legal, so that this expression is elaborated where it appears, and not at the freeze point of the object to which it applies. The following must compile and execute quietly: with Pack; use Pack; procedure Check_Init is begin if not Done then raise Program_Error; end if; end; --- with System; package Addr is function Find_Place return System.Address; function Report return Boolean; end Addr; --- package body Addr is Anchor : Integer := 0; function Find_Place return System.Address is begin Anchor := 111; return Anchor'Address; end Find_Place; function Report return Boolean is begin return Anchor = 111; end; end Addr; --- with Addr; use Addr; package Pack is Var1 : Integer; for Var1'address use Find_Place; Done : Boolean := Report; Var2 : Integer; end; Tested on x86_64-pc-linux-gnu, committed on trunk 2010-08-05 Ed Schonberg <schonberg@adacore.com> * exp_util.ads, exp_util.adb (Needs_Constant_Address): New predicate to determine whether the expression in an address clause for an initialized object must be constant. Code moved from freeze.adb. (Remove_Side_Effects): When the temporary is initialized with a reference, indicate that the temporary is a constant as done in all other cases. * freeze.adb (Check_Address_Clause): use Needs_Constant_Address. * exp_ch13.adb (Expand_N_Attribute_Definition_Clause, case 'Address): If object does not need a constant address, remove side effects from address expression, so it is elaborated at the point of the address clause and not at the freeze point of the object, so that elaboration order is respected.