From: Arnaud Charlet <charlet@gcc.gnu.org>
Date: Tue, 25 Apr 2017 12:09:22 +0000 (+0200)
Subject: [multiple changes]
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=5f8d3dd5b33acad71225d815ef3389fbf6c5963d;p=gcc.git

[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 93ace03de42..492070248fd 100644
--- 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 3a79f61444c..35c5ed2c831 100644
--- 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 a2eb9ce5908..b0a8c6a6188 100644
--- 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.