Index: sem_ch3.adb =================================================================== --- sem_ch3.adb (revision 223040) +++ sem_ch3.adb (working copy) @@ -3336,6 +3336,18 @@ -- or a variant record type is encountered, Check_Restrictions is called -- indicating the count is unknown. + function Delayed_Aspect_Present return Boolean; + -- If the declaration has an expression that is an aggregate, and it + -- has aspects that require delayed analysis, the resolution of the + -- aggregate must be deferred to the freeze point of the objet. This + -- special processing was created for address clauses, but it must + -- also apply to Alignment. + -- This must be done before the aspect specifications are analyzed + -- because we must handle the aggregate before the analysis of the + -- object declaration is complete. + + -- any other relevant delayed aspects on object declarations ??? + ----------------- -- Count_Tasks -- ----------------- @@ -3390,6 +3402,32 @@ end if; end Count_Tasks; + ---------------------------- + -- Delayed_Aspect_Present -- + ---------------------------- + + function Delayed_Aspect_Present return Boolean is + A : Node_Id; + A_Id : Aspect_Id; + + begin + if Present (Aspect_Specifications (N)) then + A := First (Aspect_Specifications (N)); + A_Id := Get_Aspect_Id (Chars (Identifier (A))); + while Present (A) loop + if + A_Id = Aspect_Alignment or else A_Id = Aspect_Address + then + return True; + end if; + + Next (A); + end loop; + end if; + + return False; + end Delayed_Aspect_Present; + -- Start of processing for Analyze_Object_Declaration begin @@ -3705,7 +3743,8 @@ if Comes_From_Source (N) and then Expander_Active and then Nkind (E) = N_Aggregate - and then Present (Following_Address_Clause (N)) + and then (Present (Following_Address_Clause (N)) + or else Delayed_Aspect_Present) then Set_Etype (E, T); Index: freeze.adb =================================================================== --- freeze.adb (revision 223039) +++ freeze.adb (working copy) @@ -1894,6 +1894,10 @@ procedure Freeze_Array_Type (Arr : Entity_Id); -- Freeze array type, including freezing index and component types + procedure Freeze_Object_Declaration (E : Entity_Id); + -- Perfom checks and generate freeze node if needed for a constant + -- or variable declared by an object declaration. + function Freeze_Generic_Entities (Pack : Entity_Id) return List_Id; -- Create Freeze_Generic_Entity nodes for types declared in a generic -- package. Recurse on inner generic packages. @@ -2782,6 +2786,211 @@ end if; end Freeze_Array_Type; + ------------------------------- + -- Freeze_Object_Declaration -- + ------------------------------- + + procedure Freeze_Object_Declaration (E : Entity_Id) is + begin + -- Abstract type allowed only for C++ imported variables or + -- constants. + + -- Note: we inhibit this check for objects that do not come + -- from source because there is at least one case (the + -- expansion of x'Class'Input where x is abstract) where we + -- legitimately generate an abstract object. + + if Is_Abstract_Type (Etype (E)) + and then Comes_From_Source (Parent (E)) + and then not (Is_Imported (E) and then Is_CPP_Class (Etype (E))) + then + Error_Msg_N ("type of object cannot be abstract", + Object_Definition (Parent (E))); + + if Is_CPP_Class (Etype (E)) then + Error_Msg_NE ("\} may need a cpp_constructor", + Object_Definition (Parent (E)), Etype (E)); + + elsif Present (Expression (Parent (E))) then + Error_Msg_N -- CODEFIX + ("\maybe a class-wide type was meant", + Object_Definition (Parent (E))); + end if; + end if; + + -- For object created by object declaration, perform required + -- categorization (preelaborate and pure) checks. Defer these + -- checks to freeze time since pragma Import inhibits default + -- initialization and thus pragma Import affects these checks. + + Validate_Object_Declaration (Declaration_Node (E)); + + -- If there is an address clause, check that it is valid + -- and if need be move initialization to the freeze node. + + Check_Address_Clause (E); + + -- Similar processing is needed for aspects that may affect + -- object layout, like Alignment, if there is an initialization + -- expression. + + if Has_Delayed_Aspects (E) + and then Expander_Active + and then Is_Array_Type (Etype (E)) + and then Present (Expression (Parent (E))) + then + declare + Decl : constant Node_Id := Parent (E); + Lhs : constant Node_Id := New_Occurrence_Of (E, Loc); + begin + + -- Capture initialization value at point of declaration, + -- and make explicit assignment legal, because object may + -- be a constant. + + Remove_Side_Effects (Expression (Decl)); + Set_Assignment_OK (Lhs); + + -- Move initialization to freeze actions. + + Append_Freeze_Action (E, + Make_Assignment_Statement (Loc, + Name => Lhs, + Expression => Expression (Decl))); + + Set_No_Initialization (Decl); + -- Set_Is_Frozen (E, False); + end; + end if; + + -- Reset Is_True_Constant for non-constant aliased object. We + -- consider that the fact that a non-constant object is aliased + -- may indicate that some funny business is going on, e.g. an + -- aliased object is passed by reference to a procedure which + -- captures the address of the object, which is later used to + -- assign a new value, even though the compiler thinks that it + -- is not modified. Such code is highly dubious, but we choose + -- to make it "work" for non-constant aliased objects. + -- Note that we used to do this for all aliased objects, whether + -- or not constant, but this caused anomalies down the line + -- because we ended up with static objects that were not + -- Is_True_Constant. Not resetting Is_True_Constant for (aliased) + -- constant objects ensures that this anomaly never occurs. + + -- However, we don't do that for internal entities. We figure + -- that if we deliberately set Is_True_Constant for an internal + -- entity, e.g. a dispatch table entry, then we mean it. + + if Ekind (E) /= E_Constant + and then (Is_Aliased (E) or else Is_Aliased (Etype (E))) + and then not Is_Internal_Name (Chars (E)) + then + Set_Is_True_Constant (E, False); + end if; + + -- If the object needs any kind of default initialization, an + -- error must be issued if No_Default_Initialization applies. + -- The check doesn't apply to imported objects, which are not + -- ever default initialized, and is why the check is deferred + -- until freezing, at which point we know if Import applies. + -- Deferred constants are also exempted from this test because + -- their completion is explicit, or through an import pragma. + + if Ekind (E) = E_Constant + and then Present (Full_View (E)) + then + null; + + elsif Comes_From_Source (E) + and then not Is_Imported (E) + and then not Has_Init_Expression (Declaration_Node (E)) + and then + ((Has_Non_Null_Base_Init_Proc (Etype (E)) + and then not No_Initialization (Declaration_Node (E)) + and then not Is_Value_Type (Etype (E)) + and then not Initialization_Suppressed (Etype (E))) + or else + (Needs_Simple_Initialization (Etype (E)) + and then not Is_Internal (E))) + then + Has_Default_Initialization := True; + Check_Restriction + (No_Default_Initialization, Declaration_Node (E)); + end if; + + -- Check that a Thread_Local_Storage variable does not have + -- default initialization, and any explicit initialization must + -- either be the null constant or a static constant. + + if Has_Pragma_Thread_Local_Storage (E) then + declare + Decl : constant Node_Id := Declaration_Node (E); + begin + if Has_Default_Initialization + or else + (Has_Init_Expression (Decl) + and then + (No (Expression (Decl)) + or else not + (Is_OK_Static_Expression (Expression (Decl)) + or else Nkind (Expression (Decl)) = N_Null))) + then + Error_Msg_NE + ("Thread_Local_Storage variable& is " + & "improperly initialized", Decl, E); + Error_Msg_NE + ("\only allowed initialization is explicit " + & "NULL or static expression", Decl, E); + end if; + end; + end if; + + -- For imported objects, set Is_Public unless there is also an + -- address clause, which means that there is no external symbol + -- needed for the Import (Is_Public may still be set for other + -- unrelated reasons). Note that we delayed this processing + -- till freeze time so that we can be sure not to set the flag + -- if there is an address clause. If there is such a clause, + -- then the only purpose of the Import pragma is to suppress + -- implicit initialization. + + if Is_Imported (E) and then No (Address_Clause (E)) then + Set_Is_Public (E); + end if; + + -- For source objects that are not Imported and are library + -- level, if no linker section pragma was given inherit the + -- appropriate linker section from the corresponding type. + + if Comes_From_Source (E) + and then not Is_Imported (E) + and then Is_Library_Level_Entity (E) + and then No (Linker_Section_Pragma (E)) + then + Set_Linker_Section_Pragma + (E, Linker_Section_Pragma (Etype (E))); + end if; + + -- For convention C objects of an enumeration type, warn if the + -- size is not integer size and no explicit size given. Skip + -- warning for Boolean, and Character, assume programmer expects + -- 8-bit sizes for these cases. + + if (Convention (E) = Convention_C + or else Convention (E) = Convention_CPP) + and then Is_Enumeration_Type (Etype (E)) + and then not Is_Character_Type (Etype (E)) + and then not Is_Boolean_Type (Etype (E)) + and then Esize (Etype (E)) < Standard_Integer_Size + and then not Has_Size_Clause (E) + then + Error_Msg_Uint_1 := UI_From_Int (Standard_Integer_Size); + Error_Msg_N + ("??convention C enumeration object has size less than ^", E); + Error_Msg_N ("\??use explicit size clause to set size", E); + end if; + end Freeze_Object_Declaration; + ----------------------------- -- Freeze_Generic_Entities -- ----------------------------- @@ -4690,176 +4899,7 @@ -- Special processing for objects created by object declaration if Nkind (Declaration_Node (E)) = N_Object_Declaration then - - -- Abstract type allowed only for C++ imported variables or - -- constants. - - -- Note: we inhibit this check for objects that do not come - -- from source because there is at least one case (the - -- expansion of x'Class'Input where x is abstract) where we - -- legitimately generate an abstract object. - - if Is_Abstract_Type (Etype (E)) - and then Comes_From_Source (Parent (E)) - and then not (Is_Imported (E) - and then Is_CPP_Class (Etype (E))) - then - Error_Msg_N ("type of object cannot be abstract", - Object_Definition (Parent (E))); - - if Is_CPP_Class (Etype (E)) then - Error_Msg_NE - ("\} may need a cpp_constructor", - Object_Definition (Parent (E)), Etype (E)); - - elsif Present (Expression (Parent (E))) then - Error_Msg_N -- CODEFIX - ("\maybe a class-wide type was meant", - Object_Definition (Parent (E))); - end if; - end if; - - -- For object created by object declaration, perform required - -- categorization (preelaborate and pure) checks. Defer these - -- checks to freeze time since pragma Import inhibits default - -- initialization and thus pragma Import affects these checks. - - Validate_Object_Declaration (Declaration_Node (E)); - - -- If there is an address clause, check that it is valid - - Check_Address_Clause (E); - - -- Reset Is_True_Constant for non-constant aliased object. We - -- consider that the fact that a non-constant object is aliased - -- may indicate that some funny business is going on, e.g. an - -- aliased object is passed by reference to a procedure which - -- captures the address of the object, which is later used to - -- assign a new value, even though the compiler thinks that - -- it is not modified. Such code is highly dubious, but we - -- choose to make it "work" for non-constant aliased objects. - -- Note that we used to do this for all aliased objects, - -- whether or not constant, but this caused anomalies down - -- the line because we ended up with static objects that - -- were not Is_True_Constant. Not resetting Is_True_Constant - -- for (aliased) constant objects ensures that this anomaly - -- never occurs. - - -- However, we don't do that for internal entities. We figure - -- that if we deliberately set Is_True_Constant for an internal - -- entity, e.g. a dispatch table entry, then we mean it. - - if Ekind (E) /= E_Constant - and then (Is_Aliased (E) or else Is_Aliased (Etype (E))) - and then not Is_Internal_Name (Chars (E)) - then - Set_Is_True_Constant (E, False); - end if; - - -- If the object needs any kind of default initialization, an - -- error must be issued if No_Default_Initialization applies. - -- The check doesn't apply to imported objects, which are not - -- ever default initialized, and is why the check is deferred - -- until freezing, at which point we know if Import applies. - -- Deferred constants are also exempted from this test because - -- their completion is explicit, or through an import pragma. - - if Ekind (E) = E_Constant - and then Present (Full_View (E)) - then - null; - - elsif Comes_From_Source (E) - and then not Is_Imported (E) - and then not Has_Init_Expression (Declaration_Node (E)) - and then - ((Has_Non_Null_Base_Init_Proc (Etype (E)) - and then not No_Initialization (Declaration_Node (E)) - and then not Is_Value_Type (Etype (E)) - and then not Initialization_Suppressed (Etype (E))) - or else - (Needs_Simple_Initialization (Etype (E)) - and then not Is_Internal (E))) - then - Has_Default_Initialization := True; - Check_Restriction - (No_Default_Initialization, Declaration_Node (E)); - end if; - - -- Check that a Thread_Local_Storage variable does not have - -- default initialization, and any explicit initialization must - -- either be the null constant or a static constant. - - if Has_Pragma_Thread_Local_Storage (E) then - declare - Decl : constant Node_Id := Declaration_Node (E); - begin - if Has_Default_Initialization - or else - (Has_Init_Expression (Decl) - and then - (No (Expression (Decl)) - or else not - (Is_OK_Static_Expression (Expression (Decl)) - or else - Nkind (Expression (Decl)) = N_Null))) - then - Error_Msg_NE - ("Thread_Local_Storage variable& is " - & "improperly initialized", Decl, E); - Error_Msg_NE - ("\only allowed initialization is explicit " - & "NULL or static expression", Decl, E); - end if; - end; - end if; - - -- For imported objects, set Is_Public unless there is also an - -- address clause, which means that there is no external symbol - -- needed for the Import (Is_Public may still be set for other - -- unrelated reasons). Note that we delayed this processing - -- till freeze time so that we can be sure not to set the flag - -- if there is an address clause. If there is such a clause, - -- then the only purpose of the Import pragma is to suppress - -- implicit initialization. - - if Is_Imported (E) and then No (Address_Clause (E)) then - Set_Is_Public (E); - end if; - - -- For source objects that are not Imported and are library - -- level, if no linker section pragma was given inherit the - -- appropriate linker section from the corresponding type. - - if Comes_From_Source (E) - and then not Is_Imported (E) - and then Is_Library_Level_Entity (E) - and then No (Linker_Section_Pragma (E)) - then - Set_Linker_Section_Pragma - (E, Linker_Section_Pragma (Etype (E))); - end if; - - -- For convention C objects of an enumeration type, warn if - -- the size is not integer size and no explicit size given. - -- Skip warning for Boolean, and Character, assume programmer - -- expects 8-bit sizes for these cases. - - if (Convention (E) = Convention_C - or else - Convention (E) = Convention_CPP) - and then Is_Enumeration_Type (Etype (E)) - and then not Is_Character_Type (Etype (E)) - and then not Is_Boolean_Type (Etype (E)) - and then Esize (Etype (E)) < Standard_Integer_Size - and then not Has_Size_Clause (E) - then - Error_Msg_Uint_1 := UI_From_Int (Standard_Integer_Size); - Error_Msg_N - ("??convention C enumeration object has size less than ^", - E); - Error_Msg_N ("\??use explicit size clause to set size", E); - end if; + Freeze_Object_Declaration (E); end if; -- Check that a constant which has a pragma Volatile[_Components]