[multiple changes]

2017-05-02  Eric Botcazou  <ebotcazou@adacore.com>

	* atree.h (Flag290): Add missing terminating parenthesis.
	* einfo.adb (Is_Class_Wide_Clone): Use Flag290.
	(Set_Is_Class_Wide_Clone): Likewise.
	* einfo.ads (Is_Class_Wide_Clone): Likewise.

2017-05-02  Gary Dismukes  <dismukes@adacore.com>

	* checks.ads (Null_Exclusion_Static_Checks): Add Boolean
	parameter Array_Comp to indicate the case of an array object
	with null-excluding components.
	* checks.adb (Null_Exclusion_Static_Checks):
	Call Compile_Time_Constraint_Error instead of
	Apply_Compile_Time_Constraint_Error in the component case. Also
	call that when Array_Comp is True, with an appropriate warning for
	the array component case. Only create an explicit initialization
	by null in the case of an object of a null-excluding access type
	(and no longer do that in the component case).
	* sem_ch3.adb (Check_Component): Add a Boolean parameter
	Array_Comp defaulted to False.	Pass Empty for the Comp
	actual when calling Null_Exclusion_Static_Checks in the case
	where Comp_Decl matches Object_Decl, because we don't have a
	component in that case. In the case of an object or component
	of an array type, pass True for Array_Comp on the recursive call
	to Check_Component.

From-SVN: r247474

7 files changed, 89 insertions, 34 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 0d53e03..499d696 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,30 @@
+2017-05-02  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* atree.h (Flag290): Add missing terminating parenthesis.
+	* einfo.adb (Is_Class_Wide_Clone): Use Flag290.
+	(Set_Is_Class_Wide_Clone): Likewise.
+	* einfo.ads (Is_Class_Wide_Clone): Likewise.
+
+2017-05-02  Gary Dismukes  <dismukes@adacore.com>
+
+	* checks.ads (Null_Exclusion_Static_Checks): Add Boolean
+	parameter Array_Comp to indicate the case of an array object
+	with null-excluding components.
+	* checks.adb (Null_Exclusion_Static_Checks):
+	Call Compile_Time_Constraint_Error instead of
+	Apply_Compile_Time_Constraint_Error in the component case. Also
+	call that when Array_Comp is True, with an appropriate warning for
+	the array component case. Only create an explicit initialization
+	by null in the case of an object of a null-excluding access type
+	(and no longer do that in the component case).
+	* sem_ch3.adb (Check_Component): Add a Boolean parameter
+	Array_Comp defaulted to False.	Pass Empty for the Comp
+	actual when calling Null_Exclusion_Static_Checks in the case
+	where Comp_Decl matches Object_Decl, because we don't have a
+	component in that case. In the case of an object or component
+	of an array type, pass True for Array_Comp on the recursive call
+	to Check_Component.
+
 2017-05-02  Bob Duff  <duff@adacore.com>
 
 	* s-taprop-linux.adb (Prio_To_Linux_Prio): New function to correctly
diff --git a/gcc/ada/atree.h b/gcc/ada/atree.h
index bad0765..7a38883 100644
--- a/gcc/ada/atree.h
+++ b/gcc/ada/atree.h
@@ -6,7 +6,7 @@
  *                                                                          *
  *                              C Header File                               *
  *                                                                          *
- *          Copyright (C) 1992-2016, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2017, 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- *
@@ -869,7 +869,7 @@ extern Node_Id Current_Error_Node;
 #define Flag287(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.in_list)
 #define Flag288(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.has_aspects)
 #define Flag289(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.rewrite_ins)
-#define Flag290(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.analyzed
+#define Flag290(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.analyzed)
 #define Flag291(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.c_f_s)
 #define Flag292(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.error_posted)
 #define Flag293(N)     (Nodes_Ptr[(N) - First_Node_Id + 5].U.K.flag4)
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index e8f38f9..d4a3aa4 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -4043,8 +4043,9 @@ package body Checks is
    ----------------------------------
 
    procedure Null_Exclusion_Static_Checks
