[multiple changes]

2017-09-08  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_util.adb (Copy_Node_With_Replacement):
	Update the Renamed_Object field of a replicated object renaming
	declaration.

2017-09-08  Patrick Bernardi  <bernardi@adacore.com>

	* exp_ch9.adb (Is_Pure_Barrier): Allow type
	conversions and components of objects. Simplified the detection
	of the Count attribute by identifying the corresponding run-time
	calls.

2017-09-08  Yannick Moy  <moy@adacore.com>

	* exp_ch9.adb, exp_disp.adb, repinfo.adb, sem_ch12.adb, sem_dim.adb,
	sem_type.adb, sinfo.ads: Minor reformatting.

2017-09-08  Ed Schonberg  <schonberg@adacore.com>

	* freeze.adb (Has_Incomplete_Compoent): New predicate, subsidiary
	of Freeze_Profile, used to inhibit the freezing of the profile
	of an expression function declared within a nested package, when
	some type in the profile depends on a private type declared in
	an enclosing package.

2017-09-08  Bob Duff  <duff@adacore.com>

	* gnat1drv.adb (Gnat1drv): Do not set the Force_ALI_Tree_File flag in
	the subunit case. It's still OK to set it in the "missing subunits"
	case, because that won't cause the obsolete .ali files that cause
	confusion.

2017-09-08  Bob Duff  <duff@adacore.com>

	* sinput-l.adb: Remove unused "with Unchecked_Conversion;". It's
	unclear why this didn't cause a warning.
	* a-uncdea.ads, a-unccon.ads: Add "Ada." to names in the
	pragmas. It's unclear why this didn't cause an error.

From-SVN: r251869

14 files changed, 209 insertions, 79 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 1014e0e..e4501ea 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,45 @@
 2017-09-08  Hristian Kirtchev  <kirtchev@adacore.com>
 
+	* sem_util.adb (Copy_Node_With_Replacement):
+	Update the Renamed_Object field of a replicated object renaming
+	declaration.
+
+2017-09-08  Patrick Bernardi  <bernardi@adacore.com>
+
+	* exp_ch9.adb (Is_Pure_Barrier): Allow type
+	conversions and components of objects. Simplified the detection
+	of the Count attribute by identifying the corresponding run-time
+	calls.
+
+2017-09-08  Yannick Moy  <moy@adacore.com>
+
+	* exp_ch9.adb, exp_disp.adb, repinfo.adb, sem_ch12.adb, sem_dim.adb,
+	sem_type.adb, sinfo.ads: Minor reformatting.
+
+2017-09-08  Ed Schonberg  <schonberg@adacore.com>
+
+	* freeze.adb (Has_Incomplete_Compoent): New predicate, subsidiary
+	of Freeze_Profile, used to inhibit the freezing of the profile
+	of an expression function declared within a nested package, when
+	some type in the profile depends on a private type declared in
+	an enclosing package.
+
+2017-09-08  Bob Duff  <duff@adacore.com>
+
+	* gnat1drv.adb (Gnat1drv): Do not set the Force_ALI_Tree_File flag in
+	the subunit case. It's still OK to set it in the "missing subunits"
+	case, because that won't cause the obsolete .ali files that cause
+	confusion.
+
+2017-09-08  Bob Duff  <duff@adacore.com>
+
+	* sinput-l.adb: Remove unused "with Unchecked_Conversion;". It's
+	unclear why this didn't cause a warning.
+	* a-uncdea.ads, a-unccon.ads: Add "Ada." to names in the
+	pragmas. It's unclear why this didn't cause an error.
+
+2017-09-08  Hristian Kirtchev  <kirtchev@adacore.com>
+
 	* exp_spark.adb (Expand_SPARK_N_Object_Renaming_Declaration):
 	Reimplemented.
 	(Expand_SPARK_Potential_Renaming): Code clean up.
