[multiple changes]

2017-09-08  Arnaud Charlet  <charlet@adacore.com>

	* sem_util.ads, sem_util.adb (Is_CCT_Instance): moved from
	sem_prag.adb to make it available for GNATprove; for concurrent
	types replace custom scope climbing with Scope_Same_Or_Within; for
	single concurrent objects add scope climbing (with Scope_Within),
	which was not there (that's the primary semantic change of this
	commit); also, when comparing a single concurrent object with
	its corresponding concurrent type rely on equality of types,
	not of objects (because that's simpler to code).
	* sem_prag.adb (Is_CCT_Instance): lifted to sem_util.ads.
	(Analyze_Global_Item): adjust special-casing of references to the
	current instance of a concurrent unit in the Global contracts
	of task types and single tasks objects; similar for references
	in the protected operations and entries of protected types and
	single protected objects (in all these cases the current instance
	behaves as an implicit parameter and must not be mentioned in
	the Global contract).

2017-09-08  Arnaud Charlet  <charlet@adacore.com>

	* exp_ch6.adb (Expand_Call_Helper): Introduce temporary for
	function calls returning a record within a subprogram call,
	for C generation.

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

	* sem_ch8.adb (Find_Expanded_Name): Handle properly an expanded
	name that designates the current instance of a child unit in its
	own body and appears as the prefix of a reference to an entity
	local to the child unit.
	* exp_ch6.adb, freeze.adb, sem_ch3.adb, sem_prag.adb, sem_util.adb:
	Minor reformatting.

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

	* sem_res.adb (Resolve_Equality_Op): Do not warn on comparisons that
	may be intentional.

2017-09-08  Tristan Gingold  <gingold@adacore.com>

	* sem_warn.adb (Check_Unused_Withs): Remove test that disabled
	warnings on internal units in configurable run time mode.

From-SVN: r251871

10 files changed, 241 insertions, 134 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 2631caf..8f5ef1b 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,47 @@
+2017-09-08  Arnaud Charlet  <charlet@adacore.com>
+
+	* sem_util.ads, sem_util.adb (Is_CCT_Instance): moved from
+	sem_prag.adb to make it available for GNATprove; for concurrent
+	types replace custom scope climbing with Scope_Same_Or_Within; for
+	single concurrent objects add scope climbing (with Scope_Within),
+	which was not there (that's the primary semantic change of this
+	commit); also, when comparing a single concurrent object with
+	its corresponding concurrent type rely on equality of types,
+	not of objects (because that's simpler to code).
+	* sem_prag.adb (Is_CCT_Instance): lifted to sem_util.ads.
+	(Analyze_Global_Item): adjust special-casing of references to the
+	current instance of a concurrent unit in the Global contracts
+	of task types and single tasks objects; similar for references
+	in the protected operations and entries of protected types and
+	single protected objects (in all these cases the current instance
+	behaves as an implicit parameter and must not be mentioned in
+	the Global contract).
+
+2017-09-08  Arnaud Charlet  <charlet@adacore.com>
+
+	* exp_ch6.adb (Expand_Call_Helper): Introduce temporary for
+	function calls returning a record within a subprogram call,
+	for C generation.
+
+2017-09-08  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch8.adb (Find_Expanded_Name): Handle properly an expanded
+	name that designates the current instance of a child unit in its
+	own body and appears as the prefix of a reference to an entity
+	local to the child unit.
+	* exp_ch6.adb, freeze.adb, sem_ch3.adb, sem_prag.adb, sem_util.adb:
+	Minor reformatting.
+
+2017-09-08  Yannick Moy  <moy@adacore.com>
+
+	* sem_res.adb (Resolve_Equality_Op): Do not warn on comparisons that
+	may be intentional.
+
+2017-09-08  Tristan Gingold  <gingold@adacore.com>
+
+	* sem_warn.adb (Check_Unused_Withs): Remove test that disabled
+	warnings on internal units in configurable run time mode.
+
 2017-09-08  Bob Duff  <duff@adacore.com>
 
 	* sem_ch3.adb (Build_Derived_Private_Type): Inherit
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 908338f..2822765 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -2751,32 +2751,70 @@ package body Exp_Ch6 is
          end;
       end if;
 
-      --  When generating C code, transform a function call that returns a
-      --  constrained array type into procedure form.
-
       if Modify_Tree_For_C
         and then Nkind (Call_Node) = N_Function_Call
         and then Is_Entity_Name (Name (Call_Node))
-        and then Rewritten_For_C (Ultimate_Alias (Entity (Name (Call_Node))))
       then
-         --  For internally generated calls ensure that they reference the
-         --  entity of the spec of the called function (needed since the
-         --  expander may generate calls using the entity of their body).
-         --  See for example Expand_Boolean_Operator().
-
-         if not (Comes_From_Source (Call_Node))
-           and then Nkind (Unit_Declaration_Node
-                            (Ultimate_Alias (Entity (Name (Call_Node))))) =
-                              N_Subprogram_Body
-         then
-            Set_Entity (Name (Call_Node),
-              Corresponding_Function
-                (Corresponding_Procedure
-                  (Ultimate_Alias (Entity (Name (Call_Node))))));
-         end if;
+         declare
+            Func_Id : constant Entity_Id :=
+                        Ultimate_Alias (Entity (Name (Call_Node)));
+         begin
+            --  When generating C code, transform a function call that returns
+            --  a constrained array type into procedure form.
 
-         Rewrite_Function_Call_For_C (Call_Node);
-         return;
+            if Rewritten_For_C (Func_Id) then
+
+               --  For internally generated calls ensure that they reference
+               --  the entity of the spec of the called function (needed since
+               --  the expander may generate calls using the entity of their
+               --  body). See for example Expand_Boolean_Operator().
+
+               if not (Comes_From_Source (Call_Node))
+                 and then Nkind (Unit_Declaration_Node (Func_Id)) =
+                            N_Subprogram_Body
+               then
+                  Set_Entity (Name (Call_Node),
+                    Corresponding_Function
+                      (Corresponding_Procedure (Func_Id)));
+               end if;
+
+               Rewrite_Function_Call_For_C (Call_Node);
+               return;
+
+            --  Also introduce a temporary for functions that return a record
+            --  called within another procedure or function call, since records
+            --  are passed by pointer in the generated C code, and we cannot
+            --  take a pointer from a subprogram call.
+
+            elsif Nkind (Parent (Call_Node)) in N_Subprogram_Call
+              and then Is_Record_Type (Etype (Func_Id))
+            then
+               declare
+                  Temp_Id : constant Entity_Id := Make_Temporary (Loc, 'T');
+                  Decl    : Node_Id;
+
+               begin
+                  --  Generate:
+                  --    Temp : ... := Func_Call (...);
+
+                  Decl :=
+                    Make_Object_Declaration (Loc,
+                      Defining_Identifier => Temp_Id,
+                      Object_Definition   =>
+                        New_Occurrence_Of (Etype (Func_Id), Loc),
+                      Expression          =>
+                        Make_Function_Call (Loc,
+                          Name                   =>
+                            New_Occurrence_Of (Func_Id, Loc),
+                          Parameter_Associations =>
+                            Parameter_Associations (Call_Node)));
+
+                  Insert_Action (Parent (Call_Node), Decl);
+                  Rewrite (Call_Node, New_Occurrence_Of (Temp_Id, Loc));
+                  return;
+               end;
+            end if;
+         end;
       end if;
 
       --  First step, compute extra actuals, corresponding to any Extra_Formals
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 8a3bf36..437951c 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -3423,16 +3423,12 @@ package body Freeze is
       --------------------
 
       function Freeze_Profile (E : Entity_Id) return Boolean is
-         F_Type    : Entity_Id;
-         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.
+         --  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 --
@@ -3456,6 +3452,7 @@ package body Freeze is
 
                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))
