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

[Ada] Wrong accessibility on 'Access of formal in call

Browse Source 
gcc/ada/

	* exp_ch6.adb (Expand_Call_Helper): Modify addition of the extra
	accessibility parameter to take into account the extra
	accessibility of formals within the calling subprogram.
This commit is contained in:
Justin Squirek 2020-06-18 14:15:47 -04:00 committed by Pierre-Marie de Rodat
parent 116e8b669e
commit 19796dddf0
1 changed files with 16 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
gcc/ada/exp_ch6.adb
View File

@ -3264,7 +3264,7 @@ package body Exp_Ch6 is
Param_Count : Natural := 0; Param_Count : Natural := 0;
Parent_Formal : Entity_Id; Parent_Formal : Entity_Id;
Parent_Subp : Entity_Id; Parent_Subp : Entity_Id;
Pref_Entity : Entity_Id; Prev_Ult : Node_Id;
Scop : Entity_Id; Scop : Entity_Id;
Subp : Entity_Id; Subp : Entity_Id;
@ -3824,60 +3824,30 @@ package body Exp_Ch6 is
Expression (Original_Node (Prev_Orig)); Expression (Original_Node (Prev_Orig));
end if; end if;
-- If this is an Access attribute applied to the -- Obtain the ultimate prefix so we can check for
-- the current instance object passed to a type -- the case where we are taking 'Access of a
-- initialization procedure, then use the level -- component of an anonymous access formal - which
-- of the type itself. This is not really correct, -- would mean we need to pass said formal's
-- as there should be an extra level parameter -- corresponding extra accessibility formal.
-- passed in with _init formals (only in the case
-- where the type is immutably limited), but we
-- don't have an easy way currently to create such
-- an extra formal (init procs aren't ever frozen).
-- For now we just use the level of the type,
-- which may be too shallow, but that works better
-- than passing Object_Access_Level of the type,
-- which can be one level too deep in some cases.
-- ???
-- A further case that requires special handling Prev_Ult := Ultimate_Prefix (Prev_Orig);
-- is the common idiom E.all'access. If E is a
-- formal of the enclosing subprogram, the
-- accessibility of the expression is that of E.
if Is_Entity_Name (Prev_Orig) then if Is_Entity_Name (Prev_Ult)
Pref_Entity := Entity (Prev_Orig); and then not Is_Type (Entity (Prev_Ult))
elsif Nkind (Prev_Orig) = N_Explicit_Dereference
and then Is_Entity_Name (Prefix (Prev_Orig))
then
Pref_Entity := Entity (Prefix ((Prev_Orig)));
else
Pref_Entity := Empty;
end if;
if Is_Entity_Name (Prev_Orig)
and then Is_Type (Entity (Prev_Orig))
then
Add_Extra_Actual
(Expr =>
Make_Integer_Literal (Loc,
Intval =>
Type_Access_Level (Pref_Entity)),
EF => Get_Accessibility (Formal));
elsif Nkind (Prev_Orig) = N_Explicit_Dereference
and then Present (Pref_Entity)
and then Is_Formal (Pref_Entity)
and then Present and then Present
(Get_Accessibility (Pref_Entity)) (Get_Accessibility
(Entity (Prev_Ult)))
then then
Add_Extra_Actual Add_Extra_Actual
(Expr => (Expr =>
New_Occurrence_Of New_Occurrence_Of
(Get_Accessibility (Pref_Entity), Loc), (Get_Accessibility
(Entity (Prev_Ult)), Loc),
EF => Get_Accessibility (Formal)); EF => Get_Accessibility (Formal));
-- Normal case, call Object_Access_Level. Note:
-- should be Dynamic_Accessibility_Level ???
else else
Add_Extra_Actual Add_Extra_Actual
(Expr => (Expr =>