diff --git a/gcc/ada/a-unccon.ads b/gcc/ada/a-unccon.ads
index a3b4318..a8429c1 100644
--- a/gcc/ada/a-unccon.ads
+++ b/gcc/ada/a-unccon.ads
@@ -19,6 +19,6 @@ generic
 
 function Ada.Unchecked_Conversion (S : Source) return Target;
 
-pragma No_Elaboration_Code_All (Unchecked_Conversion);
-pragma Pure (Unchecked_Conversion);
-pragma Import (Intrinsic, Unchecked_Conversion);
+pragma No_Elaboration_Code_All (Ada.Unchecked_Conversion);
+pragma Pure (Ada.Unchecked_Conversion);
+pragma Import (Intrinsic, Ada.Unchecked_Conversion);
diff --git a/gcc/ada/a-uncdea.ads b/gcc/ada/a-uncdea.ads
index d566b4b..a61cd50 100644
--- a/gcc/ada/a-uncdea.ads
+++ b/gcc/ada/a-uncdea.ads
@@ -20,4 +20,4 @@ generic
 procedure Ada.Unchecked_Deallocation (X : in out Name);
 pragma Preelaborate (Unchecked_Deallocation);
 
-pragma Import (Intrinsic, Unchecked_Deallocation);
+pragma Import (Intrinsic, Ada.Unchecked_Deallocation);
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index ecca4c3..64bc84a 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -5999,8 +5999,9 @@ package body Exp_Ch9 is
          Renamed : Node_Id;
 
       begin
-         --  Check for case of _object.all.field (note that the explicit
-         --  dereference gets inserted by analyze/expand of _object.field).
+         --  Check if the name is a component of the protected object. If
+         --  the expander is active, the component has been transformed into
+         --  a renaming of _object.all.component.
 
          if Expander_Active then
             Renamed := Renamed_Object (Entity (N));
@@ -6010,7 +6011,7 @@ package body Exp_Ch9 is
                 and then Nkind (Renamed) = N_Selected_Component
                 and then Chars (Prefix (Prefix (Renamed))) = Name_uObject;
          else
-            return Scope (Entity (N)) = Current_Scope;
+            return Is_Protected_Component (Entity (N));
          end if;
       end Is_Simple_Barrier_Name;
 
@@ -6019,25 +6020,6 @@ package body Exp_Ch9 is
       ---------------------
 
       function Is_Pure_Barrier (N : Node_Id) return Traverse_Result is
-         function Is_Count_Attribute (N : Node_Id) return Boolean;
-         --  Check whether N is part of an expansion of the Count attribute.
-         --  Return True if N represents the expanded function call.
-
-         ------------------------
-         -- Is_Count_Attribute --
-         ------------------------
-
-         function Is_Count_Attribute (N : Node_Id) return Boolean is
-         begin
-            return
-              Nkind (N) = N_Function_Call
-                and then Present (Original_Node (N))
-                and then Nkind (Original_Node (N)) = N_Attribute_Reference
-                and then Attribute_Name (Original_Node (N)) = Name_Count;
-         end Is_Count_Attribute;
-
-      --  Start of processing for Is_Pure_Barrier
-
       begin
          case Nkind (N) is
             when N_Expanded_Name
@@ -6045,11 +6027,8 @@ package body Exp_Ch9 is
             =>
                if No (Entity (N)) then
                   return Abandon;
-               end if;
 
-               if Present (Parent (N))
-                 and then Is_Count_Attribute (Parent (N))
-               then
+               elsif Is_Universal_Numeric_Type (Entity (N)) then
                   return OK;
                end if;
 
@@ -6062,24 +6041,35 @@ package body Exp_Ch9 is
                   =>
                      return OK;
 
-                  when E_Component
-                     | E_Variable
-                  =>
-                     --  A variable in the protected type is expanded as a
-                     --  component.
+                  when E_Component =>
+                     return OK;
 
+                  when E_Variable =>
                      if Is_Simple_Barrier_Name (N) then
                         return OK;
                      end if;
 
