OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
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
This commit is contained in:
Arnaud Charlet 2017-04-25 14:09:22 +02:00
parent 0bcee27558
commit 5f8d3dd5b3
3 changed files with 30 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
gcc/ada/ChangeLog
View File

@ -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

26
gcc/ada/exp_util.adb
View File

@ -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.

7
gcc/ada/sem_disp.adb
View File

@ -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.