@@ -295,8 +295,8 @@ package body Sem_Util is
-- enclosing dynamic scope (effectively the accessibility
-- level of the innermost enclosing master).
- function Subprogram_Call_Level (Call_Ent : Entity_Id) return Node_Id;
- -- Centeralized processing of subprogram calls which may appear in
+ function Function_Call_Level (Call_Ent : Entity_Id) return Node_Id;
+ -- Centralized processing of subprogram calls which may appear in
-- prefix notation.
----------------------------------
@@ -314,7 +314,7 @@ package body Sem_Util is
-- that Defining_Entity can be applied to, and return the
-- depth of that entity's nearest enclosing dynamic scope.
- -- The rules which define what a master are are defined in
+ -- The rules that define what a master are defined in
-- RM 7.6.1 (3), and include statements and conditions for loops
-- among other things. These cases are detected properly ???
@@ -327,7 +327,7 @@ package body Sem_Util is
-- Ignore transient scopes made during expansion
- if Comes_From_Source (Encl_Scop) then
+ if Comes_From_Source (Node_Par) then
return Scope_Depth (Encl_Scop);
end if;
@@ -366,15 +366,16 @@ package body Sem_Util is
return Result;
end Make_Level_Literal;
- ---------------------------
- -- Subprogram_Call_Level --
- ---------------------------
+ -------------------------
+ -- Function_Call_Level --
+ -------------------------
- function Subprogram_Call_Level (Call_Ent : Entity_Id) return Node_Id is
+ function Function_Call_Level (Call_Ent : Entity_Id) return Node_Id is
+ Par : Node_Id;
begin
-- Results of functions are objects, so we either get the
-- accessibility of the function or, in case of a call which is
- -- indirect, the level of the access to subprogram type.
+ -- indirect, the level of the access-to-subprogram type.
-- This code looks wrong ???
@@ -393,17 +394,62 @@ package body Sem_Util is
if Is_Named_Access_Type (Etype (Call_Ent)) then
return Make_Level_Literal (Type_Access_Level (Etype (Call_Ent)));
- -- Otherwise, the level is that of the innermost master of the call,
- -- according to RM 3.10.2 (10.6/2).
-
- -- Note: Expr is used here instead of Call_Ent since expansion may
- -- have taken place, and we need to ensure we can climb the parent
- -- chain.
+ -- Otherwise, the level is dictated by RM 3.10.2 (10.7/3)
else
- return Make_Level_Literal (Innermost_Master_Scope_Depth (Expr));
+ -- Find any relevant enclosing parent nodes that designate an
+ -- object being initialized.
+
+ -- 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_Helper for N_Selected_Component.
+
+ -- How are we sure, for example, that we are not coming up from,
+ -- say, the left hand part of an assignment. More verification
+ -- needed ???
+
+ Par := Parent (Expr);
+ while Present (Par) loop
+ exit when Nkind (Par) in N_Assignment_Statement
+ | N_Object_Declaration
+ | N_Function_Call;
+ Par := Parent (Par);
+ end loop;
+
+ -- If no object is being initialized then the level is that of the
+ -- innermost master of the call, according to RM 3.10.2 (10.6/3).
+
+ if No (Par) or else Nkind (Par) = N_Function_Call then
+ return Make_Level_Literal (Innermost_Master_Scope_Depth (Expr));
+ end if;
+
+ -- The function call was used to initialize the entire object, so
+ -- the master is "that of the object."
+
+ -- 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 ???
+
+ case Nkind (Par) is
+ when N_Object_Declaration =>
+ return Make_Level_Literal
+ (Scope_Depth
+ (Scope (Defining_Identifier (Par))));
+
+ when N_Assignment_Statement =>
+ -- Return the accessiblity level of the left-hand part
+
+ return Accessibility_Level_Helper (Name (Par), Static);
+
+ -- Should never get here
+
+ when others =>
+ raise Program_Error;
+ end case;
end if;
- end Subprogram_Call_Level;
+ end Function_Call_Level;
-- Local variables
@@ -471,7 +517,7 @@ package body Sem_Util is
when N_Object_Declaration =>
return Make_Level_Literal
(Scope_Depth
- (Scope (Defining_Identifier (Parent (Expr)))));
+ (Scope (Defining_Identifier (Par))));
-- In an assignment statement the level is that of the
-- object at the left-hand side.
@@ -479,7 +525,7 @@ package body Sem_Util is
when N_Assignment_Statement =>
return Make_Level_Literal
(Scope_Depth
- (Scope (Entity (Name (Parent (Expr))))));
+ (Scope (Entity (Name (Par)))));
-- Subprogram calls have a level one deeper than the
-- nearest enclosing scope.
@@ -702,6 +748,25 @@ package body Sem_Util is
return Make_Level_Literal
(Type_Access_Level (Etype (Prefix (E))));
+ -- The accessibility calculation routine that handles function
+ -- calls (Function_Call_Level) assumes, in the case the
+ -- result is of an anonymous access type, that the result will be
+ -- used "in its entirety" when the call is present within an
+ -- assignment or object declaration.
+
+ -- To properly handle cases where the result is not used in its
+ -- entirety, we test if the prefix of the component in question is
+ -- a function call, which tells us that one of its components has
+ -- been identified and is being accessed. Therefore we can
+ -- conclude that the result is not used "in its entirety"
+ -- according to RM 3.10.2 (10.2/3).
+
+ elsif Nkind (Pre) = N_Function_Call
+ and then not Is_Named_Access_Type (Etype (Pre))
+ then
+ return Make_Level_Literal
+ (Innermost_Master_Scope_Depth (Expr));
+
-- Otherwise, continue recursing over the expression prefixes
else
@@ -721,7 +786,7 @@ package body Sem_Util is
-- Handle function calls
when N_Function_Call =>
- return Subprogram_Call_Level (E);
+ return Function_Call_Level (E);
-- Explicit dereference accessibility level calculation