@@ -3464,6 +3461,7 @@ package body Freeze is
                   then
                      return True;
                   end if;
+
                   Comp := Next_Entity (Comp);
                end loop;
 
@@ -3471,16 +3469,26 @@ package body Freeze is
 
             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;
+
+               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;
 
+         --  Local variables
+
+         F_Type    : Entity_Id;
+         R_Type    : Entity_Id;
+         Warn_Node : Node_Id;
+
+      --  Start of processing for Freeze_Profile
+
       begin
          --  Loop through formals
 
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 158aa67..188a0d3 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -9580,6 +9580,7 @@ package body Sem_Ch3 is
       --  type, and from any interfaces.
 
       Inherit_Rep_Item_Chain (Derived_Type, Parent_Type);
+
       declare
          Iface : Node_Id := First (Abstract_Interface_List (Derived_Type));
       begin
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 621de03..5194703 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -3437,7 +3437,7 @@ package body Sem_Ch8 is
          --  addition the renamed entity may depend on the generic formals of
          --  the enclosing generic.
 
-         if Is_Actual and not Inside_A_Generic then
+         if Is_Actual and then not Inside_A_Generic then
             Freeze_Before (N, Old_S);
             Freeze_Actual_Profile;
             Set_Has_Delayed_Freeze (New_S, False);
