[multiple changes]

2017-05-02  Hristian Kirtchev  <kirtchev@adacore.com>

	* checks.adb, sem_ch3.adb, sem_ch6.adb: Minor reformatting.

2017-05-02  Bob Duff  <duff@adacore.com>

	* exp_attr.adb (Callable, Identity, Terminated): Use Find_Prim_Op
	to find primitive ops, instead of using an Identifier that will
	later be looked up. This is necessary because these ops are not
	necessarily visible at all places where we need to call them.
	* exp_util.ads: Minor comment fix.

From-SVN: r247466

6 files changed, 104 insertions, 79 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5ef8c6d..59ee6e5 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,15 @@
+2017-05-02  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* checks.adb, sem_ch3.adb, sem_ch6.adb: Minor reformatting.
+
+2017-05-02  Bob Duff  <duff@adacore.com>
+
+	* exp_attr.adb (Callable, Identity, Terminated): Use Find_Prim_Op
+	to find primitive ops, instead of using an Identifier that will
+	later be looked up. This is necessary because these ops are not
+	necessarily visible at all places where we need to call them.
+	* exp_util.ads: Minor comment fix.
+
 2017-05-02  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_ch6.adb (Fully_Conformant_Expressions): Two entity
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index a5a57c4..40f4e65 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -4124,7 +4124,7 @@ package body Checks is
 
          if Present (Comp) then
 
-            --  Specialize the error message to indicate that we are dealing
+            --  Specialize the warning message to indicate that we are dealing
             --  with an uninitialized composite object that has a defaulted
             --  null-excluding component.
 
@@ -4133,9 +4133,11 @@ package body Checks is
 
             Apply_Compile_Time_Constraint_Error
               (N      => Expression (N),
-               Msg    => "(Ada 2005) null-excluding component % of object % " &
-                           "must be initialized??",
+               Msg    =>
+                 "(Ada 2005) null-excluding component % of object % must be "
+                 & "initialized??",
                Reason => CE_Null_Not_Allowed);