+                  when E_Function =>
+
+                     --  The count attribute has been transformed into run-time
+                     --  calls.
+
+                     if Is_RTE (Entity (N), RE_Protected_Count)
+                       or else Is_RTE (Entity (N), RE_Protected_Count_Entry)
+                     then
+                        return OK;
+                     end if;
+
                   when others =>
                      null;
                end case;
 
             when N_Function_Call =>
-               if Is_Count_Attribute (N) then
-                  return OK;
-               end if;
+
+               --  Function call checks are carried out as part of the analysis
+               --  of the function call name.
+
+               return OK;
 
             when N_Character_Literal
                | N_Integer_Literal
@@ -6097,6 +6087,27 @@ package body Exp_Ch9 is
             when N_Short_Circuit =>
                return OK;
 
+            when N_Indexed_Component
+               | N_Selected_Component
+            =>
+               if not Is_Access_Type (Etype (Prefix (N))) then
+                  return OK;
+               end if;
+
+            when N_Type_Conversion =>
+
+               --  Conversions to Universal_Integer will not raise constraint
+               --  errors.
+
+               if Cannot_Raise_Constraint_Error (N)
+                 or else Etype (N) = Universal_Integer
+               then
+                  return OK;
+               end if;
+
+            when N_Unchecked_Type_Conversion =>
+               return OK;
+
             when others =>
                null;
          end case;
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index e5e2c61..872ac64 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -5895,7 +5895,7 @@ package body Exp_Disp is
                   --  Retrieve the ultimate alias of the primitive for proper
                   --  handling of renamings and eliminated primitives.
 
-                  E        := Ultimate_Alias (Prim);
+                  E := Ultimate_Alias (Prim);
 
                   --  If the alias is not a primitive operation then Prim does
                   --  not rename another primitive, but rather an operation
@@ -7806,7 +7806,8 @@ package body Exp_Disp is
             then
                declare
                   Par_Type : constant Entity_Id :=
-                    Find_Dispatching_Type (Alias (Prim));
+                               Find_Dispatching_Type (Alias (Prim));
+
                begin
                   if Present (Par_Type)
                     and then Par_Type /= Typ
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index c20beef..8a3bf36 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -3427,6 +3427,60 @@ package body Freeze is
          R_Type    : Entity_Id;
          Warn_Node : Node_Id;
 
+         function Has_Incomplete_Component (T : Entity_Id) return Boolean;
+         --  If a type includes a private component from an enclosing scope
+         --  it cannot be frozen yet. This can happen in a package nested
+         --  within another, when freezing an expression function whose
+         --  profile depends on a type in some outer scope. Those types will
+         --  be frozen at a later time in the enclosing unit.
+
+         ------------------------------
+         -- Has_Incomplete_Component --
+         ------------------------------
+
+         function Has_Incomplete_Component (T : Entity_Id) return Boolean is
+            Comp     : Entity_Id;
+            Comp_Typ : Entity_Id;
+
+         begin
+            if Nkind (N) /= N_Subprogram_Body
+              or else not Was_Expression_Function (N)
+            then
+               return False;
+
+            elsif In_Instance then
+               return False;
+
+            elsif Is_Record_Type (T) then
+               Comp := First_Entity (T);
+
+               while Present (Comp) loop
+                  Comp_Typ := Etype (Comp);
+                  if Ekind_In (Comp, E_Component, E_Discriminant)
+                    and then Is_Private_Type (Comp_Typ)
+                    and then No (Full_View (Comp_Typ))
+                    and then In_Open_Scopes (Scope (Comp_Typ))
+                    and then Scope (Comp_Typ) /= Current_Scope
+                  then
+                     return True;
+                  end if;
+                  Comp := Next_Entity (Comp);
+               end loop;
+
+               return False;
+
+            elsif Is_Array_Type (T) then
+               Comp_Typ := Component_Type (T);
+               return Is_Private_Type (Comp_Typ)
+                 and then No (Full_View (Comp_Typ))
+                 and then In_Open_Scopes (Scope (Comp_Typ))
+                 and then Scope (Comp_Typ) /= Current_Scope;
+
+            else
+               return False;
+            end if;
+         end Has_Incomplete_Component;
+
       begin
          --  Loop through formals
 
