[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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 93ace03de42b9b808e1a8e97bf70048d15c68cc7..492070248fdb839bd401f72d2468b3c0a563c194 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,13 @@
+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

diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 3a79f61444c6372dd026564541bdc8a66fab15f3..35c5ed2c831204e474a1866f9b5041c6b66ce5ff 100644 (file)
--- a/gcc/ada/exp_util.adb
+++ b/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.

diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index a2eb9ce5908de6763850680e52f9d752aea7300b..b0a8c6a61883d65bd7b66bc5d07a558fca593431 100644 (file)
--- a/gcc/ada/sem_disp.adb
+++ b/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.