From 5f8d3dd5b33acad71225d815ef3389fbf6c5963d Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 25 Apr 2017 14:09:22 +0200 Subject: [PATCH] [multiple changes] 2017-04-25 Ed Schonberg * 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 * exp_util.adb: Minor reformatting. From-SVN: r247206 --- gcc/ada/ChangeLog | 10 ++++++++++ gcc/ada/exp_util.adb | 26 +++++++++++++------------- gcc/ada/sem_disp.adb | 7 +++++++ 3 files changed, 30 insertions(+), 13 deletions(-) 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 + + * 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 + + * exp_util.adb: Minor reformatting. + 2017-04-25 Justin Squirek * 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. -- 2.30.2