@@ -3446,6 +3500,12 @@ package body Freeze is
                Set_Etype (Formal, F_Type);
             end if;
 
+            if Has_Incomplete_Component (F_Type) then
+               Set_Is_Frozen (E, False);
+               Result := No_List;
+               return False;
+            end if;
+
             if not From_Limited_With (F_Type) then
                Freeze_And_Append (F_Type, N, Result);
             end if;
diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb
index 6264c0b..b1bbea9 100644
--- a/gcc/ada/gnat1drv.adb
+++ b/gcc/ada/gnat1drv.adb
@@ -1353,9 +1353,9 @@ begin
                Write_Str (" (subunit)");
                Write_Eol;
 
-               --  Force generation of ALI file, for backward compatibility
-
-               Opt.Force_ALI_Tree_File := True;
+               --  Do not generate an ALI file in this case, because it would
+               --  become obsolete when the parent is compiled, and thus
+               --  confuse tools such as gnatfind.
 
             elsif Main_Unit_Kind = N_Subprogram_Declaration then
                Write_Str (" (subprogram spec)");
diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb
index 2634ee8..c42de8c 100644
--- a/gcc/ada/repinfo.adb
+++ b/gcc/ada/repinfo.adb
@@ -894,6 +894,7 @@ package body Repinfo is
             Cfbit := Component_Bit_Offset (Comp);
 
             if Rep_Not_Constant (Cfbit) then
+
                --  If the record is not packed, then we know that all fields
                --  whose position is not specified have a starting normalized
                --  bit position of zero.
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 94bd498..6e4a4f9 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -1902,7 +1902,7 @@ package body Sem_Ch12 is
                      --  only uses them to elaborate entities in a package
                      --  body.
 
-                     declare
+                     Explicit_Freeze_Check : declare
                         Actual : constant Entity_Id := Entity (Match);
 
                         Needs_Freezing : Boolean;
@@ -1920,16 +1920,20 @@ package body Sem_Ch12 is
                         --------------------------
 
                         procedure Check_Generic_Parent is
-                           Par            : Entity_Id;
+                           Par : Entity_Id;
+
                         begin
-                           if Nkind (Parent (Actual)) = N_Package_Specification
+                           if Nkind (Parent (Actual)) =
+                                N_Package_Specification
                            then
                               Par := Scope (Generic_Parent (Parent (Actual)));
+
                               if Is_Generic_Instance (Par)
                                 and then Scope (Par) = Current_Scope
-                                and then (No (Freeze_Node (Par))
-                                  or else
-                                    not Is_List_Member (Freeze_Node (Par)))
+                                and then
+                                  (No (Freeze_Node (Par))
+                                    or else
+                                      not Is_List_Member (Freeze_Node (Par)))
                               then
                                  Set_Has_Delayed_Freeze (Par);
                                  Append_Elmt (Par, Actuals_To_Freeze);
@@ -1937,6 +1941,8 @@ package body Sem_Ch12 is
                            end if;
                         end Check_Generic_Parent;
 
+                     --  Start of processing for Explicit_Freeze_Check
+
                      begin
                         if not Expander_Active
                           or else not Has_Completion (Actual)
@@ -1944,9 +1950,9 @@ package body Sem_Ch12 is
                           or else Is_Frozen (Actual)
                           or else
                             (Present (Renamed_Entity (Actual))
-                              and then not
-                                In_Same_Source_Unit
-                                  (I_Node, (Renamed_Entity (Actual))))
+                              and then
+                                not In_Same_Source_Unit
+                                      (I_Node, (Renamed_Entity (Actual))))
                         then
                            null;
 
