Index: exp_util.adb =================================================================== --- exp_util.adb (revision 162905) +++ exp_util.adb (working copy) @@ -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; Index: exp_util.ads =================================================================== --- exp_util.ads (revision 162866) +++ exp_util.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- 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 Index: freeze.adb =================================================================== --- freeze.adb (revision 162866) +++ freeze.adb (working copy) @@ -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 Index: exp_ch13.adb =================================================================== --- exp_ch13.adb (revision 162866) +++ exp_ch13.adb (working copy) @@ -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;