--------------------------------------
function Function_Call_Or_Allocator_Level (N : Node_Id) return Node_Id is
- Par : Node_Id;
- Prev_Par : Node_Id;
+ Prev_Par : Node_Id := Expr;
+ Par : Node_Id := Parent (Expr);
+ -- Par and Prev_Par will be used for traversing the AST, while
+ -- maintaining an invariant that Par = Parent (Prev_Par).
+
begin
-- First deal with function calls in Ada 95
-- Otherwise the accessibility level of the innermost master
else
- return Make_Level_Literal
- (Innermost_Master_Scope_Depth (Expr));
+ return Make_Level_Literal (Innermost_Master_Scope_Depth (Expr));
end if;
-- We ignore coextensions as they cannot be implemented under the
- -- "small-integer" model.
+ -- "small integer" model.
elsif Nkind (N) = N_Allocator
and then (Is_Static_Coextension (N)
or else Is_Dynamic_Coextension (N))
then
return Make_Level_Literal (Scope_Depth (Standard_Standard));
- end if;
- -- Named access types have a designated level
+ -- Objects of a named access type get their level from their type
- if Is_Named_Access_Type (Etype (N)) then
+ elsif Is_Named_Access_Type (Etype (N)) then
return Make_Level_Literal (Typ_Access_Level (Etype (N)));
- -- Otherwise, the level is dictated by RM 3.10.2 (10.7/3)
+ -- Function calls in Ada 2005 and later, and anonymous allocators
else
-- Check No_Dynamic_Accessibility_Checks restriction override for
return Make_Level_Literal (Typ_Access_Level (Etype (N)));
-- For function calls the level is that of the innermost
- -- master, otherwise (for allocators etc.) we get the level
- -- of the corresponding anonymous access type, which is
+ -- master; otherwise, for allocators we get the level of
+ -- the corresponding anonymous access type, which is
-- calculated through the normal path of execution.
elsif Nkind (N) = N_Function_Call then
- return Make_Level_Literal
- (Innermost_Master_Scope_Depth (Expr));
+ return
+ Make_Level_Literal (Innermost_Master_Scope_Depth (Expr));
end if;
end if;
+ -- AI12-0402: The master of the function call for a function
+ -- whose result type is a scalar type is always the innermost
+ -- master invoking the function.
+
+ if Ada_Version >= Ada_2022
+ and then Nkind (N) = N_Function_Call
+ and then Is_Scalar_Type (Etype (N))
+ then
+ return Make_Level_Literal (Innermost_Master_Scope_Depth (Expr));
+ end if;
+
-- Dynamic checks are generated when we are within a return
-- value or we are in a function call within an anonymous
-- access discriminant constraint of a return object (signified
end;
end if;
- -- When the call is being dereferenced the level is that of the
- -- enclosing master of the dereferenced call.
+ -- Find any relevant parent nodes that designate an object being
+ -- initialized and stop when there is an inappropriate construct.
- if Nkind (Parent (N)) in N_Explicit_Dereference
- | N_Indexed_Component
- | N_Selected_Component
- then
- return Make_Level_Literal
- (Innermost_Master_Scope_Depth (Expr));
- end if;
+ while Present (Par) loop
- -- Find any relevant enclosing parent nodes that designate an
- -- object being initialized.
+ case Nkind (Par) is
- -- Note: The above is only relevant if the result is used "in its
- -- entirety" as RM 3.10.2 (10.2/3) states. However, this is
- -- accounted for in the case statement in the main body of
- -- Accessibility_Level for N_Selected_Component.
+ -- RM 3.10.2 (10.2/5) is relevant only if the result is used
+ -- to "directly initialize" the object.
- Par := Parent (Expr);
- Prev_Par := Empty;
- while Present (Par) loop
- -- Detect an expanded implicit conversion, typically this
- -- occurs on implicitly converted actuals in calls.
+ when N_Explicit_Dereference | N_Function_Call | N_Op =>
+ exit;
- -- Does this catch all implicit conversions ???
+ -- RM 3.10.2 (10.2/5) is relevant only if the result is used
+ -- "in its entirety".
- if Nkind (Par) = N_Type_Conversion
- and then Is_Named_Access_Type (Etype (Par))
- then
- return Make_Level_Literal
- (Typ_Access_Level (Etype (Par)));
- end if;
+ when N_Indexed_Component | N_Selected_Component | N_Slice =>
+ exit;
- -- Jump out when we hit an object declaration or the right-hand
- -- side of an assignment, or a construct such as an aggregate
- -- subtype indication which would be the result is not used
- -- "in its entirety."
+ -- Accept operative constituents
- exit when Nkind (Par) in N_Object_Declaration
- or else (Nkind (Par) = N_Assignment_Statement
- and then Name (Par) /= Prev_Par);
+ when N_Case_Expression =>
+ exit when Prev_Par = Expression (Par);
- Prev_Par := Par;
- Par := Parent (Par);
- end loop;
+ when N_If_Expression =>
+ exit when Prev_Par = First (Expressions (Par));
- -- Assignment statements are handled in a similar way in
- -- accordance to the left-hand part. However, strictly speaking,
- -- this is illegal according to the RM, but this change is needed
- -- to pass an ACATS C-test and is useful in general ???
+ when N_Case_Expression_Alternative
+ | N_Qualified_Expression
+ | N_Unchecked_Type_Conversion
+ =>
+ null;
- case Nkind (Par) is
- when N_Object_Declaration =>
- return Make_Level_Literal
- (Scope_Depth
- (Scope (Defining_Identifier (Par))));
+ -- Detect an expanded implicit conversion, typically this
+ -- occurs on implicitly converted actuals in calls.
- when N_Assignment_Statement =>
- -- Return the accessibility level of the left-hand part
+ -- Does this catch all implicit conversions ???
- return Accessibility_Level
- (Expr => Name (Par),
- Level => Object_Decl_Level,
- In_Return_Context => In_Return_Context);
+ when N_Type_Conversion =>
+ if Is_Named_Access_Type (Etype (Par)) then
+ return
+ Make_Level_Literal (Typ_Access_Level (Etype (Par)));
+ end if;
- when others =>
- return Make_Level_Literal
- (Innermost_Master_Scope_Depth (Expr));
- end case;
+ -- For the (static) declaration of an object, return the
+ -- accessibility level of the master of the object.
+
+ when N_Object_Declaration =>
+ return
+ Make_Level_Literal
+ (Scope_Depth (Scope (Defining_Identifier (Par))));
+
+ -- For the dynamic allocation of an object, return the
+ -- accessibility level of the allocator.
+
+ when N_Allocator =>
+ return Accessibility_Level (Par);
+
+ -- RM 3.10.2(10.3/5): If the result is of an anonymous
+ -- access type and is converted to a (named or anonymous)
+ -- access type, the master is determined following the
+ -- rules given for determining the master of an object
+ -- created by an allocator.
+
+ -- The conversion can be an implicit subtype conversion,
+ -- in particular the one in an assignment (RM 5.2(11/5)).
+
+ -- For an anonymous allocator in an assignment, return the
+ -- accessibility level of the name (RM 3.10.2(14/6)).
+
+ when N_Assignment_Statement =>
+ exit when Prev_Par = Name (Par)
+ or else not Is_Anonymous_Access_Type (Etype (N));
+
+ return Accessibility_Level
+ (Expr => Name (Par),
+ Level => Object_Decl_Level,
+ In_Return_Context => In_Return_Context);
+
+ when others =>
+ -- Prevent the search from going too far
+
+ exit when Is_Statement (Par)
+ or else Is_Body_Or_Package_Declaration (Par);
+ end case;
+
+ Prev_Par := Par;
+ Par := Parent (Par);
+ end loop;
+
+ -- Return the accessibility level of the innermost master
+
+ return Make_Level_Literal (Innermost_Master_Scope_Depth (Expr));
end if;
end Function_Call_Or_Allocator_Level;
-- Named access types
if Is_Named_Access_Type (Etype (Pre)) then
- return Make_Level_Literal
- (Typ_Access_Level (Etype (Pre)));
+ return Make_Level_Literal (Typ_Access_Level (Etype (Pre)));
-- Anonymous access types
then
return Accessibility_Level (Renamed_Entity_Or_Object (E));
- -- Named access types get their level from their associated type
+ -- Objects of a named access type get their level from their type
elsif Is_Named_Access_Type (Etype (E)) then
- return Make_Level_Literal
- (Typ_Access_Level (Etype (E)));
+ return Make_Level_Literal (Typ_Access_Level (Etype (E)));
-- Check if E is an expansion-generated renaming of an iterator
-- by examining Related_Expression. If so, determine the
-- of the named access type in the prefix.
elsif Is_Named_Access_Type (Etype (Pre)) then
- return Make_Level_Literal
- (Typ_Access_Level (Etype (Pre)));
+ return Make_Level_Literal (Typ_Access_Level (Etype (Pre)));
-- The current expression is a named access type, so there is no
-- reason to look at the prefix. Instead obtain the level of E's
-- named access type.
elsif Is_Named_Access_Type (Etype (E)) then
- return Make_Level_Literal
- (Typ_Access_Level (Etype (E)));
+ return Make_Level_Literal (Typ_Access_Level (Etype (E)));
-- A nondiscriminant selected component where the component
-- is an anonymous access type means that its associated
and then No_Dynamic_Accessibility_Checks_Enabled (E)
and then Debug_Flag_Underscore_B
then
- return Make_Level_Literal
- (Typ_Access_Level (Etype (E)));
+ return Make_Level_Literal (Typ_Access_Level (Etype (E)));
end if;
-- Otherwise proceed normally
- return Make_Level_Literal
- (Typ_Access_Level (Etype (Prefix (E))));
+ return
+ Make_Level_Literal (Typ_Access_Level (Etype (Prefix (E))));
-- The accessibility calculation routine that handles function
-- calls (Function_Call_Level) assumes, in the case the
when N_Qualified_Expression =>
if Is_Named_Access_Type (Etype (E)) then
- return Make_Level_Literal
- (Typ_Access_Level (Etype (E)));
+ return Make_Level_Literal (Typ_Access_Level (Etype (E)));
else
return Accessibility_Level (Expression (E));
end if;
-- access type.
elsif Is_Named_Access_Type (Etype (E)) then
- return Make_Level_Literal
- (Typ_Access_Level (Etype (E)));
+ return Make_Level_Literal (Typ_Access_Level (Etype (E)));
-- In section RM 3.10.2 (10/4) the accessibility rules for
-- aggregates and value conversions are outlined. Are these
projects / thirdparty / gcc.git / commitdiff