@@ -6000,6 +6000,21 @@ package body Sem_Ch8 is
                Candidate        := Get_Full_View (Non_Limited_View (Id));
                Is_New_Candidate := True;
 
+            --  An unusual case arises with a fully qualified name for an
+            --  entity local to a generic child unit package, within an
+            --  instantiation of that package. The name of the unit now
+            --  denotes the renaming created within the instance. This is
+            --  only relevant in an instance body, see below.
+
+            elsif Is_Generic_Instance (Scope (Id))
+              and then In_Open_Scopes (Scope (Id))
+              and then In_Instance_Body
+              and then Ekind (Scope (Id)) = E_Package
+              and then Ekind (Id) = E_Package
+              and then Renamed_Entity (Id) = Scope (Id)
+            then
+               Is_New_Candidate := True;
+
             else
                Is_New_Candidate := False;
             end if;
@@ -6246,6 +6261,10 @@ package body Sem_Ch8 is
                      end;
 
                   else
+                     --  Might be worth specializing the case when the prefix
+                     --  is a limited view.
+                     --  ... not declared in limited view of...
+
                      Error_Msg_NE ("& not declared in&", N, Selector);
                   end if;
 
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index dc0f830..ed4622e 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -259,14 +259,6 @@ package body Sem_Prag is
    --  Determine whether dependency clause Clause is surrounded by extra
    --  parentheses. If this is the case, issue an error message.
 
-   function Is_CCT_Instance
-     (Ref_Id     : Entity_Id;
-      Context_Id : Entity_Id) return Boolean;
-   --  Subsidiary to the analysis of pragmas [Refined_]Depends and [Refined_]
-   --  Global. Determine whether entity Ref_Id denotes the current instance of
-   --  a concurrent type. Context_Id denotes the associated context where the
-   --  pragma appears.
-
    function Is_Unconstrained_Or_Tagged_Item (Item : Entity_Id) return Boolean;
    --  Subsidiary to Collect_Subprogram_Inputs_Outputs and the analysis of
    --  pragma Depends. Determine whether the type of dependency item Item is
@@ -2188,24 +2180,28 @@ package body Sem_Prag is
                      --  formal parameter.
 
                      if Ekind (Item_Id) = E_Protected_Type then
-                        Error_Msg_Name_1 := Chars (Item_Id);
-                        SPARK_Msg_NE
-                          (Fix_Msg (Spec_Id, "global item of subprogram & "
-                           & "cannot reference current instance of protected "
-                           & "type %"), Item, Spec_Id);
-                        return;
+                        if Scope (Spec_Id) = Item_Id then
+                           Error_Msg_Name_1 := Chars (Item_Id);
+                           SPARK_Msg_NE
+                             (Fix_Msg (Spec_Id, "global item of subprogram & "
+                              & "cannot reference current instance of "
+                              & "protected type %"), Item, Spec_Id);
+                           return;
+                        end if;
 
                      --  Pragma [Refined_]Global associated with a task type
                      --  cannot mention the current instance of a task type
                      --  because the instance behaves as a formal parameter.
 
                      else pragma Assert (Ekind (Item_Id) = E_Task_Type);
-                        Error_Msg_Name_1 := Chars (Item_Id);
-                        SPARK_Msg_NE
-                          (Fix_Msg (Spec_Id, "global item of subprogram & "
-                           & "cannot reference current instance of task type "
-                           & "%"), Item, Spec_Id);
-                        return;
+                        if Spec_Id = Item_Id then
+                           Error_Msg_Name_1 := Chars (Item_Id);
+                           SPARK_Msg_NE
+                             (Fix_Msg (Spec_Id, "global item of subprogram & "
+                              & "cannot reference current instance of task "
+                              & "type %"), Item, Spec_Id);
+                           return;
+                        end if;
                      end if;
 
                   --  Otherwise the global item denotes a subtype mark that is
