[multiple changes]

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

	* sem_ch3.adb, exp_ch9.adb, einfo.adb, sem_ch4.adb, sem_ch6.adb: Minor
	reformatting.

2016-05-02  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch4.adb (Expand_N_Allocator): If the designated type
	is a private derived type with no discriminants, examine its
	underlying_full_view to determine whether the full view has
	defaulted discriminants, so their defaults can be used in the
	call to the initialization procedure for the designated object.

From-SVN: r235740

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 8acbbb3ec325d4e6f72412a7bdde669cdd41c34e..51ba99854e9ddacd5ad664e5dc4db8a654aa381f 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,16 @@
+2016-05-02  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * sem_ch3.adb, exp_ch9.adb, einfo.adb, sem_ch4.adb, sem_ch6.adb: Minor
+       reformatting.
+
+2016-05-02  Ed Schonberg  <schonberg@adacore.com>
+
+       * exp_ch4.adb (Expand_N_Allocator): If the designated type
+       is a private derived type with no discriminants, examine its
+       underlying_full_view to determine whether the full view has
+       defaulted discriminants, so their defaults can be used in the
+       call to the initialization procedure for the designated object.
+
 2016-05-02  Hristian Kirtchev  <kirtchev@adacore.com>
 
        * exp_prag.adb, comperr.adb: Minor reformatting.

diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index e66ca79aa7ce1a209631306d85ab10d0f245278b..c6a0935b3e66e724f8ee6d3ab42c7fa3f36f9b4f 100644 (file)
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -5908,7 +5908,7 @@ package body Einfo is
 
    procedure Set_Original_Protected_Subprogram (Id : E; V : N) is
    begin
-      pragma Assert (Ekind_In (Id, E_Procedure, E_Function));
+      pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
       Set_Node41 (Id, V);
    end Set_Original_Protected_Subprogram;
 

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index ea59e6e73b49bc100316a97a472d837392fb415f..cb1c117b30bc8a2ba522207a36c9e30acca35c6d 100644 (file)
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -4503,12 +4503,25 @@ package body Exp_Ch4 is
                      Dis := True;
                      Typ := T;
 
-                  elsif Is_Private_Type (T)
-                    and then Present (Full_View (T))
-                    and then Has_Discriminants (Full_View (T))
-                  then
-                     Dis := True;
-                     Typ := Full_View (T);
+                  --  Type may be a private type with no visible discriminants
+                  --  in which case check full view if in scope, or the
+                  --  underlying_full_view if dealing with a type whose full
+                  --  view may be derived from a private type whose own full
+                  --  view has discriminants.
+
+                  elsif Is_Private_Type (T) then
+                     if Present (Full_View (T))
+                       and then Has_Discriminants (Full_View (T))
+                     then
+                        Dis := True;
+                        Typ := Full_View (T);
+
+                     elsif Present (Underlying_Full_View (T))
+                       and then Has_Discriminants (Underlying_Full_View (T))
+                     then
+                        Dis := True;
+                        Typ := Underlying_Full_View (T);
+                     end if;
                   end if;
 
                   if Dis then

diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index e48b983906460331f832d37038f05cc8ed8a35f2..68c6dcb957531fadf3e659867aeff04014b2f586 100644 (file)
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -2558,9 +2558,9 @@ package body Exp_Ch9 is
          end if;
 
          return
-           Type_Conformant_Parameters (
-             Parameter_Specifications (Iface_Op_Spec),
-             Parameter_Specifications (Wrapper_Spec));
+           Type_Conformant_Parameters
+             (Parameter_Specifications (Iface_Op_Spec),
+              Parameter_Specifications (Wrapper_Spec));
       end Overriding_Possible;
 
       -----------------------
@@ -2609,14 +2609,13 @@ package body Exp_Ch9 is
 
             Append_To (New_Formals,
               Make_Parameter_Specification (Loc,
-                Defining_Identifier =>
+                Defining_Identifier    =>
                   Make_Defining_Identifier (Loc,
-                    Chars                  => Chars
-                                             (Defining_Identifier (Formal))),
-                    In_Present             => In_Present  (Formal),
-                    Out_Present            => Out_Present (Formal),
-                    Null_Exclusion_Present => Null_Exclusion_Present (Formal),
-                    Parameter_Type         => Param_Type));
+                    Chars => Chars (Defining_Identifier (Formal))),
+                In_Present             => In_Present  (Formal),
+                Out_Present            => Out_Present (Formal),
+                Null_Exclusion_Present => Null_Exclusion_Present (Formal),
+                Parameter_Type         => Param_Type));
 
             Next (Formal);
          end loop;
