From: Eric Botcazou <[email protected]>
The assertion failure shows that the 'Access reference implicitly introduced
for calls written in object notation whose controlling first parameter is an
access to class-wide interface is not later expanded in the cases where the
pointer to the interface needs to be retrieved.
gcc/ada/ChangeLog:
PR ada/34290
* sem_ch4.adb (Try_Object_Operation.Complete_Object_Operation): Call
Preserve_Comes_From_Source to preserve the flag on nodes. Relocate
the Obj node consistently. Preserve the Comes_From_Source flag for
the case of an implicit 'Access reference and post the local errors
on the rewritten prefix consistently.
* sem_util.adb (Is_Aliased_View): Also return true for a generalized
reference to the result of a function call.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_ch4.adb | 36 ++++++++++++++++++++++--------------
gcc/ada/sem_util.adb | 6 ++++++
2 files changed, 28 insertions(+), 14 deletions(-)
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 54df44d954b..c16e0453ec1 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -9791,8 +9791,8 @@ package body Sem_Ch4 is
-- source if the original one is. Set entity and type, even though
-- they may be overwritten during resolution if overloaded.
- Set_Comes_From_Source (Subprog, Comes_From_Source (N));
- Set_Comes_From_Source (Call_Node, Comes_From_Source (N));
+ Preserve_Comes_From_Source (Subprog, N);
+ Preserve_Comes_From_Source (Call_Node, N);
if Nkind (N) = N_Selected_Component
and then not Inside_A_Generic
@@ -9820,7 +9820,7 @@ package body Sem_Ch4 is
and then Is_Access_Type (Etype (Obj))
then
Rewrite (First_Actual,
- Make_Explicit_Dereference (Sloc (Obj), Obj));
+ Make_Explicit_Dereference (Sloc (Obj), Relocate_Node (Obj)));
Analyze (First_Actual);
-- If we need to introduce an explicit dereference, verify that
@@ -9832,11 +9832,12 @@ package body Sem_Ch4 is
Error_Msg_NE
("expect variable in call to&", Prefix (N), Entity (Subprog));
end if;
+
-- Conversely, if the formal is an access parameter and the object is
- -- not an access type or a reference type (i.e. a type with the
+ -- neither an access type nor a reference type (i.e. a type with the
-- Implicit_Dereference aspect specified), replace the actual with a
- -- 'Access reference. Its analysis will check that the object is
- -- aliased.
+ -- 'Access reference and give more specific error messages in common
+ -- illegal cases than Resolve_Attribute would.
elsif Is_Access_Type (Formal_Type)
and then not Is_Access_Type (Etype (Obj))
@@ -9846,6 +9847,17 @@ package body Sem_Ch4 is
not Is_Access_Type (Designated_Type (Etype
(Get_Reference_Discriminant (Etype (Obj))))))
then
+ Rewrite (First_Actual,
+ Make_Attribute_Reference (Loc,
+ Attribute_Name => Name_Access,
+ Prefix => Relocate_Node (Obj)));
+
+ -- Treat the new actual as being in the source if the object is.
+ -- This is necessary when interface types are involved, see the
+ -- Expand_N_Attribute_Reference procedure.
+
+ Preserve_Comes_From_Source (First_Actual, Obj);
+
-- A special case: A.all'Access is illegal if A is an access to a
-- constant and the context requires an access to a variable.
@@ -9855,17 +9867,13 @@ package body Sem_Ch4 is
or else not Is_Variable (Obj)
then
Error_Msg_NE
- ("actual for & must be a variable", Obj, Control);
+ ("actual for & must be a variable",
+ Prefix (First_Actual), Control);
end if;
end if;
- Rewrite (First_Actual,
- Make_Attribute_Reference (Loc,
- Attribute_Name => Name_Access,
- Prefix => Relocate_Node (Obj)));
-
- -- If the object is not overloaded verify that taking access of
- -- it is legal. Otherwise check is made during resolution.
+ -- If the object is not overloaded, verify that taking access of
+ -- it is legal. Otherwise the check is made during resolution.
if not Is_Overloaded (Obj)
and then not Is_Aliased_View (Obj)
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index e23d875f3f4..123c79dce5f 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -16148,6 +16148,12 @@ package body Sem_Util is
(Nkind (Parent (Obj)) = N_Object_Renaming_Declaration
and then Is_Return_Object (Defining_Entity (Parent (Obj))));
+ -- RM 4.1.5(6/3): A generalized reference denotes a view equivalent to
+ -- that of a dereference of the reference discriminant of the object.
+
+ elsif Nkind (Obj) = N_Function_Call then
+ return Has_Implicit_Dereference (Etype (Obj));
+
elsif Nkind (Obj) = N_Slice then
-- A slice of a bit-packed array is not considered aliased even
-- for an extended access type because even extended access types
--
2.51.0