@@ -1978,7 +1984,7 @@ package body Sem_Ch12 is
                               Append_Elmt (Actual, Actuals_To_Freeze);
                            end if;
                         end if;
-                     end;
+                     end Explicit_Freeze_Check;
                   end if;
 
                --  For use type and use package appearing in the generic part,
@@ -9297,8 +9303,8 @@ package body Sem_Ch12 is
           and then (Nkind_In (Gen_Unit, N_Generic_Package_Declaration,
                                         N_Package_Declaration)
                      or else (Gen_Unit = Body_Unit
-                               and then True_Sloc (N, Act_Unit)
-                                          < Sloc (Orig_Body)))
+                               and then True_Sloc (N, Act_Unit) <
+                                          Sloc (Orig_Body)))
           and then Is_In_Main_Unit (Original_Node (Gen_Unit))
           and then In_Same_Scope (Gen_Id, Act_Id));
 
@@ -9314,7 +9320,7 @@ package body Sem_Ch12 is
 
       if Expander_Active
         and then (No (Freeze_Node (Act_Id))
-          or else not Is_List_Member (Freeze_Node (Act_Id)))
+                   or else not Is_List_Member (Freeze_Node (Act_Id)))
       then
          Ensure_Freeze_Node (Act_Id);
          F_Node := Freeze_Node (Act_Id);