@@ -2776,13 +2775,16 @@ package body Exp_Ch9 is
 
          else
             pragma Assert (Is_Private_Primitive_Subprogram (Subp_Id));
+
             Obj_Param :=
               Make_Parameter_Specification (Loc,
                 Defining_Identifier =>
                   Make_Defining_Identifier (Loc, Name_uO),
-                In_Present  => In_Present (Parent (First_Entity (Subp_Id))),
-                Out_Present => Ekind (Subp_Id) /= E_Function,
-                  Parameter_Type => New_Occurrence_Of (Obj_Typ, Loc));
+                In_Present          =>
+                  In_Present (Parent (First_Entity (Subp_Id))),
+                Out_Present         => Ekind (Subp_Id) /= E_Function,
+                Parameter_Type      => New_Occurrence_Of (Obj_Typ, Loc));
+
             Prepend_To (New_Formals, Obj_Param);
          end if;
 
@@ -4195,8 +4197,7 @@ package body Exp_Ch9 is
                       Unprotected_Mode => 'N');
 
    begin
-      if Ekind (Defining_Unit_Name (Specification (N))) =
-           E_Subprogram_Body
+      if Ekind (Defining_Unit_Name (Specification (N))) = E_Subprogram_Body
       then
          Decl := Unit_Declaration_Node (Corresponding_Spec (N));
       else
@@ -4238,7 +4239,7 @@ package body Exp_Ch9 is
       if Nkind (Specification (Decl)) = N_Procedure_Specification then
          New_Spec :=
            Make_Procedure_Specification (Loc,
-             Defining_Unit_Name => New_Id,
+             Defining_Unit_Name       => New_Id,
              Parameter_Specifications => New_Plist);
 
       --  Create a new specification for the anonymous subprogram type
@@ -4246,9 +4247,9 @@ package body Exp_Ch9 is
       else
          New_Spec :=
            Make_Function_Specification (Loc,
-             Defining_Unit_Name => New_Id,
+             Defining_Unit_Name       => New_Id,
              Parameter_Specifications => New_Plist,
-             Result_Definition =>
+             Result_Definition        =>
                Copy_Result_Type (Result_Definition (Specification (Decl))));
 
          Set_Return_Present (Defining_Unit_Name (New_Spec));
@@ -9654,22 +9655,22 @@ package body Exp_Ch9 is
                 Present (Interfaces (Corresponding_Record_Type (Prot_Typ)))
             then
                declare
+                  Found     : Boolean := False;
                   Prim_Elmt : Elmt_Id;
                   Prim_Op   : Node_Id;
-                  Found     : Boolean := False;
 
                begin
                   Prim_Elmt :=
                     First_Elmt
                       (Primitive_Operations
-                         (Corresponding_Record_Type (Prot_Typ)));
+                        (Corresponding_Record_Type (Prot_Typ)));
 
                   while Present (Prim_Elmt) loop
                      Prim_Op := Node (Prim_Elmt);
 
                      if Is_Primitive_Wrapper (Prim_Op)
-                       and then (Wrapped_Entity (Prim_Op))
-                                   = Defining_Entity (Specification (Comp))
+                       and then Wrapped_Entity (Prim_Op) =
+                                  Defining_Entity (Specification (Comp))
                      then
                         Found := True;
                         exit;
@@ -9684,6 +9685,7 @@ package body Exp_Ch9 is
                          Specification =>
                            Build_Protected_Sub_Specification
                              (Comp, Prot_Typ, Dispatching_Mode));
+
                      Insert_After (Current_Node, Sub);
                      Analyze (Sub);
 
@@ -9740,19 +9742,19 @@ package body Exp_Ch9 is
                Body_Arr :=
                  Make_Object_Declaration (Loc,
                    Defining_Identifier => Body_Id,
-                   Aliased_Present => True,
-                   Object_Definition =>
+                   Aliased_Present     => True,
+                   Object_Definition   =>
                      Make_Subtype_Indication (Loc,
                        Subtype_Mark =>
                          New_Occurrence_Of
                            (RTE (RE_Protected_Entry_Body_Array), Loc),
-                       Constraint =>
+                       Constraint   =>
                          Make_Index_Or_Discriminant_Constraint (Loc,
                            Constraints => New_List (
                               Make_Range (Loc,
                                 Make_Integer_Literal (Loc, 1),
                                 Make_Integer_Literal (Loc, E_Count))))),
-                   Expression => Entries_Aggr);
+                   Expression          => Entries_Aggr);
 
             when System_Tasking_Protected_Objects_Single_Entry =>
                Body_Arr :=
