OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

sem_res.adb (Resolve): special-case resolution of Null in an instance or an inlined body to avoid view... 

* 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.

From-SVN: r46509
This commit is contained in:
Ed Schonberg 2001-10-26 00:34:46 +00:00 committed by Geert Bosch
parent ce9e912264
commit 17be0cdf52
3 changed files with 71 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/ada/ChangeLog
View File

@ -1,3 +1,11 @@
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.
2001-10-25 Robert Dewar <dewar@gnat.com>
* sem_ch3.adb:

66
gcc/ada/sem_ch12.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- $Revision: 1.776 $
-- $Revision$
-- --
-- Copyright (C) 1992-2001, Free Software Foundation, Inc. --
-- --
@ -4197,6 +4197,9 @@ package body Sem_Ch12 is
-- 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,6 +4209,19 @@ package body Sem_Ch12 is
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,11 +4622,41 @@ package body Sem_Ch12 is
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,11 +4678,7 @@ package body Sem_Ch12 is
-- 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)));
Copy_Descendants;
-- Restore the original adjustment factor in case changed
@ -4659,22 +4701,14 @@ package body Sem_Ch12 is
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)));
Copy_Descendants;
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)));
Copy_Descendants;
if Instantiating
and then Nkind (N) = N_Subprogram_Body

14
gcc/ada/sem_res.adb
View File

@ -1670,6 +1670,18 @@ package body Sem_Res is
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
@ -4522,7 +4534,7 @@ package body Sem_Res is
begin
-- For now allow circumvention of the restriction against
-- anonymous null access values via a debug switch to allow
-- for easier trasition.
-- for easier transition.
if not Debug_Flag_J
and then Ekind (Typ) = E_Anonymous_Access_Type