@@ -2230,24 +2226,28 @@ package body Sem_Prag is
                   --  parameter.
 
                   if Is_Single_Protected_Object (Item_Id) then
-                     Error_Msg_Name_1 := Chars (Item_Id);
-                     SPARK_Msg_NE
-                       (Fix_Msg (Spec_Id, "global item of subprogram & cannot "
-                        & "reference current instance of protected type %"),
-                        Item, Spec_Id);
-                     return;
+                     if Scope (Spec_Id) = Etype (Item_Id) then
+                        Error_Msg_Name_1 := Chars (Item_Id);
+                        SPARK_Msg_NE
+                          (Fix_Msg (Spec_Id, "global item of subprogram & "
+                           & "cannot reference current instance of protected "
+                           & "type %"), Item, Spec_Id);
+                        return;
+                     end if;
 
                   --  Pragma [Refined_]Global associated with a task type
                   --  cannot mention the current instance of a task type
                   --  because the instance behaves as a formal parameter.
 
                   else pragma Assert (Is_Single_Task_Object (Item_Id));
-                     Error_Msg_Name_1 := Chars (Item_Id);
-                     SPARK_Msg_NE
-                       (Fix_Msg (Spec_Id, "global item of subprogram & cannot "
-                        & "reference current instance of task type %"),
-                        Item, Spec_Id);
-                     return;
+                     if Spec_Id = Item_Id then
+                        Error_Msg_Name_1 := Chars (Item_Id);
+                        SPARK_Msg_NE
+                          (Fix_Msg (Spec_Id, "global item of subprogram & "
+                           & "cannot reference current instance of task "
+                           & "type %"), Item, Spec_Id);
+                        return;
+                     end if;
                   end if;
 
                --  A formal object may act as a global item inside a generic
@@ -29243,63 +29243,6 @@ package body Sem_Prag is
       return Add_Config_Static_String (Arg);
    end Is_Config_Static_String;
 
-   ---------------------
-   -- Is_CCT_Instance --
-   ---------------------
-
-   function Is_CCT_Instance
-     (Ref_Id     : Entity_Id;
-      Context_Id : Entity_Id) return Boolean
-   is
-      S   : Entity_Id;
-      Typ : Entity_Id;
-
-   begin
-      --  When the reference denotes a single protected type, the context is
-      --  either a protected subprogram or its body.
-
-      if Is_Single_Protected_Object (Ref_Id) then
-         Typ := Scope (Context_Id);
-
-         return
-           Ekind (Typ) = E_Protected_Type
-             and then Present (Anonymous_Object (Typ))
-             and then Anonymous_Object (Typ) = Ref_Id;
-
-      --  When the reference denotes a single task type, the context is either
-      --  the same type or if inside the body, the anonymous task type.
-
-      elsif Is_Single_Task_Object (Ref_Id) then
-         if Ekind (Context_Id) = E_Task_Type then
-            return
-              Present (Anonymous_Object (Context_Id))
-                and then Anonymous_Object (Context_Id) = Ref_Id;
-         else
-            return Ref_Id = Context_Id;
-         end if;
-
-      --  Otherwise the reference denotes a protected or a task type. Climb the
-      --  scope chain looking for an enclosing concurrent type that matches the
-      --  referenced entity.
-
-      else
-         pragma Assert (Ekind_In (Ref_Id, E_Protected_Type, E_Task_Type));
-
-         S := Current_Scope;
-         while Present (S) and then S /= Standard_Standard loop
-            if Ekind_In (S, E_Protected_Type, E_Task_Type)
-              and then S = Ref_Id
-            then
-               return True;
-            end if;
-
-            S := Scope (S);
-         end loop;
-      end if;
-
-      return False;
-   end Is_CCT_Instance;
-
    -------------------------------
    -- Is_Elaboration_SPARK_Mode --
    -------------------------------
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index ed96c53..fc99753 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -7997,11 +7997,20 @@ package body Sem_Res is
             Check_Restriction (No_Dispatching_Calls, N);
          end if;
 