@@ -9761,7 +9763,8 @@ package body Exp_Ch9 is
                    Aliased_Present     => True,
                    Object_Definition   =>
                      New_Occurrence_Of (RTE (RE_Entry_Body), Loc),
-                   Expression => Remove_Head (Expressions (Entries_Aggr)));
+                   Expression          =>
+                     Remove_Head (Expressions (Entries_Aggr)));
 
             when others =>
                raise Program_Error;

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index df0293c8525b4ba2229b413fd5e9f57afc633ac3..18ebc25ab77ca83fbe778ffb8802961bfd5ed9c4 100644 (file)
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -19828,8 +19828,8 @@ package body Sem_Ch3 is
                                    (Subp_Id => Prim,
                                     Obj_Typ => Conc_Typ,
                                     Formals =>
-                                      Parameter_Specifications (
-                                        Parent (Prim))));
+                                      Parameter_Specifications
+                                        (Parent (Prim))));
 
                            Insert_After (Curr_Nod, Wrap_Spec);
                            Curr_Nod := Wrap_Spec;

diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 73fa52199caabcc2978553bbe8a37d77a13f84ea..dd140c165cb7397e11ce9cf87375a94acacd69d8 100644 (file)
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -9022,9 +9022,10 @@ package body Sem_Ch4 is
             --  Exp_Ch9.Build_Selected_Name).
 
             elsif Is_Protected_Type (Obj_Type) then
-               return Present (Original_Protected_Subprogram (Prim_Op))
-                 and then Chars (Original_Protected_Subprogram (Prim_Op))
-                            = Chars (Subprog);
+               return
+                 Present (Original_Protected_Subprogram (Prim_Op))
+                   and then Chars (Original_Protected_Subprogram (Prim_Op)) =
+                              Chars (Subprog);
             end if;
 
             return False;

diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index d7647a3c1bfa3c50caf02a8cf15d32fbe0de89ed..244e7a1dbb82d4ac5495e83d6eaa55ffda448a44 100644 (file)
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -6491,13 +6491,6 @@ package body Sem_Ch6 is
         (Prim_Params  : List_Id;
          Iface_Params : List_Id) return Boolean
       is
-         Iface_Id     : Entity_Id;
-         Iface_Param  : Node_Id;
-         Iface_Typ    : Entity_Id;
-         Prim_Id      : Entity_Id;
-         Prim_Param   : Node_Id;
-         Prim_Typ     : Entity_Id;
-
          function Is_Implemented
            (Ifaces_List : Elist_Id;
             Iface       : Entity_Id) return Boolean;
@@ -6527,6 +6520,15 @@ package body Sem_Ch6 is
             return False;
          end Is_Implemented;
 
+         --  Local variables
+
+         Iface_Id     : Entity_Id;
+         Iface_Param  : Node_Id;
+         Iface_Typ    : Entity_Id;
+         Prim_Id      : Entity_Id;
+         Prim_Param   : Node_Id;
+         Prim_Typ     : Entity_Id;
+
       --  Start of processing for Matches_Prefixed_View_Profile
 
       begin
@@ -6539,8 +6541,8 @@ package body Sem_Ch6 is
 
          Prim_Param := First (Prim_Params);
 
-         --  The first parameter of the potentially overridden subprogram
-         --  must be an interface implemented by Prim.
+         --  The first parameter of the potentially overridden subprogram must
+         --  be an interface implemented by Prim.
 
          if not Is_Interface (Iface_Typ)
            or else not Is_Implemented (Ifaces_List, Iface_Typ)
@@ -6548,8 +6550,8 @@ package body Sem_Ch6 is
             return False;
          end if;
 
-         --  The checks on the object parameters are done, move onto the
-         --  rest of the parameters.
+         --  The checks on the object parameters are done, move onto the rest
+         --  of the parameters.
 
          if not In_Scope then
             Prim_Param := Next (Prim_Param);
