[multiple changes]

2017-04-25  Ed Schonberg  <schonberg@adacore.com>

	* sem_disp.adb (Check_Dispatching_Context): Add guard to refine
	the check that recognizes a call to a private overridding and
	replaces the called subprogram with its alias.

2017-04-25  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_util.adb: Minor reformatting.

From-SVN: r247206

gcc/ada/ChangeLog

+2017-04-25  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_disp.adb (Check_Dispatching_Context): Add guard to refine
+	the check that recognizes a call to a private overridding and
+	replaces the called subprogram with its alias.
+
+2017-04-25  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_util.adb: Minor reformatting.
+
 2017-04-25  Justin Squirek  <squirek@adacore.com>
 
 	* exp_ch3.adb (Freeze_Type): Add condition to always treat

gcc/ada/exp_util.adb

@@ -2243,6 +2243,19 @@ package body Exp_Util is
             return;
          end if;
 
+         --  When the type inheriting the class-wide invariant is a concurrent
+         --  type, use the corresponding record type because it contains all
+         --  primitive operations of the concurren type and allows for proper
+         --  substitution.
+
+         if Is_Concurrent_Type (T) then
+            Deriv_Typ := Corresponding_Record_Type (T);
+         else
+            Deriv_Typ := T;
+         end if;
+
+               pragma Assert (Present (Deriv_Typ));
+
          --  Determine which rep item chain to use. Precedence is given to that
          --  of the parent type's partial view since it usually carries all the
          --  class-wide invariants.
@@ -2318,19 +2331,6 @@ package body Exp_Util is
 
                Expr := New_Copy_Tree (Prag_Expr);
 
-               --  When the type inheriting the class-wide invariant is a task
-               --  or protected type, use the corresponding record type because
-               --  it contains all primitive operations of the concurren type
-               --  and allows for proper substitution.
-
-               if Is_Concurrent_Type (T) then
-                  Deriv_Typ := Corresponding_Record_Type (T);
-               else
-                  Deriv_Typ := T;
-               end if;
-
-               pragma Assert (Present (Deriv_Typ));
-
                --  The parent type must have a "partial" invariant procedure
                --  because class-wide invariants are captured exclusively by
                --  it.

gcc/ada/sem_disp.adb

@@ -549,12 +549,19 @@ package body Sem_Disp is
       --  Start of processing for Check_Dispatching_Context
 
       begin
+         --  If the called subprogram is a private overriding, replace it
+         --  with its alias, which has the correct body. Verify that the
+         --  two subprograms have the same controlling type (this is not the
+         --  case for an inherited subprogram that has become abstract).
+
          if Is_Abstract_Subprogram (Subp)
            and then No (Controlling_Argument (Call))
          then
             if Present (Alias (Subp))
               and then not Is_Abstract_Subprogram (Alias (Subp))
               and then No (DTC_Entity (Subp))
+              and then Find_Dispatching_Type (Subp) =
+                 Find_Dispatching_Type (Alias (Subp))
             then
                --  Private overriding of inherited abstract operation, call is
                --  legal.