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

[Ada] Broken privacy on Controlled type extensions

Browse Source 
2019-12-12  Justin Squirek  <squirek@adacore.com>

gcc/ada/

	* sem_ch4.adb (Analyze_One_Call): Add condition to check for
	incorrectly resolved hidden controlled primitives.

From-SVN: r279297
This commit is contained in:
Justin Squirek 2019-12-12 10:03:16 +00:00 committed by Pierre-Marie de Rodat
parent 4bcf29692f
commit 2f0a921fad
2 changed files with 57 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
gcc/ada/ChangeLog
View File

@ -1,3 +1,8 @@
2019-12-12 Justin Squirek <squirek@adacore.com>
* sem_ch4.adb (Analyze_One_Call): Add condition to check for
incorrectly resolved hidden controlled primitives.
2019-12-12 Ed Schonberg <schonberg@adacore.com>
* sem_res.adb: Fix processing of standard predefined operators.

54
gcc/ada/sem_ch4.adb
View File

@ -3249,6 +3249,7 @@ package body Sem_Ch4 is
-- is already known to be compatible, and because this may be an
-- indexing of a call with default parameters.
First_Form : Entity_Id;
Formal : Entity_Id;
Actual : Node_Id;
Is_Indexed : Boolean := False;
@ -3581,8 +3582,9 @@ package body Sem_Ch4 is
-- Normalize_Actuals has chained the named associations in the
-- correct order of the formals.
Actual := First_Actual (N);
Formal := First_Formal (Nam);
Actual := First_Actual (N);
Formal := First_Formal (Nam);
First_Form := Formal;
-- If we are analyzing a call rewritten from object notation, skip
-- first actual, which may be rewritten later as an explicit
@ -3742,6 +3744,54 @@ package body Sem_Ch4 is
end if;
end loop;
-- Due to our current model of controlled type expansion we may
-- have resolved a user call to a non-visible controlled primitive
-- since these inherited subprograms may be generated in the current
-- scope. This is a side-effect of the need for the expander to be
-- able to resolve internally generated calls.
-- Specifically, the issue appears when predefined controlled
-- operations get called on a type extension whose parent is a
-- private extension completed with a controlled extension - see
-- below:
-- package X is
-- type Par_Typ is tagged private;
-- private
-- type Par_Typ is new Controlled with null record;
-- end;
-- ...
-- procedure Main is
-- type Ext_Typ is new Par_Typ with null record;
-- Obj : Ext_Typ;
-- begin
-- Finalize (Obj); -- Will improperly resolve
-- end;
-- To avoid breaking privacy, Is_Hidden gets set elsewhere on such
-- primitives, but we still need to verify that Nam is indeed a
-- controlled subprogram. So, we do that here and issue the
-- appropriate error.
if Is_Hidden (Nam)
and then not In_Instance
and then not Comes_From_Source (Nam)
and then Comes_From_Source (N)
-- Verify Nam is a controlled primitive
and then Nam_In (Chars (Nam), Name_Adjust,
Name_Finalize,
Name_Initialize)
and then Ekind (Nam) = E_Procedure
and then Is_Controlled (Etype (First_Form))
and then No (Next_Formal (First_Form))
then
Error_Msg_Node_2 := Etype (First_Form);
Error_Msg_NE ("call to non-visible controlled primitive & on type"
& " &", N, Nam);
end if;
-- On exit, all actuals match
Indicate_Name_And_Type;