@@ -6568,15 +6570,15 @@ package body Sem_Ch6 is
               and then Is_Concurrent_Type (Designated_Type (Prim_Typ))
             then
                Iface_Typ := Designated_Type (Iface_Typ);
-               Prim_Typ := Designated_Type (Prim_Typ);
+               Prim_Typ  := Designated_Type (Prim_Typ);
             end if;
 
             --  Case of multiple interface types inside a parameter profile
 
             --     (Obj_Param : in out Iface; ...; Param : Iface)
 
-            --  If the interface type is implemented, then the matching type
-            --  in the primitive should be the implementing record type.
+            --  If the interface type is implemented, then the matching type in
+            --  the primitive should be the implementing record type.
 
             if Ekind (Iface_Typ) = E_Record_Type
               and then Is_Interface (Iface_Typ)
@@ -6626,9 +6628,9 @@ package body Sem_Ch6 is
          return;
       end if;
 
-      --  Search for the concurrent declaration since it contains the list
-      --  of all implemented interfaces. In this case, the subprogram is
-      --  declared within the scope of a protected or a task type.
+      --  Search for the concurrent declaration since it contains the list of
+      --  all implemented interfaces. In this case, the subprogram is declared
+      --  within the scope of a protected or a task type.
 
       if Present (Scope (Def_Id))
         and then Is_Concurrent_Type (Scope (Def_Id))
@@ -6658,10 +6660,10 @@ package body Sem_Ch6 is
          then
             In_Scope := False;
 
-         --  This case occurs when the concurrent type is declared within
-         --  a generic unit. As a result the corresponding record has been
-         --  built and used as the type of the first formal, we just have
-         --  to retrieve the corresponding concurrent type.
+         --  This case occurs when the concurrent type is declared within a
+         --  generic unit. As a result the corresponding record has been built
+         --  and used as the type of the first formal, we just have to retrieve
+         --  the corresponding concurrent type.
 
          elsif Is_Concurrent_Record_Type (Typ)
            and then not Is_Class_Wide_Type (Typ)
@@ -6693,9 +6695,8 @@ package body Sem_Ch6 is
          Subp      : Entity_Id := Empty;
 
       begin
-         --  Traverse the homonym chain, looking for a potentially
-         --  overridden subprogram that belongs to an implemented
-         --  interface.
+         --  Traverse the homonym chain, looking for a potentially overridden
+         --  subprogram that belongs to an implemented interface.
 
          Hom := Current_Entity_In_Scope (Def_Id);
          while Present (Hom) loop
@@ -6710,11 +6711,10 @@ package body Sem_Ch6 is
             then
                null;
 
-            --  Entries and procedures can override abstract or null
-            --  interface procedures.
+            --  Entries and procedures can override abstract or null interface
+            --  procedures.
 
