package body Accessibility is
+ function Needs_Result_Accessibility_Level_Param
+ (Func_Id : Entity_Id;
+ Func_Typ : Entity_Id) return Boolean;
+ -- Subsidiary of functions Needs_Result_Accessibility_Extra_Formal and
+ -- Needs_Result_Accessibility_Level_Param. Return True if the function
+ -- needs an implicit parameter to identify the accessibility level of
+ -- the function result "determined by the point of call". Func_Typ is
+ -- the function return type; this function returns False if Func_Typ is
+ -- Empty.
+
---------------------------
-- Accessibility_Message --
---------------------------
and then Is_Explicitly_Aliased (Entity (Prefix (Exp)));
end Is_Special_Aliased_Formal_Access;
+ ---------------------------------------------
+ -- Needs_Result_Accessibility_Extra_Formal --
+ ---------------------------------------------
+
+ function Needs_Result_Accessibility_Extra_Formal
+ (Func_Id : Entity_Id) return Boolean
+ is
+ Func_Typ : Entity_Id;
+
+ begin
+ if Present (Underlying_Type (Etype (Func_Id))) then
+ Func_Typ := Underlying_Type (Etype (Func_Id));
+
+ -- Case of a function returning a private type which is not completed
+ -- yet. The support for this case is required because this function is
+ -- called to create the extra formals of dispatching primitives, and
+ -- they may be frozen before we see the full-view of their returned
+ -- private type.
+
+ else
+ -- Temporarily restore previous behavior
+ -- Func_Typ := Etype (Func_Id);
+ Func_Typ := Empty;
+ end if;
+
+ return Needs_Result_Accessibility_Level_Param (Func_Id, Func_Typ);
+ end Needs_Result_Accessibility_Extra_Formal;
+
--------------------------------------
-- Needs_Result_Accessibility_Level --
--------------------------------------
is
Func_Typ : constant Entity_Id := Underlying_Type (Etype (Func_Id));
+ begin
+ return Needs_Result_Accessibility_Level_Param (Func_Id, Func_Typ);
+ end Needs_Result_Accessibility_Level;
+
+ --------------------------------------------
+ -- Needs_Result_Accessibility_Level_Param --
+ --------------------------------------------
+
+ function Needs_Result_Accessibility_Level_Param
+ (Func_Id : Entity_Id;
+ Func_Typ : Entity_Id) return Boolean
+ is
function Has_Unconstrained_Access_Discriminant_Component
(Comp_Typ : Entity_Id) return Boolean;
-- Returns True if any component of the type has an unconstrained access
-- Flag used to temporarily disable a "True" result for tagged types.
-- See comments further below for details.
- -- Start of processing for Needs_Result_Accessibility_Level
+ -- Start of processing for Needs_Result_Accessibility_Level_Param
begin
-- False if completion unavailable, which can happen when we are
else
return False;
end if;
- end Needs_Result_Accessibility_Level;
+ end Needs_Result_Accessibility_Level_Param;
------------------------------------------
-- Prefix_With_Safe_Accessibility_Level --
-- prefix is an aliased formal of Scop and that Scop returns an anonymous
-- access type. See RM 3.10.2 for more details.
+ function Needs_Result_Accessibility_Extra_Formal
+ (Func_Id : Entity_Id) return Boolean;
+ -- Ada 2012 (AI05-0234): Return True if the function needs an implicit
+ -- parameter to identify the accessibility level of the function result.
+ -- If the type of the function result is a private type and its completion
+ -- is unavailable, which can happen when we are analyzing an abstract
+ -- subprogram, determines its result using the returned private type. This
+ -- function is used by Create_Extra_Formals.
+
function Needs_Result_Accessibility_Level
(Func_Id : Entity_Id) return Boolean;
-- Ada 2012 (AI05-0234): Return True if the function needs an implicit
-- parameter to identify the accessibility level of the function result
- -- "determined by the point of call".
+ -- "determined by the point of call". Return False if the type of the
+ -- function result is a private type and its completion is unavailable.
function Subprogram_Access_Level (Subp : Entity_Id) return Uint;
-- Return the accessibility level of the view denoted by Subp
begin
Ada_Version := Ada_2022;
- if Needs_Result_Accessibility_Level (Ref_E)
+ if Needs_Result_Accessibility_Extra_Formal (Ref_E)
or else
(Present (Parent_Subp)
- and then Needs_Result_Accessibility_Level (Parent_Subp))
+ and then Needs_Result_Accessibility_Extra_Formal (Parent_Subp))
or else
(Present (Alias_Subp)
- and then Needs_Result_Accessibility_Level (Alias_Subp))
+ and then Needs_Result_Accessibility_Extra_Formal (Alias_Subp))
then
Set_Extra_Accessibility_Of_Result (E,
Add_Extra_Formal (E, Standard_Natural, E, "L"));
-- Check attribute Extra_Accessibility_Of_Result
if Ekind (E) in E_Function | E_Subprogram_Type
- and then Needs_Result_Accessibility_Level (E)
+ and then Needs_Result_Accessibility_Extra_Formal (E)
and then No (Extra_Accessibility_Of_Result (E))
then
return False;