2007-04-06 Ed Schonberg <schonberg@adacore.com>
* sem_ch10.adb (Install_Limited_Context_Clauses. Expand_Limited_With_Clause): Use a new copy of selector name in the call to Make_With_Clause. This fixes the tree structure for ASIS purposes. Nothing is changed in the compiler behaviour. (Process_Body_Clauses): Handle properly use clauses whose prefix is a package renaming. (Install_Limited_With_Clauses): Do not install non-limited view when it is still incomplete. From-SVN: r123592
This commit is contained in:
parent
53ff7b048c
commit
9915e6c758
@ -305,6 +305,28 @@ package body Sem_Ch10 is
|
||||
Subt_Mark : Node_Id;
|
||||
Use_Item : Node_Id;
|
||||
|
||||
function Same_Unit (N : Node_Id; P : Entity_Id) return Boolean;
|
||||
-- In an expanded name in a use clause, if the prefix is a
|
||||
-- renamed package, the entity is set to the original package
|
||||
-- as a result, when checking whether the package appears in a
|
||||
-- previous with_clause, the renaming has to be taken into
|
||||
-- account, to prevent spurious or incorrect warnings. The
|
||||
-- common case is the use of Text_IO.
|
||||
|
||||
---------------
|
||||
-- Same_Unit --
|
||||
---------------
|
||||
|
||||
function Same_Unit (N : Node_Id; P : Entity_Id) return Boolean is
|
||||
begin
|
||||
return Entity (N) = P
|
||||
or else
|
||||
(Present (Renamed_Object (P))
|
||||
and then Entity (N) = Renamed_Object (P));
|
||||
end Same_Unit;
|
||||
|
||||
-- Start of processing for Process_Body_Clauses
|
||||
|
||||
begin
|
||||
Used := False;
|
||||
Used_Type_Or_Elab := False;
|
||||
@ -338,7 +360,7 @@ package body Sem_Ch10 is
|
||||
|
||||
UE := Use_Item;
|
||||
while Nkind (UE) = N_Expanded_Name loop
|
||||
if Entity (Prefix (UE)) = Nam_Ent then
|
||||
if Same_Unit (Prefix (UE), Nam_Ent) then
|
||||
Used := True;
|
||||
exit;
|
||||
end if;
|
||||
@ -360,7 +382,7 @@ package body Sem_Ch10 is
|
||||
while Present (Subt_Mark)
|
||||
and then not Used_Type_Or_Elab
|
||||
loop
|
||||
if Entity (Prefix (Subt_Mark)) = Nam_Ent then
|
||||
if Same_Unit (Prefix (Subt_Mark), Nam_Ent) then
|
||||
Used_Type_Or_Elab := True;
|
||||
end if;
|
||||
|
||||
@ -3652,7 +3674,7 @@ package body Sem_Ch10 is
|
||||
Make_With_Clause (Loc,
|
||||
Name => Make_Selected_Component (Loc,
|
||||
Prefix => New_Copy_Tree (Prefix (Nam)),
|
||||
Selector_Name => Selector_Name (Nam)));
|
||||
Selector_Name => New_Copy (Selector_Name (Nam))));
|
||||
Set_Parent (Withn, Parent (N));
|
||||
end if;
|
||||
|
||||
@ -3767,21 +3789,31 @@ package body Sem_Ch10 is
|
||||
Def_Id := Defining_Identifier (Decl);
|
||||
Non_Lim_View := Non_Limited_View (Def_Id);
|
||||
|
||||
-- Convert an incomplete subtype declaration into a
|
||||
-- corresponding non-limited view subtype declaration.
|
||||
if not Is_Incomplete_Type (Non_Lim_View) then
|
||||
|
||||
Set_Subtype_Indication (Decl,
|
||||
New_Reference_To (Non_Lim_View, Sloc (Def_Id)));
|
||||
Set_Etype (Def_Id, Non_Lim_View);
|
||||
Set_Ekind (Def_Id, Subtype_Kind (Ekind (Non_Lim_View)));
|
||||
Set_Analyzed (Decl, False);
|
||||
-- Convert an incomplete subtype declaration into a
|
||||
-- corresponding non-limited view subtype declaration.
|
||||
-- This is usually the case when analyzing a body that
|
||||
-- has regular with-clauses, when the spec has limited
|
||||
-- ones.
|
||||
-- if the non-limited view is still incomplete, it is
|
||||
-- the dummy entry already created, and the declaration
|
||||
-- cannot be reanalyzed. This is the case when installing
|
||||
-- a parent unit that has limited with-clauses.
|
||||
|
||||
-- Reanalyze the declaration, suppressing the call to
|
||||
-- Enter_Name to avoid duplicate names.
|
||||
Set_Subtype_Indication (Decl,
|
||||
New_Reference_To (Non_Lim_View, Sloc (Def_Id)));
|
||||
Set_Etype (Def_Id, Non_Lim_View);
|
||||
Set_Ekind (Def_Id, Subtype_Kind (Ekind (Non_Lim_View)));
|
||||
Set_Analyzed (Decl, False);
|
||||
|
||||
Analyze_Subtype_Declaration
|
||||
(N => Decl,
|
||||
Skip => True);
|
||||
-- Reanalyze the declaration, suppressing the call to
|
||||
-- Enter_Name to avoid duplicate names.
|
||||
|
||||
Analyze_Subtype_Declaration
|
||||
(N => Decl,
|
||||
Skip => True);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Next (Decl);
|
||||
|
Loading…
Reference in New Issue
Block a user