+
          else
             Apply_Compile_Time_Constraint_Error
               (N      => Expression (N),
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index b81e26c..4d8417a 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -1028,7 +1028,7 @@ package body Exp_Attr is
       Loc       : Source_Ptr;
       Loop_Id   : Entity_Id;
       Loop_Stmt : Node_Id;
-      Result    : Node_Id;
+      Result    : Node_Id := Empty;
       Scheme    : Node_Id;
       Temp_Decl : Node_Id;
       Temp_Id   : Entity_Id;
@@ -1093,8 +1093,6 @@ package body Exp_Attr is
             Decls := Declarations (Parent (Parent (Loop_Stmt)));
          end if;
 
-         Result := Empty;
-
       --  Transform the loop into a conditional block
 
       else
@@ -2480,20 +2478,25 @@ package body Exp_Attr is
            and then Is_Interface (Ptyp)
            and then Is_Task_Interface (Ptyp)
          then
-            Rewrite (N,
-              Make_Function_Call (Loc,
-                Name                   =>
-                  New_Occurrence_Of (RTE (RE_Callable), Loc),
-                Parameter_Associations => New_List (
-                  Make_Unchecked_Type_Conversion (Loc,
-                    Subtype_Mark =>
-                      New_Occurrence_Of (RTE (RO_ST_Task_Id), Loc),
-                    Expression   =>
-                      Make_Selected_Component (Loc,
-                        Prefix        =>
-                          New_Copy_Tree (Pref),
-                        Selector_Name =>
-                          Make_Identifier (Loc, Name_uDisp_Get_Task_Id))))));
+            declare
+               Id : constant Node_Id :=
+                 New_Occurrence_Of
+                   (Find_Prim_Op (Ptyp, Name_uDisp_Get_Task_Id), Loc);
+               Call : constant Node_Id :=
+                 Make_Function_Call (Loc,
+                   Name => Id,
+                   Parameter_Associations => New_List (Pref));
+            begin
+               Rewrite (N,
+                 Make_Function_Call (Loc,
+                   Name =>
+                     New_Occurrence_Of (RTE (RE_Callable), Loc),
+                   Parameter_Associations => New_List (
+                     Make_Unchecked_Type_Conversion (Loc,
+                       Subtype_Mark =>
+                         New_Occurrence_Of (RTE (RO_ST_Task_Id), Loc),
+                       Expression => Call))));
+            end;
 
          else
             Rewrite (N,
@@ -3578,13 +3581,17 @@ package body Exp_Attr is
               and then Is_Interface (Ptyp)
               and then Is_Task_Interface (Ptyp)
             then
-               Rewrite (N,
-                 Unchecked_Convert_To (Id_Kind,
-                   Make_Selected_Component (Loc,
-                     Prefix =>
-                       New_Copy_Tree (Pref),
-                     Selector_Name =>
-                       Make_Identifier (Loc, Name_uDisp_Get_Task_Id))));
+               declare
+                  Id : constant Node_Id :=
+                    New_Occurrence_Of
+                      (Find_Prim_Op (Ptyp, Name_uDisp_Get_Task_Id), Loc);
+                  Call : constant Node_Id :=
+                    Make_Function_Call (Loc,
+                      Name => Id,
+                      Parameter_Associations => New_List (Pref));
+               begin
+                  Rewrite (N, Unchecked_Convert_To (Id_Kind, Call));
+               end;
 
             else
                Rewrite (N,
@@ -6264,27 +6271,32 @@ package body Exp_Attr is
 
          --  The prefix of Terminated is of a task interface class-wide type.
          --  Generate:
-         --    terminated (Task_Id (Pref._disp_get_task_id));
+         --    terminated (Task_Id (_disp_get_task_id (Pref)));
 
          if Ada_Version >= Ada_2005
            and then Ekind (Ptyp) = E_Class_Wide_Type
            and then Is_Interface (Ptyp)
            and then Is_Task_Interface (Ptyp)
          then
-            Rewrite (N,
-              Make_Function_Call (Loc,
-                Name =>
-                  New_Occurrence_Of (RTE (RE_Terminated), Loc),
-                Parameter_Associations => New_List (
-                  Make_Unchecked_Type_Conversion (Loc,
-                    Subtype_Mark =>
-                      New_Occurrence_Of (RTE (RO_ST_Task_Id), Loc),
-                    Expression =>
-                      Make_Selected_Component (Loc,
-                        Prefix =>
-                          New_Copy_Tree (Pref),
-                        Selector_Name =>
-                          Make_Identifier (Loc, Name_uDisp_Get_Task_Id))))));
+            declare
+               Id : constant Node_Id :=
+                 New_Occurrence_Of
+                   (Find_Prim_Op (Ptyp, Name_uDisp_Get_Task_Id), Loc);
+               Call : constant Node_Id :=
+                 Make_Function_Call (Loc,
+                   Name => Id,
+                   Parameter_Associations => New_List (Pref));
+            begin
+               Rewrite (N,
+                 Make_Function_Call (Loc,
+                   Name =>
+                     New_Occurrence_Of (RTE (RE_Terminated), Loc),
+                   Parameter_Associations => New_List (
+                     Make_Unchecked_Type_Conversion (Loc,
+                       Subtype_Mark =>
+                         New_Occurrence_Of (RTE (RO_ST_Task_Id), Loc),
+                       Expression => Call))));
+            end;
 
          elsif Restricted_Profile then
             Rewrite (N,
diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads
index 3f60993..485374b 100644
--- a/gcc/ada/exp_util.ads
+++ b/gcc/ada/exp_util.ads
@@ -592,11 +592,9 @@ package Exp_Util is
    function Find_Prim_Op
      (T    : Entity_Id;
       Name : TSS_Name_Type) return Entity_Id;
-   --  Find the first primitive operation of type T whose name has the form
-   --  indicated by the name parameter (i.e. is a type support subprogram
-   --  with the indicated suffix). This function allows use of a primitive
-   --  operation which is not directly visible. If T is a class wide type,
-   --  then the reference is to an operation of the corresponding root type.
+   --  Same as Find_Prim_Op above, except we're searching for an op that has
+   --  the form indicated by Name (i.e. is a type support subprogram with the
+   --  indicated suffix).
 
    function Find_Optional_Prim_Op
      (T : Entity_Id; Name : Name_Id) return Entity_Id;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 24560159..9ad370f 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -3583,17 +3583,17 @@ package body Sem_Ch3 is
       T     : Entity_Id;
 
       E : Node_Id := Expression (N);
-      --  E is set to Expression (N) throughout this routine. When
-      --  Expression (N) is modified, E is changed accordingly.
+      --  E is set to Expression (N) throughout this routine. When Expression
+      --  (N) is modified, E is changed accordingly.
 
       Prev_Entity : Entity_Id := Empty;
 
       procedure Check_For_Null_Excluding_Components
         (Obj_Typ  : Entity_Id;
          Obj_Decl : Node_Id);
-      --  Recursively verify that each null-excluding component of an object
-      --  declaration's type has explicit initialization, and generate
-      --  compile-time warnings for each one that does not.
+      --  Verify that each null-excluding component of object declaration
+      --  Obj_Decl carrying type Obj_Typ has explicit initialization. Emit
+      --  a compile-time warning if this is not the case.
 
       function Count_Tasks (T : Entity_Id) return Uint;
       --  This function is called when a non-generic library level object of a
@@ -3622,12 +3622,12 @@ package body Sem_Ch3 is
         (Obj_Typ  : Entity_Id;
          Obj_Decl : Node_Id)
       is
-
          procedure Check_Component
            (Comp_Typ  : Entity_Id;
             Comp_Decl : Node_Id := Empty);
-         --  Perform compile-time null-exclusion checks on a given component
-         --  and all of its subcomponents, if any.
+         --  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).
 
          ---------------------
          -- Check_Component --
@@ -3641,15 +3641,14 @@ package body Sem_Ch3 is
             T    : Entity_Id;
 
          begin
-            --  Return without further checking if the component has explicit
-            --  initialization or does not come from source.
+            --  Do not consider internally-generated components or those that
+            --  are already initialized.
 
-            if Present (Comp_Decl) then
-               if not Comes_From_Source (Comp_Decl)
-                 or else Present (Expression (Comp_Decl))
-               then
-                  return;
-               end if;
+            if Present (Comp_Decl)
+              and then (not Comes_From_Source (Comp_Decl)
+                         or else Present (Expression (Comp_Decl)))
+            then
+               return;
             end if;
 
             if Is_Incomplete_Or_Private_Type (Comp_Typ)
@@ -3667,9 +3666,10 @@ package body Sem_Ch3 is
             then
                Null_Exclusion_Static_Checks (Obj_Decl, Comp_Decl);
 
-            --  Check array type components
+            --  Check array components
 
             elsif Is_Array_Type (T) then
+
                --  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
@@ -3681,12 +3681,10 @@ package body Sem_Ch3 is
                   Check_Component (Component_Type (T), Comp_Decl);
                end if;
 
-            --  If T allows named components, then iterate through them,
-            --  recursively verifying all subcomponents.
+            --  Verify all components of type T
 
-            --  NOTE: Due to the complexities involved with checking components
-            --  of nontrivial types with discriminants (variant records and
-            --  the like), no static checking is performed on them. ???
+            --  Note: No checks are performed on types with discriminants due
+            --  to complexities involving variants. ???
 
             elsif (Is_Concurrent_Type (T)
                     or else Is_Incomplete_Or_Private_Type (T)
@@ -3910,12 +3908,12 @@ package body Sem_Ch3 is
       --  out some static checks.
 
       if Ada_Version >= Ada_2005 then
+
          --  In case of aggregates we must also take care of the correct
          --  initialization of nested aggregates bug this is done at the
          --  point of the analysis of the aggregate (see sem_aggr.adb) ???
 
          if Can_Never_Be_Null (T) then
-
             if Present (Expression (N))
               and then Nkind (Expression (N)) = N_Aggregate
             then
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 98c893b..5c31c42 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -8763,18 +8763,20 @@ package body Sem_Ch6 is
          if Present (Entity (E1)) then
             return Entity (E1) = Entity (E2)
 
-              --  One may be a discriminant that has been replaced by
-              --  the corresponding discriminal.
+              --  One may be a discriminant that has been replaced by the
+              --  corresponding discriminal.
 
-              or else (Chars (Entity (E1)) = Chars (Entity (E2))
-                        and then Ekind (Entity (E1)) = E_Discriminant
-                        and then Ekind (Entity (E2)) = E_In_Parameter)
+              or else
+                (Chars (Entity (E1)) = Chars (Entity (E2))
+                  and then Ekind (Entity (E1)) = E_Discriminant
+                  and then Ekind (Entity (E2)) = E_In_Parameter)
 
              --  The discriminant of a protected type is transformed into
              --  a local constant and then into a parameter of a protected
              --  operation.
 
-             or else (Ekind (Entity (E1)) = E_Constant
+             or else
+               (Ekind (Entity (E1)) = E_Constant
                  and then Ekind (Entity (E2)) = E_In_Parameter
                  and then Present (Discriminal_Link (Entity (E1)))
                  and then Discriminal_Link (Entity (E1)) =
@@ -8784,9 +8786,10 @@ package body Sem_Ch6 is
              --  match if they have the same identifier, even though they
              --  are different entities.
 
-              or else (Chars (Entity (E1)) = Chars (Entity (E2))
-                       and then Ekind (Entity (E1)) = E_Loop_Parameter
-                       and then Ekind (Entity (E2)) = E_Loop_Parameter);
+              or else
+                (Chars (Entity (E1)) = Chars (Entity (E2))
+                  and then Ekind (Entity (E1)) = E_Loop_Parameter
+                  and then Ekind (Entity (E2)) = E_Loop_Parameter);
 
          elsif Nkind (E1) = N_Expanded_Name
            and then Nkind (E2) = N_Expanded_Name