-     (N    : Node_Id;
-      Comp : Node_Id := Empty)
+     (N          : Node_Id;
+      Comp       : Node_Id := Empty;
+      Array_Comp : Boolean := False)
    is
       Error_Node : Node_Id;
       Expr       : Node_Id;
@@ -4120,13 +4121,6 @@ package body Checks is
         and then not Constant_Present (N)
         and then not No_Initialization (N)
       then
-         --  Add an expression that assigns null. This node is needed by
-         --  Apply_Compile_Time_Constraint_Error, which will replace this with
-         --  a Constraint_Error node.
-
-         Set_Expression (N, Make_Null (Sloc (N)));
-         Set_Etype (Expression (N), Etype (Defining_Identifier (N)));
-
          if Present (Comp) then
 
             --  Specialize the warning message to indicate that we are dealing
@@ -4136,14 +4130,36 @@ package body Checks is
             Error_Msg_Name_1 := Chars (Defining_Identifier (Comp));
             Error_Msg_Name_2 := Chars (Defining_Identifier (N));
 
-            Apply_Compile_Time_Constraint_Error
-              (N      => Expression (N),
-               Msg    =>
-                 "(Ada 2005) null-excluding component % of object % must be "
-                 & "initialized??",
-               Reason => CE_Null_Not_Allowed);
+            Discard_Node
+              (Compile_Time_Constraint_Error
+                 (N      => N,
+                  Msg    =>
+                    "(Ada 2005) null-excluding component % of object % must "
+                    & "be initialized??",
+                  Ent => Defining_Identifier (Comp)));
+
+         --  This is a case of an array with null-excluding components, so
+         --  indicate that in the warning.
+
+         elsif Array_Comp then
+            Discard_Node
+              (Compile_Time_Constraint_Error
+                 (N      => N,
+                  Msg    =>
+                    "(Ada 2005) null-excluding array components must "
+                    & "be initialized??",
+                  Ent => Defining_Identifier (N)));
+
+         --  Normal case of object of a null-excluding access type
 
          else
+            --  Add an expression that assigns null. This node is needed by
+            --  Apply_Compile_Time_Constraint_Error, which will replace this
+            --  with a Constraint_Error node.
+
+            Set_Expression (N, Make_Null (Sloc (N)));
+            Set_Etype (Expression (N), Etype (Defining_Identifier (N)));
+
             Apply_Compile_Time_Constraint_Error
               (N      => Expression (N),
                Msg    =>
diff --git a/gcc/ada/checks.ads b/gcc/ada/checks.ads
index 218bdca..159cdba 100644
--- a/gcc/ada/checks.ads
+++ b/gcc/ada/checks.ads
@@ -916,13 +916,17 @@ package Checks is
    --  see the warning in the body of Sem_Ch3.Process_Range_Expr_In_Decl.
 
    procedure Null_Exclusion_Static_Checks
-     (N    : Node_Id;
-      Comp : Node_Id := Empty);
-   --  Ada 2005 (AI-231): Check bad usages of the null-exclusion issue
+     (N          : Node_Id;
+      Comp       : Node_Id := Empty;
+      Array_Comp : Boolean := False);
+   --  Ada 2005 (AI-231): Test for and warn on null-excluding objects or
+   --  components that will raise an exception due to initialization by null.
    --
    --  When a value for Comp is supplied (as in the case of an uninitialized
    --  null-excluding component within a composite object), a reported warning
    --  will indicate the offending component instead of the object itself.
+   --  Array_Comp being True indicates an array object with null-excluding
+   --  components, and any reported warning will indicate that.
 
    procedure Remove_Checks (Expr : Node_Id);
    --  Remove all checks from Expr except those that are only executed
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index bfe96e5..76ab625 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -603,8 +603,7 @@ package body Einfo is
    --    Rewritten_For_C                 Flag287
    --    Predicates_Ignored              Flag288
    --    Has_Timing_Event                Flag289
-
-   --    (unused)                        Flag290  --  ??? flag breaks einfo.h
+   --    Is_Class_Wide_Clone             Flag290
 
    --    Has_Inherited_Invariants        Flag291
    --    Is_Partial_Invariant_Procedure  Flag292
@@ -615,10 +614,10 @@ package body Einfo is
    --    Is_Entry_Wrapper                Flag297
    --    Is_Underlying_Full_View         Flag298
    --    Body_Needed_For_Inlining        Flag299
-
    --    Has_Private_Extension           Flag300
+
    --    Ignore_SPARK_Mode_Pragmas       Flag301
-   --    Is_Class_Wide_Clone             Flag302
+   --    (unused)                        Flag302
    --    (unused)                        Flag303
    --    (unused)                        Flag304
    --    (unused)                        Flag305
@@ -2134,7 +2133,7 @@ package body Einfo is
 
    function Is_Class_Wide_Clone (Id : E) return B is
    begin
-      return Flag302 (Id);
+      return Flag290 (Id);
    end Is_Class_Wide_Clone;
 
    function Is_Class_Wide_Equivalent_Type (Id : E) return B is
@@ -5258,7 +5257,7 @@ package body Einfo is
 
    procedure Set_Is_Class_Wide_Clone (Id : E; V : B := True) is
    begin
-      Set_Flag302 (Id, V);
+      Set_Flag290 (Id, V);
    end Set_Is_Class_Wide_Clone;
 
    procedure Set_Is_Class_Wide_Equivalent_Type (Id : E; V : B := True) is
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 61694bf..f2b9d93 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -2356,7 +2356,7 @@ package Einfo is
 --       Defined in all entities. Set only for defining entities of program
 --       units that are child units (but False for subunits).
 
---    Is_Class_Wide_Clone (Flag302)
+--    Is_Class_Wide_Clone (Flag290)
 --       Defined on subprogram entities. Set for subprograms built in order
 --       to implement properly the inheritance of class-wide pre- or post-
 --       conditions when the condition contains calls to other primitives
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index e92a954..f55e7d4 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -3648,7 +3648,9 @@ package body Sem_Ch3 is
          then
             Comp := First_Component (Obj_Type);
             while Present (Comp) loop
-               if Known_Static_Esize (Etype (Comp)) then
+               if Known_Static_Esize (Etype (Comp))
+                 or else Size_Known_At_Compile_Time (Etype (Comp))
+               then
                   null;
 
                elsif not Discriminated_Size (Comp)
@@ -3674,8 +3676,9 @@ package body Sem_Ch3 is
          Obj_Decl : Node_Id)
       is
          procedure Check_Component
