diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 15 | ||||
| -rw-r--r-- | gcc/ada/freeze.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/gnat_ugn.texi | 5 | ||||
| -rw-r--r-- | gcc/ada/sem_aggr.adb | 47 |
4 files changed, 62 insertions, 14 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5ca6f568e16..7b9017ad5f5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,18 @@ +2014-08-04 Robert Dewar <dewar@adacore.com> + + * gnat_ugn.texi: Clarify documentation on assertions. + +2014-08-04 Ed Schonberg <schonberg@adacore.com> + + * sem_aggr.adb (Resolve_Record_Aggregate, Get_Value): Warn + if a component association has a box initialization when the + component type has no default initialization, either through an + initial value, an aspect, or an implicit initialization procedure. + +2014-08-04 Ed Schonberg <schonberg@adacore.com> + + * freeze.adb: Code clean up. + 2014-08-04 Thomas Quinot <quinot@adacore.com> * sem_ch5.adb: Minor reformatting. diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 677fb42259b..870cdc2a198 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -4018,7 +4018,7 @@ package body Freeze is while Present (Formal) loop F_Type := Etype (Formal); - -- AI05-0151 : incomplete types can appear in a profile. + -- AI05-0151: incomplete types can appear in a profile. -- By the time the entity is frozen, the full view must -- be available, unless it is a limited view. @@ -4204,9 +4204,10 @@ package body Freeze is Get_Source_Unit (E) /= Get_Source_Unit (N) and then Expander_Active and then Ekind (Scope (E)) = E_Package - and then Nkind (Unit_Declaration_Node (Scope (E))) - = N_Package_Declaration - and then not In_Open_Scopes (Scope (E)); + and then Nkind (Unit_Declaration_Node (Scope (E))) = + N_Package_Declaration + and then not In_Open_Scopes (Scope (E)) + and then Get_Source_Unit (E) /= Current_Sem_Unit; -- Freeze return type diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 5293eab3050..913330d7370 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -3604,7 +3604,10 @@ using the configuration pragma @code{Check_Policy}. In Ada 2012, it also activates all assertions defined in the RM as aspects: preconditions, postconditions, type invariants and (sub)type predicates. In all Ada modes, corresponding pragmas for type invariants and (sub)type predicates are -also activated. +also activated. The default is that all these assertions are disabled, +and have no effect, other than being checked for syntactic validity, and +in the case of subtype predicates, constructions such as membership tests +still test predicates even if assertions are turned off. @item -gnatA @cindex @option{-gnatA} (@command{gcc}) diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index 56c4fad0348..654f413c088 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -23,6 +23,7 @@ -- -- ------------------------------------------------------------------------------ +with Aspects; use Aspects; with Atree; use Atree; with Checks; use Checks; with Einfo; use Einfo; @@ -3168,6 +3169,7 @@ package body Sem_Aggr is Consider_Others_Choice : Boolean := False) return Node_Id is + Typ : constant Entity_Id := Etype (Compon); Assoc : Node_Id; Expr : Node_Id := Empty; Selector_Name : Node_Id; @@ -3215,15 +3217,15 @@ package body Sem_Aggr is end if; else - if Present (Others_Etype) and then - Base_Type (Others_Etype) /= Base_Type (Etype - (Compon)) + if Present (Others_Etype) + and then Base_Type (Others_Etype) /= Base_Type (Typ) then - Error_Msg_N ("components in OTHERS choice must " & - "have same type", Selector_Name); + Error_Msg_N + ("components in OTHERS choice must " + & "have same type", Selector_Name); end if; - Others_Etype := Etype (Compon); + Others_Etype := Typ; if Expander_Active then return @@ -3269,15 +3271,42 @@ package body Sem_Aggr is -- initialized, but an association for the component -- exists, and it is not covered by an others clause. + -- Scalar and private types have no initialization + -- procedure, so they remain uninitialized. If the + -- target of the aggregate is a constant this + -- deserves a warning. + + if No (Expression (Parent (Compon))) + and then not Has_Non_Null_Base_Init_Proc (Typ) + and then not Has_Aspect (Typ, Aspect_Default_Value) + and then not Is_Concurrent_Type (Typ) + and then Nkind (Parent (N)) = N_Object_Declaration + and then Constant_Present (Parent (N)) + then + Error_Msg_Node_2 := Typ; + Error_Msg_NE + ("component&? of type& is uninitialized", + Assoc, Selector_Name); + + -- An additional reminder if the component type + -- is a generic formal. + + if Is_Generic_Type (Base_Type (Typ)) then + Error_Msg_NE + ("\instance should provide actual " + & "type with initialization for&", + Assoc, Typ); + end if; + end if; + return New_Copy_Tree_And_Copy_Dimensions (Expression (Parent (Compon))); else if Present (Next (Selector_Name)) then - Expr := - New_Copy_Tree_And_Copy_Dimensions - (Expression (Assoc)); + Expr := New_Copy_Tree_And_Copy_Dimensions + (Expression (Assoc)); else Expr := Expression (Assoc); end if; |