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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@213563 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5ca6f56..7b9017a 100644 (file)
--- 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 677fb42..870cdc2 100644 (file)
--- 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 5293eab..913330d 100644 (file)
--- 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 56c4fad..654f413 100644 (file)
--- 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;