-           (Comp_Typ  : Entity_Id;
-            Comp_Decl : Node_Id := Empty);
+           (Comp_Typ   : Entity_Id;
+            Comp_Decl  : Node_Id := Empty;
+            Array_Comp : Boolean := False);
          --  Apply a compile-time null-exclusion check on a component denoted
          --  by its declaration Comp_Decl and type Comp_Typ, and all of its
          --  subcomponents (if any).
@@ -3686,7 +3689,8 @@ package body Sem_Ch3 is
 
          procedure Check_Component
            (Comp_Typ  : Entity_Id;
-            Comp_Decl : Node_Id := Empty)
+            Comp_Decl : Node_Id := Empty;
+            Array_Comp : Boolean := False)
          is
             Comp : Entity_Id;
             T    : Entity_Id;
@@ -3715,7 +3719,12 @@ package body Sem_Ch3 is
             if Is_Access_Type (T)
               and then Can_Never_Be_Null (T)
             then
-               Null_Exclusion_Static_Checks (Obj_Decl, Comp_Decl);
+               if Comp_Decl = Obj_Decl then
+                  Null_Exclusion_Static_Checks (Obj_Decl, Empty, Array_Comp);
+               else
+                  Null_Exclusion_Static_Checks
+                    (Obj_Decl, Comp_Decl, Array_Comp);
+               end if;
 
             --  Check array components
 
@@ -3724,10 +3733,10 @@ package body Sem_Ch3 is
                --  There is no suitable component when the object is of an
                --  array type. However, a namable component may appear at some
                --  point during the recursive inspection, but not at the top
-               --  level.
+               --  level. At the top level just indicate array component case.
 
                if Comp_Decl = Obj_Decl then
-                  Check_Component (Component_Type (T));
+                  Check_Component (Component_Type (T), Array_Comp => True);
                else
                   Check_Component (Component_Type (T), Comp_Decl);
                end if;