diff --git a/gcc/ada/sem_dim.adb b/gcc/ada/sem_dim.adb
index 6e829f9..6330703 100644
--- a/gcc/ada/sem_dim.adb
+++ b/gcc/ada/sem_dim.adb
@@ -195,12 +195,12 @@ package body Sem_Dim is
    OK_For_Dimension : constant array (Node_Kind) of Boolean :=
      (N_Attribute_Reference       => True,
       N_Case_Expression           => True,
-      N_If_Expression             => True,
       N_Expanded_Name             => True,
       N_Explicit_Dereference      => True,
       N_Defining_Identifier       => True,
       N_Function_Call             => True,
       N_Identifier                => True,
+      N_If_Expression             => True,
       N_Indexed_Component         => True,
       N_Integer_Literal           => True,
       N_Op_Abs                    => True,
@@ -1169,6 +1169,9 @@ package body Sem_Dim is
          when N_Binary_Op =>
             Analyze_Dimension_Binary_Op (N);
 
+         when N_Case_Expression =>
+            Analyze_Dimension_Case_Expression (N);
+
          when N_Component_Declaration =>
             Analyze_Dimension_Component_Declaration (N);
 
@@ -1187,20 +1190,17 @@ package body Sem_Dim is
          =>
             Analyze_Dimension_Has_Etype (N);
 
-         when N_Case_Expression =>
-            Analyze_Dimension_Case_Expression (N);
-
-         when N_If_Expression =>
-            Analyze_Dimension_If_Expression (N);
-
-         --  In the presence of a repaired syntax error, an identifier
-         --  may be introduced without a usable type.
+         --  In the presence of a repaired syntax error, an identifier may be
+         --  introduced without a usable type.
 
          when N_Identifier =>
             if Present (Etype (N)) then
                Analyze_Dimension_Has_Etype (N);
             end if;
 
+         when N_If_Expression =>
+            Analyze_Dimension_If_Expression (N);
+
          when N_Number_Declaration =>
             Analyze_Dimension_Number_Declaration (N);
 
@@ -1787,9 +1787,12 @@ package body Sem_Dim is
    ---------------------------------------
 
    procedure Analyze_Dimension_Case_Expression (N : Node_Id) is
+      Frst      : constant Node_Id        := First (Alternatives (N));
+      Frst_Expr : constant Node_Id        := Expression (Frst);
+      Dims      : constant Dimension_Type := Dimensions_Of (Frst_Expr);
+
       Alt : Node_Id;
-      Frst : constant Node_Id := First (Alternatives (N));
-      Dims : constant Dimension_Type := Dimensions_Of (Expression (Frst));
+
    begin
       Alt := Next (Frst);
       while Present (Alt) loop
@@ -1800,7 +1803,8 @@ package body Sem_Dim is
 
          Next (Alt);
       end loop;
-      Copy_Dimensions (Expression (Frst), N);
+
+      Copy_Dimensions (Frst_Expr, N);
    end Analyze_Dimension_Case_Expression;
 
    ---------------------------------------------
@@ -2144,6 +2148,7 @@ package body Sem_Dim is
    procedure Analyze_Dimension_If_Expression (N : Node_Id) is
       Then_Expr : constant Node_Id := Next (First (Expressions (N)));
       Else_Expr : constant Node_Id := Next (Then_Expr);
+
    begin
       if Dimensions_Of (Then_Expr) /= Dimensions_Of (Else_Expr) then
          Error_Msg_N ("dimensions mismatch in conditional expression", N);
diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb
index c9d8f4b..c70d892 100644
--- a/gcc/ada/sem_type.adb
+++ b/gcc/ada/sem_type.adb
@@ -2947,9 +2947,9 @@ package body Sem_Type is
             --  Continue climbing
 
             else
-               --  Use the full-view of private types (if allowed).
-               --  Guard against infinite loops when full view has same
-               --  type as parent, as can happen with interface extensions,
+               --  Use the full-view of private types (if allowed). Guard
+               --  against infinite loops when full view has same type as
+               --  parent, as can happen with interface extensions.
 
                if Use_Full_View
                  and then Is_Private_Type (Par)
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 968de98..f57b7c5 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -17659,8 +17659,8 @@ package body Sem_Util is
                  (New_Node, Default_Node.Comes_From_Source);
             end if;
 
-            --  If the node is a call and has named associations, set the
-            --  corresponding links in the copy.
+            --  Update the named association links for calls to mention the
+            --  copied actual parameters.
 
             if Nkind_In (Old_Node, N_Entry_Call_Statement,
                                    N_Function_Call,
@@ -17668,6 +17668,13 @@ package body Sem_Util is
               and then Present (First_Named_Actual (Old_Node))
             then
                Adjust_Named_Associations (Old_Node, New_Node);
+
+            --  Update the Renamed_Object attribute of an object renaming
+            --  declaration to mention the replicated name.
+
+            elsif Nkind (Old_Node) = N_Object_Renaming_Declaration then
+               Set_Renamed_Object
+                 (Defining_Entity (New_Node), Name (New_Node));
             end if;
 
             --  Reset First_Real_Statement for Handled_Sequence_Of_Statements.
@@ -17679,8 +17686,9 @@ package body Sem_Util is
               and then Present (First_Real_Statement (Old_Node))
             then
                declare
-                  Old_F  : constant Node_Id := First_Real_Statement (Old_Node);
-                  N1, N2 : Node_Id;
+                  Old_F : constant Node_Id := First_Real_Statement (Old_Node);
+                  N1    : Node_Id;
+                  N2    : Node_Id;
 
                begin
                   N1 := First (Statements (Old_Node));
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 93b0653..0aef4b6 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -11852,8 +11852,8 @@ package Sinfo is
      N_Case_Expression_Alternative =>
        (1 => False,   --  Actions (List1-Sem)
         2 => False,   --  unused
-        3 => True,    --  Statements (List3)
-        4 => True,    --  Expression (Node4)
+        3 => True,    --  Expression (Node3)
+        4 => True,    --  Discrete_Choices (List4)
         5 => False),  --  unused
 
      N_Case_Statement =>
diff --git a/gcc/ada/sinput-l.adb b/gcc/ada/sinput-l.adb
index d7e337b..360e711 100644
--- a/gcc/ada/sinput-l.adb
+++ b/gcc/ada/sinput-l.adb
@@ -45,8 +45,6 @@ with System;   use System;
 
 with System.OS_Lib; use System.OS_Lib;
 
-with Unchecked_Conversion;
-
 package body Sinput.L is
 
    Prep_Buffer : Text_Buffer_Ptr := null;