This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] Fix view mismatch when doing front-end inlining
- To: gcc-patches at gcc dot gnu dot org
- Subject: [Ada] Fix view mismatch when doing front-end inlining
- From: bosch at gnat dot com
- Date: Thu, 25 Oct 2001 20:34:19 -0400 (EDT)
2001-10-25 Ed Schonberg <schonber@gnat.com>
* sem_res.adb (Resolve): special-case resolution of Null in an
instance or an inlined body to avoid view conflicts.
* sem_ch12.adb (Copy_Generic_Node): for allocators, check for view
compatibility by retrieving the access type of the generic copy.
*** sem_res.adb 2001/09/23 23:27:40 1.717
--- sem_res.adb 2001/09/25 19:00:16 1.718
***************
*** 1666,1671 ****
--- 1666,1683 ----
Wrong_Type (Expression (N), Designated_Type (Typ));
Found := True;
+ -- Check for view mismatch on Null in instances, for
+ -- which the view-swapping mechanism has no identifier.
+
+ elsif (In_Instance or else In_Inlined_Body)
+ and then (Nkind (N) = N_Null)
+ and then Is_Private_Type (Typ)
+ and then Is_Access_Type (Full_View (Typ))
+ then
+ Resolve (N, Full_View (Typ));
+ Set_Etype (N, Typ);
+ return;
+
-- Check for an aggregate. Sometimes we can get bogus
-- aggregates from misuse of parentheses, and we are
-- about to complain about the aggregate without even
***************
*** 4513,4519 ****
begin
-- For now allow circumvention of the restriction against
-- anonymous null access values via a debug switch to allow
! -- for easier trasition.
if not Debug_Flag_J
and then Ekind (Typ) = E_Anonymous_Access_Type
--- 4525,4531 ----
begin
-- For now allow circumvention of the restriction against
-- anonymous null access values via a debug switch to allow
! -- for easier transition.
if not Debug_Flag_J
and then Ekind (Typ) = E_Anonymous_Access_Type
*** sem_ch12.adb 2001/09/18 18:27:29 1.776
--- sem_ch12.adb 2001/09/25 19:00:18 1.777
***************
*** 4197,4202 ****
--- 4197,4205 ----
-- field may hold a Node_Id, a List_Id, or an Elist_Id, or a plain
-- value (Sloc, Uint, Char) in which case it need not be copied.
+ procedure Copy_Descendants;
+ -- Common utility for various nodes.
+
function Copy_Generic_Elist (E : Elist_Id) return Elist_Id;
-- Make copy of element list.
***************
*** 4206,4211 ****
--- 4209,4227 ----
return List_Id;
-- Apply Copy_Node recursively to the members of a node list.
+ -----------------------
+ -- Copy_Descendants --
+ -----------------------
+
+ procedure Copy_Descendants is
+ begin
+ Set_Field1 (New_N, Copy_Generic_Descendant (Field1 (N)));
+ Set_Field2 (New_N, Copy_Generic_Descendant (Field2 (N)));
+ Set_Field3 (New_N, Copy_Generic_Descendant (Field3 (N)));
+ Set_Field4 (New_N, Copy_Generic_Descendant (Field4 (N)));
+ Set_Field5 (New_N, Copy_Generic_Descendant (Field5 (N)));
+ end Copy_Descendants;
+
-----------------------------
-- Copy_Generic_Descendant --
-----------------------------
***************
*** 4606,4616 ****
--- 4622,4662 ----
end if;
end if;
+ -- Do not copy the associated node, which points to
+ -- the generic copy of the aggregate.
+
Set_Field1 (New_N, Copy_Generic_Descendant (Field1 (N)));
Set_Field2 (New_N, Copy_Generic_Descendant (Field2 (N)));
Set_Field3 (New_N, Copy_Generic_Descendant (Field3 (N)));
Set_Field5 (New_N, Copy_Generic_Descendant (Field5 (N)));
+ -- Allocators do not have an identifier denoting the access type,
+ -- so we must locate it through the expression to check whether
+ -- the views are consistent.
+
+ elsif Nkind (N) = N_Allocator
+ and then Nkind (Expression (N)) = N_Qualified_Expression
+ and then Instantiating
+ then
+ declare
+ T : Node_Id := Associated_Node (Subtype_Mark (Expression (N)));
+ Acc_T : Entity_Id;
+
+ begin
+ if Present (T) then
+ -- Retrieve the allocator node in the generic copy.
+
+ Acc_T := Etype (Parent (Parent (T)));
+ if Present (Acc_T)
+ and then Is_Private_Type (Acc_T)
+ then
+ Switch_View (Acc_T);
+ end if;
+ end if;
+
+ Copy_Descendants;
+ end;
+
-- For a proper body, we must catch the case of a proper body that
-- replaces a stub. This represents the point at which a separate
-- compilation unit, and hence template file, may be referenced, so
***************
*** 4632,4642 ****
-- Now copy the fields of the proper body, using the new
-- adjustment factor if one was needed as per test above.
! Set_Field1 (New_N, Copy_Generic_Descendant (Field1 (N)));
! Set_Field2 (New_N, Copy_Generic_Descendant (Field2 (N)));
! Set_Field3 (New_N, Copy_Generic_Descendant (Field3 (N)));
! Set_Field4 (New_N, Copy_Generic_Descendant (Field4 (N)));
! Set_Field5 (New_N, Copy_Generic_Descendant (Field5 (N)));
-- Restore the original adjustment factor in case changed
--- 4678,4684 ----
-- Now copy the fields of the proper body, using the new
-- adjustment factor if one was needed as per test above.
! Copy_Descendants;
-- Restore the original adjustment factor in case changed
***************
*** 4659,4680 ****
New_N := Make_Null_Statement (Sloc (N));
else
! Set_Field1 (New_N, Copy_Generic_Descendant (Field1 (N)));
! Set_Field2 (New_N, Copy_Generic_Descendant (Field2 (N)));
! Set_Field3 (New_N, Copy_Generic_Descendant (Field3 (N)));
! Set_Field4 (New_N, Copy_Generic_Descendant (Field4 (N)));
! Set_Field5 (New_N, Copy_Generic_Descendant (Field5 (N)));
end if;
end;
-- For the remaining nodes, copy recursively their descendants.
else
! Set_Field1 (New_N, Copy_Generic_Descendant (Field1 (N)));
! Set_Field2 (New_N, Copy_Generic_Descendant (Field2 (N)));
! Set_Field3 (New_N, Copy_Generic_Descendant (Field3 (N)));
! Set_Field4 (New_N, Copy_Generic_Descendant (Field4 (N)));
! Set_Field5 (New_N, Copy_Generic_Descendant (Field5 (N)));
if Instantiating
and then Nkind (N) = N_Subprogram_Body
--- 4701,4714 ----
New_N := Make_Null_Statement (Sloc (N));
else
! Copy_Descendants;
end if;
end;
-- For the remaining nodes, copy recursively their descendants.
else
! Copy_Descendants;
if Instantiating
and then Nkind (N) = N_Subprogram_Body