-            elsif (Ekind (Def_Id) = E_Procedure
-                    or else Ekind (Def_Id) = E_Entry)
+            elsif Ekind_In (Def_Id, E_Entry, E_Procedure)
               and then Ekind (Subp) = E_Procedure
               and then Matches_Prefixed_View_Profile
                          (Parameter_Specifications (Parent (Def_Id)),
@@ -6723,17 +6723,16 @@ package body Sem_Ch6 is
                Candidate := Subp;
 
                --  For an overridden subprogram Subp, check whether the mode
-               --  of its first parameter is correct depending on the kind
-               --  of synchronized type.
+               --  of its first parameter is correct depending on the kind of
+               --  synchronized type.
 
                declare
                   Formal : constant Node_Id := First_Formal (Candidate);
 
                begin
                   --  In order for an entry or a protected procedure to
-                  --  override, the first parameter of the overridden
-                  --  routine must be of mode "out", "in out" or
-                  --  access-to-variable.
+                  --  override, the first parameter of the overridden routine
+                  --  must be of mode "out", "in out" or access-to-variable.
 
                   if Ekind_In (Candidate, E_Entry, E_Procedure)
                     and then Is_Protected_Type (Typ)
@@ -6744,9 +6743,9 @@ package body Sem_Ch6 is
                   then
                      null;
 
-                  --  All other cases are OK since a task entry or routine
-                  --  does not have a restriction on the mode of the first
-                  --  parameter of the overridden interface routine.
+                  --  All other cases are OK since a task entry or routine does
+                  --  not have a restriction on the mode of the first parameter
+                  --  of the overridden interface routine.
 
                   else
                      Overridden_Subp := Candidate;
@@ -6768,8 +6767,8 @@ package body Sem_Ch6 is
 
                --  If an inherited subprogram is implemented by a protected
                --  function, then the first parameter of the inherited
-               --  subprogram shall be of mode in, but not an
-               --  access-to-variable parameter (RM 9.4(11/9)
+               --  subprogram shall be of mode in, but not an access-to-
+               --  variable parameter (RM 9.4(11/9)
 
                if Present (First_Formal (Subp))
                  and then Ekind (First_Formal (Subp)) = E_In_Parameter
@@ -9692,7 +9691,8 @@ package body Sem_Ch6 is
       -- Has_Matching_Entry_Or_Subprogram --
       --------------------------------------
 
-      function Has_Matching_Entry_Or_Subprogram (E : Entity_Id) return Boolean
+      function Has_Matching_Entry_Or_Subprogram
+        (E : Entity_Id) return Boolean
       is
          function Check_Conforming_Parameters
            (E1_Param : Node_Id;
@@ -9738,12 +9738,13 @@ package body Sem_Ch6 is
 
          begin
             while Present (Param_E1) and then Present (Param_E2) loop
-               if Ekind (Defining_Identifier (Param_E1))
-                    /= Ekind (Defining_Identifier (Param_E2))
+               if Ekind (Defining_Identifier (Param_E1)) /=
+                    Ekind (Defining_Identifier (Param_E2))
                  or else not
-                   Conforming_Types (Find_Parameter_Type (Param_E1),
-                                     Find_Parameter_Type (Param_E2),
-                                     Subtype_Conformant)
+                   Conforming_Types
+                     (Find_Parameter_Type (Param_E1),
+                      Find_Parameter_Type (Param_E2),
+                      Subtype_Conformant)
                then
                   return False;
                end if;
@@ -9799,7 +9800,7 @@ package body Sem_Ch6 is
 
          begin
             --  Search for entities in the enclosing scope of this synchonized
-            --  type
+            --  type.
 
             pragma Assert (Is_Concurrent_Type (Conc_Typ));
             Push_Scope (Scope (Conc_Typ));
@@ -9841,7 +9842,7 @@ package body Sem_Ch6 is
 
          begin
             --  Temporarily decorate the first parameter of Subp as controlling
-            --  formal; required to invoke Subtype_Conformant()
+            --  formal, required to invoke Subtype_Conformant.
 
             Set_Is_Controlling_Formal (First_Entity (Subp));
 
@@ -9866,6 +9867,7 @@ package body Sem_Ch6 is
             end loop;
 
             Set_Is_Controlling_Formal (First_Entity (Subp), ICF);
+
             return Empty;
          end Matching_Original_Protected_Subprogram;
 
@@ -9882,8 +9884,8 @@ package body Sem_Ch6 is
            and then Is_Concurrent_Record_Type (Etype (First_Entity (E)))
          then
             if Scope (E) =
-                 Scope (Corresponding_Concurrent_Type (
-                          Etype (First_Entity (E))))
+                 Scope (Corresponding_Concurrent_Type
+                         (Etype (First_Entity (E))))
               and then
                 Present
                   (Matching_Entry_Or_Subprogram
@@ -9913,8 +9915,8 @@ package body Sem_Ch6 is
            and then
              Present
                (Matching_Original_Protected_Subprogram
-                  (Corresponding_Concurrent_Type (Etype (First_Entity (E))),
-                   Subp => E))
+                 (Corresponding_Concurrent_Type (Etype (First_Entity (E))),
+                  Subp => E))
          then
             Report_Conflict (E,
               Matching_Original_Protected_Subprogram
@@ -9944,8 +9946,8 @@ package body Sem_Ch6 is
       ----------------------------
 
       function Is_Private_Declaration (E : Entity_Id) return Boolean is
-         Priv_Decls : List_Id;
          Decl       : constant Node_Id := Unit_Declaration_Node (E);
+         Priv_Decls : List_Id;
 
       begin
          if Is_Package_Or_Generic_Package (Current_Scope)
@@ -9979,6 +9981,7 @@ package body Sem_Ch6 is
       is
          AO : constant Entity_Id := Alias (Old_E);
          AN : constant Entity_Id := Alias (New_E);
+
       begin
          return Scope (AO) /= Scope (AN)
            or else No (DTC_Entity (AO))