+         --  Only warn for redundant equality comparison to True for objects
+         --  (e.g. "X = True") and operations (e.g. "(X < Y) = True"). For
+         --  other expressions, it may be a matter of preference to write
+         --  "Expr = True" or "Expr".
+
          if Warn_On_Redundant_Constructs
            and then Comes_From_Source (N)
            and then Comes_From_Source (R)
            and then Is_Entity_Name (R)
            and then Entity (R) = Standard_True
+           and then
+             ((Is_Entity_Name (L) and then Is_Object (Entity (L)))
+                or else
+              Nkind (L) in N_Op)
          then
             Error_Msg_N -- CODEFIX
               ("?r?comparison with True is redundant!", N);
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 9deee3b..8fe3e1a 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -205,7 +205,7 @@ package body Sem_Util is
             Nod := Type_Definition (Parent (Typ));
          end if;
 
-      --  It's not the kind of type that can implement interfaces
+      --  Otherwise the type is of a kind which does not implement interfaces
 
       else
          return Empty_List;
@@ -12382,6 +12382,52 @@ package body Sem_Util is
                   Is_RTE (Root_Type (Under), RO_WW_Super_String));
    end Is_Bounded_String;
 
+   ---------------------
+   -- Is_CCT_Instance --
+   ---------------------
+
+   function Is_CCT_Instance
+     (Ref_Id     : Entity_Id;
+      Context_Id : Entity_Id) return Boolean
+   is
+   begin
+      pragma Assert
+        (Is_Entry (Context_Id)
+           or else
+         Ekind_In (Context_Id, E_Function,
+                               E_Procedure,
+                               E_Protected_Type,
+                               E_Task_Type)
+           or else
+         Is_Single_Concurrent_Object (Context_Id));
+
+      --  When the reference denotes a single protected type, the context is
+      --  either a protected subprogram or its body.
+
+      if Is_Single_Protected_Object (Ref_Id) then
+         return Scope_Within (Context_Id, Etype (Ref_Id));
+
+      --  When the reference denotes a single task type, the context is either
+      --  the same type or if inside the body, the anonymous task object.
+
+      elsif Is_Single_Task_Object (Ref_Id) then
+         if Is_Single_Task_Object (Context_Id) then
+            return Context_Id = Ref_Id;
+
+         elsif Ekind (Context_Id) = E_Task_Type then
+            return Context_Id = Etype (Ref_Id);
+
+         else
+            return Scope_Within_Or_Same (Context_Id, Etype (Ref_Id));
+         end if;
+
+      else
+         pragma Assert (Ekind_In (Ref_Id, E_Protected_Type, E_Task_Type));
+
+         return Scope_Within_Or_Same (Context_Id, Ref_Id);
+      end if;
+   end Is_CCT_Instance;
+
    -------------------------
    -- Is_Child_Or_Sibling --
    -------------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index a7b3487..1477dcd 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -1476,6 +1476,14 @@ package Sem_Util is
    function Is_CPP_Constructor_Call (N : Node_Id) return Boolean;
    --  Returns True if N is a call to a CPP constructor
 
+   function Is_CCT_Instance
+     (Ref_Id     : Entity_Id;
+      Context_Id : Entity_Id) return Boolean;
+   --  Subsidiary to the analysis of pragmas [Refined_]Depends and [Refined_]
+   --  Global. Determine whether entity Ref_Id denotes the current instance of
+   --  a concurrent type. Context_Id denotes the associated context where the
+   --  pragma appears.
+
    function Is_Child_Or_Sibling
      (Pack_1 : Entity_Id;
       Pack_2 : Entity_Id) return Boolean;
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index c8136b0..f6adb7c 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -2383,15 +2383,6 @@ package body Sem_Warn is
 
          if not In_Extended_Main_Source_Unit (Cnode) then
             return;
-
-         --  In configurable run time mode, we remove the bodies of non-inlined
-         --  subprograms, which may lead to spurious warnings, which are
-         --  clearly undesirable.
-
-         elsif Configurable_Run_Time_Mode
-           and then Is_Predefined_Unit (Unit)
-         then
-            return;
          end if;
 
          --  Loop through context items in this unit