Commit 4de287c4 by Ed Schonberg Committed by Arnaud Charlet

sem_ch8.adb (Find_Direct_Name): Handle properly the case of a generic package…

sem_ch8.adb (Find_Direct_Name): Handle properly the case of a generic package that contains local declarations...

2005-07-07  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8.adb (Find_Direct_Name): Handle properly the case of a
	generic package that contains local declarations with the same name.
	(Analyze_Object_Renaming): Check wrong renaming of incomplete type.

From-SVN: r101698
parent 28be29ce
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -726,6 +726,16 @@ package body Sem_Ch8 is ...@@ -726,6 +726,16 @@ package body Sem_Ch8 is
end if; end if;
T2 := Etype (Nam); T2 := Etype (Nam);
-- (Ada 2005: AI-326): Handle wrong use of incomplete type
if Nkind (Nam) = N_Explicit_Dereference
and then Ekind (Etype (T2)) = E_Incomplete_Type
then
Error_Msg_N ("invalid use of incomplete type", Id);
return;
end if;
Set_Ekind (Id, E_Variable); Set_Ekind (Id, E_Variable);
Init_Size_Align (Id); Init_Size_Align (Id);
...@@ -861,7 +871,7 @@ package body Sem_Ch8 is ...@@ -861,7 +871,7 @@ package body Sem_Ch8 is
if Present (Renamed_Object (Old_P)) then if Present (Renamed_Object (Old_P)) then
Set_Renamed_Object (New_P, Renamed_Object (Old_P)); Set_Renamed_Object (New_P, Renamed_Object (Old_P));
else else
Set_Renamed_Object (New_P, Old_P); Set_Renamed_Object (New_P, Old_P);
end if; end if;
Set_Has_Completion (New_P); Set_Has_Completion (New_P);
...@@ -1349,16 +1359,16 @@ package body Sem_Ch8 is ...@@ -1349,16 +1359,16 @@ package body Sem_Ch8 is
Check_Fully_Conformant (New_S, Rename_Spec); Check_Fully_Conformant (New_S, Rename_Spec);
Set_Public_Status (New_S); Set_Public_Status (New_S);
-- Indicate that the entity in the declaration functions like -- Indicate that the entity in the declaration functions like the
-- the corresponding body, and is not a new entity. The body will -- corresponding body, and is not a new entity. The body will be
-- be constructed later at the freeze point, so indicate that -- constructed later at the freeze point, so indicate that the
-- the completion has not been seen yet. -- completion has not been seen yet.
Set_Ekind (New_S, E_Subprogram_Body); Set_Ekind (New_S, E_Subprogram_Body);
New_S := Rename_Spec; New_S := Rename_Spec;
Set_Has_Completion (Rename_Spec, False); Set_Has_Completion (Rename_Spec, False);
-- Ada 2005: check overriding indicator. -- Ada 2005: check overriding indicator
if Must_Override (Specification (N)) if Must_Override (Specification (N))
and then not Is_Overriding_Operation (Rename_Spec) and then not Is_Overriding_Operation (Rename_Spec)
...@@ -1385,10 +1395,10 @@ package body Sem_Ch8 is ...@@ -1385,10 +1395,10 @@ package body Sem_Ch8 is
end if; end if;
end if; end if;
-- There is no need for elaboration checks on the new entity, which -- There is no need for elaboration checks on the new entity, which may
-- may be called before the next freezing point where the body will -- be called before the next freezing point where the body will appear.
-- appear. Elaboration checks refer to the real entity, not the one -- Elaboration checks refer to the real entity, not the one created by
-- created by the renaming declaration. -- the renaming declaration.
Set_Kill_Elaboration_Checks (New_S, True); Set_Kill_Elaboration_Checks (New_S, True);
...@@ -1399,8 +1409,8 @@ package body Sem_Ch8 is ...@@ -1399,8 +1409,8 @@ package body Sem_Ch8 is
elsif Nkind (Nam) = N_Selected_Component then elsif Nkind (Nam) = N_Selected_Component then
-- Renamed entity is an entry or protected subprogram. For those -- Renamed entity is an entry or protected subprogram. For those
-- cases an explicit body is built (at the point of freezing of -- cases an explicit body is built (at the point of freezing of this
-- this entity) that contains a call to the renamed entity. -- entity) that contains a call to the renamed entity.
Analyze_Renamed_Entry (N, New_S, Present (Rename_Spec)); Analyze_Renamed_Entry (N, New_S, Present (Rename_Spec));
return; return;
...@@ -1430,9 +1440,8 @@ package body Sem_Ch8 is ...@@ -1430,9 +1440,8 @@ package body Sem_Ch8 is
end if; end if;
-- Most common case: subprogram renames subprogram. No body is -- Most common case: subprogram renames subprogram. No body is generated
-- generated in this case, so we must indicate that the declaration -- in this case, so we must indicate the declaration is complete as is.
-- is complete as is.
if No (Rename_Spec) then if No (Rename_Spec) then
Set_Has_Completion (New_S); Set_Has_Completion (New_S);
...@@ -1441,6 +1450,7 @@ package body Sem_Ch8 is ...@@ -1441,6 +1450,7 @@ package body Sem_Ch8 is
-- Find the renamed entity that matches the given specification. Disable -- Find the renamed entity that matches the given specification. Disable
-- Ada_83 because there is no requirement of full conformance between -- Ada_83 because there is no requirement of full conformance between
-- renamed entity and new entity, even though the same circuit is used. -- renamed entity and new entity, even though the same circuit is used.
-- This is a bit of a kludge, which introduces a really irregular use of -- This is a bit of a kludge, which introduces a really irregular use of
-- Ada_Version[_Explicit]. Would be nice to find cleaner way to do this -- Ada_Version[_Explicit]. Would be nice to find cleaner way to do this
-- ??? -- ???
...@@ -3274,10 +3284,9 @@ package body Sem_Ch8 is ...@@ -3274,10 +3284,9 @@ package body Sem_Ch8 is
elsif elsif
Is_Predefined_File_Name (Unit_File_Name (Current_Sem_Unit)) Is_Predefined_File_Name (Unit_File_Name (Current_Sem_Unit))
then then
-- A use-clause in the body of a system file creates a -- A use-clause in the body of a system file creates conflict
-- conflict with some entity in a user scope, while rtsfind -- with some entity in a user scope, while rtsfind is active.
-- is active. Keep only the entity that comes from another -- Keep only the entity coming from another predefined unit.
-- predefined unit.
E2 := E; E2 := E;
while Present (E2) loop while Present (E2) loop
...@@ -3291,7 +3300,7 @@ package body Sem_Ch8 is ...@@ -3291,7 +3300,7 @@ package body Sem_Ch8 is
E2 := Homonym (E2); E2 := Homonym (E2);
end loop; end loop;
-- Entity must exist because predefined unit is correct. -- Entity must exist because predefined unit is correct
raise Program_Error; raise Program_Error;
...@@ -3334,15 +3343,39 @@ package body Sem_Ch8 is ...@@ -3334,15 +3343,39 @@ package body Sem_Ch8 is
E2 := Homonym (E); E2 := Homonym (E);
while Present (E2) loop while Present (E2) loop
if Is_Immediately_Visible (E2) then if Is_Immediately_Visible (E2) then
for J in Level + 1 .. Scope_Stack.Last loop
if Scope_Stack.Table (J).Entity = Scope (E2) -- If a generic package contains a local declaration that
or else Scope_Stack.Table (J).Entity = E2 -- has the same name as the generic, there may be a visibility
then -- conflict in an instance, where the local declaration must
Level := J; -- also hide the name of the corresponding package renaming.
E := E2; -- We check explicitly for a package declared by a renaming,
exit; -- whose renamed entity is an instance that is on the scope
end if; -- stack, and that contains a homonym in the same scope. Once
end loop; -- we have found it, we know that the package renaming is not
-- immediately visible, and that the identifier denotes the
-- other entity (and its homonyms if overloaded).
if Scope (E) = Scope (E2)
and then Ekind (E) = E_Package
and then Present (Renamed_Object (E))
and then Is_Generic_Instance (Renamed_Object (E))
and then In_Open_Scopes (Renamed_Object (E))
and then Comes_From_Source (N)
then
Set_Is_Immediately_Visible (E, False);
E := E2;
else
for J in Level + 1 .. Scope_Stack.Last loop
if Scope_Stack.Table (J).Entity = Scope (E2)
or else Scope_Stack.Table (J).Entity = E2
then
Level := J;
E := E2;
exit;
end if;
end loop;
end if;
end if; end if;
E2 := Homonym (E2); E2 := Homonym (E2);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment