mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-04-03 10:20:42 +08:00
[Ada] Fix spurious error on limited view with incomplete type
The problem is that Install_Limited_With_Clause does not fully implement AI05-0129, in the case where a regular with clause is processed before a limited_with clause of the same package: the visible "shadow" entity is that of the incomplete type, instead of that of the full type per the AI. This requires adjusting Remove_Limited_With_Unit to match the change in Install_Limited_With_Clause and also Build_Incomplete_Type_Declaration, which is responsible for synthesizing incomplete types out of full type declarations for self-referential types. A small tweak is also needed in Analyze_Subprogram_Body_Helper to align it with an equivalent processing for CW types in Find_Type_Name. And the patch also changes the Incomplete_View field in full type declarations to point to the entity of the view instead of its declaration. gcc/ada/ * exp_ch3.adb (Build_Assignment): Adjust to the new definition of Incomplete_View field. * sem_ch10.ads (Decorate_Type): Declare. * sem_ch10.adb (Decorate_Type): Move to library level. (Install_Limited_With_Clause): In the already analyzed case, also deal with incomplete type declarations present in the sources and simplify the replacement code. (Build_Shadow_Entity): Deal with swapped views in package body. (Restore_Chain_For_Shadow): Deal with incomplete type declarations present in the sources. * sem_ch3.adb (Analyze_Full_Type_Declaration): Adjust to the new definition of Incomplete_View field. (Build_Incomplete_Type_Declaration): Small consistency tweak. Set the incomplete type as the Incomplete_View of the full type. If the scope is a package with a limited view, build a shadow entity for the incomplete type. * sem_ch6.adb (Analyze_Subprogram_Body_Helper): When replacing the limited view of a CW type as designated type of an anonymous access return type, get to the CW type of the incomplete view of the tagged type, if any. (Collect_Primitive_Operations): Adjust to the new definition of Incomplete_View field. * sinfo.ads (Incomplete_View): Denote the entity itself instead of its declaration. * sem_util.adb: Remove call to Defining_Entity.
This commit is contained in:
Eric Botcazou
Pierre-Marie de Rodat
parent
4e8b88f36c
commit
82ca7489e7
@ -2100,8 +2100,7 @@ package body Exp_Ch3 is
|
||||
and then Present (Incomplete_View (Parent (Rec_Type)))
|
||||
then
|
||||
Append_Elmt (
|
||||
N => Defining_Identifier
|
||||
(Incomplete_View (Parent (Rec_Type))),
|
||||
N => Incomplete_View (Parent (Rec_Type)),
|
||||
To => Map);
|
||||
Append_Elmt (
|
||||
N => Defining_Identifier
|
||||
|
||||
@ -3107,6 +3107,72 @@ package body Sem_Ch10 is
|
||||
end if;
|
||||
end Check_Stub_Level;
|
||||
|
||||
-------------------
|
||||
-- Decorate_Type --
|
||||
-------------------
|
||||
|
||||
procedure Decorate_Type
|
||||
(Ent : Entity_Id;
|
||||
Scop : Entity_Id;
|
||||
Is_Tagged : Boolean := False;
|
||||
Materialize : Boolean := False)
|
||||
is
|
||||
CW_Typ : Entity_Id;
|
||||
|
||||
begin
|
||||
-- An unanalyzed type or a shadow entity of a type is treated as an
|
||||
-- incomplete type, and carries the corresponding attributes.
|
||||
|
||||
Mutate_Ekind (Ent, E_Incomplete_Type);
|
||||
Set_Etype (Ent, Ent);
|
||||
Set_Full_View (Ent, Empty);
|
||||
Set_Is_First_Subtype (Ent);
|
||||
Set_Scope (Ent, Scop);
|
||||
Set_Stored_Constraint (Ent, No_Elist);
|
||||
Reinit_Size_Align (Ent);
|
||||
|
||||
if From_Limited_With (Ent) then
|
||||
Set_Private_Dependents (Ent, New_Elmt_List);
|
||||
end if;
|
||||
|
||||
-- A tagged type and its corresponding shadow entity share one common
|
||||
-- class-wide type. The list of primitive operations for the shadow
|
||||
-- entity is empty.
|
||||
|
||||
if Is_Tagged then
|
||||
Set_Is_Tagged_Type (Ent);
|
||||
Set_Direct_Primitive_Operations (Ent, New_Elmt_List);
|
||||
|
||||
CW_Typ :=
|
||||
New_External_Entity
|
||||
(E_Void, Scope (Ent), Sloc (Ent), Ent, 'C', 0, 'T');
|
||||
|
||||
Set_Class_Wide_Type (Ent, CW_Typ);
|
||||
|
||||
-- Set parent to be the same as the parent of the tagged type.
|
||||
-- We need a parent field set, and it is supposed to point to
|
||||
-- the declaration of the type. The tagged type declaration
|
||||
-- essentially declares two separate types, the tagged type
|
||||
-- itself and the corresponding class-wide type, so it is
|
||||
-- reasonable for the parent fields to point to the declaration
|
||||
-- in both cases.
|
||||
|
||||
Set_Parent (CW_Typ, Parent (Ent));
|
||||
|
||||
Mutate_Ekind (CW_Typ, E_Class_Wide_Type);
|
||||
Set_Class_Wide_Type (CW_Typ, CW_Typ);
|
||||
Set_Etype (CW_Typ, Ent);
|
||||
Set_Equivalent_Type (CW_Typ, Empty);
|
||||
Set_From_Limited_With (CW_Typ, From_Limited_With (Ent));
|
||||
Set_Has_Unknown_Discriminants (CW_Typ);
|
||||
Set_Is_First_Subtype (CW_Typ);
|
||||
Set_Is_Tagged_Type (CW_Typ);
|
||||
Set_Materialize_Entity (CW_Typ, Materialize);
|
||||
Set_Scope (CW_Typ, Scop);
|
||||
Reinit_Size_Align (CW_Typ);
|
||||
end if;
|
||||
end Decorate_Type;
|
||||
|
||||
------------------------
|
||||
-- Expand_With_Clause --
|
||||
------------------------
|
||||
@ -5021,9 +5087,8 @@ package body Sem_Ch10 is
|
||||
-- by the shadow ones.
|
||||
|
||||
-- This code must be kept synchronized with the code that replaces the
|
||||
-- shadow entities by the real entities (see body of Remove_Limited
|
||||
-- With_Clause); otherwise the contents of the homonym chains are not
|
||||
-- consistent.
|
||||
-- shadow entities by the real entities in Remove_Limited_With_Unit,
|
||||
-- otherwise the contents of the homonym chains are not consistent.
|
||||
|
||||
else
|
||||
-- Hide all the type entities of the public part of the package to
|
||||
@ -5060,14 +5125,16 @@ package body Sem_Ch10 is
|
||||
and then not Is_Child_Unit (Lim_Typ)
|
||||
then
|
||||
declare
|
||||
Non_Lim_View : constant Entity_Id :=
|
||||
Non_Limited_View (Lim_Typ);
|
||||
|
||||
Prev : Entity_Id;
|
||||
|
||||
begin
|
||||
Prev := Current_Entity (Lim_Typ);
|
||||
E := Prev;
|
||||
|
||||
-- Replace E in the homonyms list, so that the limited view
|
||||
-- becomes available.
|
||||
-- Replace Non_Lim_View in the homonyms list, so that the
|
||||
-- limited view becomes available.
|
||||
|
||||
-- If the nonlimited view is a record with an anonymous
|
||||
-- self-referential component, the analysis of the record
|
||||
@ -5076,31 +5143,53 @@ package body Sem_Ch10 is
|
||||
-- entity is now the incomplete type, and that is the one to
|
||||
-- replace in the visibility structure.
|
||||
|
||||
if E = Non_Limited_View (Lim_Typ)
|
||||
-- Similarly, if the source already contains the incomplete
|
||||
-- type declaration, the limited view of the incomplete type
|
||||
-- is in fact never visible (AI05-129) but we have created a
|
||||
-- shadow entity E1 for it that points to E2, the incomplete
|
||||
-- type at stake. This in turn has full view E3 that is the
|
||||
-- full declaration, with a corresponding shadow entity E4.
|
||||
-- When reinstalling the limited view, the visible entity E2
|
||||
-- is first replaced with E1, but E4 must eventually become
|
||||
-- the visible entity as per the AI and thus displace E1, as
|
||||
-- it is replacing E3 in the homonyms list.
|
||||
--
|
||||
-- regular views limited views
|
||||
--
|
||||
-- * E2 (incomplete) <-- E1 (shadow)
|
||||
--
|
||||
-- |
|
||||
-- V
|
||||
--
|
||||
-- E3 (full) <-- E4 (shadow) *
|
||||
--
|
||||
-- [*] denotes the visible entity (Current_Entity)
|
||||
|
||||
if Prev = Non_Lim_View
|
||||
or else
|
||||
(Ekind (E) = E_Incomplete_Type
|
||||
and then Full_View (E) = Non_Limited_View (Lim_Typ))
|
||||
(Ekind (Prev) = E_Incomplete_Type
|
||||
and then Full_View (Prev) = Non_Lim_View)
|
||||
or else
|
||||
(Ekind (Prev) = E_Incomplete_Type
|
||||
and then From_Limited_With (Prev)
|
||||
and then
|
||||
Ekind (Non_Limited_View (Prev)) = E_Incomplete_Type
|
||||
and then
|
||||
Full_View (Non_Limited_View (Prev)) = Non_Lim_View)
|
||||
then
|
||||
Set_Homonym (Lim_Typ, Homonym (Prev));
|
||||
Set_Current_Entity (Lim_Typ);
|
||||
|
||||
else
|
||||
while Present (Homonym (Prev))
|
||||
and then Homonym (Prev) /= Non_Lim_View
|
||||
loop
|
||||
E := Homonym (Prev);
|
||||
|
||||
-- E may have been removed when installing a previous
|
||||
-- limited_with_clause.
|
||||
|
||||
exit when No (E);
|
||||
exit when E = Non_Limited_View (Lim_Typ);
|
||||
Prev := Homonym (Prev);
|
||||
end loop;
|
||||
|
||||
if Present (E) then
|
||||
Set_Homonym (Lim_Typ, Homonym (Homonym (Prev)));
|
||||
Set_Homonym (Prev, Lim_Typ);
|
||||
end if;
|
||||
Set_Homonym (Prev, Lim_Typ);
|
||||
end if;
|
||||
|
||||
Set_Homonym (Lim_Typ, Homonym (Non_Lim_View));
|
||||
end;
|
||||
|
||||
if Debug_Flag_I then
|
||||
@ -5665,7 +5754,7 @@ package body Sem_Ch10 is
|
||||
-- Create a shadow entity that hides Ent and offers an abstract or
|
||||
-- incomplete view of Ent. Scop is the proper scope. Flag Is_Tagged
|
||||
-- should be set when Ent is a tagged type. The generated entity is
|
||||
-- added to Lim_Header. This routine updates the value of Last_Shadow.
|
||||
-- added to Shadow_Pack. The routine updates the value of Last_Shadow.
|
||||
|
||||
procedure Decorate_Package (Ent : Entity_Id; Scop : Entity_Id);
|
||||
-- Perform minimal decoration of a package or its corresponding shadow
|
||||
@ -5675,17 +5764,6 @@ package body Sem_Ch10 is
|
||||
-- Perform full decoration of an abstract state or its corresponding
|
||||
-- shadow entity denoted by Ent. Scop is the proper scope.
|
||||
|
||||
procedure Decorate_Type
|
||||
(Ent : Entity_Id;
|
||||
Scop : Entity_Id;
|
||||
Is_Tagged : Boolean := False;
|
||||
Materialize : Boolean := False);
|
||||
-- Perform minimal decoration of a type or its corresponding shadow
|
||||
-- entity denoted by Ent. Scop is the proper scope. Flag Is_Tagged
|
||||
-- should be set when Ent is a tagged type. Flag Materialize should be
|
||||
-- set when Ent is a tagged type and its class-wide type needs to appear
|
||||
-- in the tree.
|
||||
|
||||
procedure Decorate_Variable (Ent : Entity_Id; Scop : Entity_Id);
|
||||
-- Perform minimal decoration of a variable denoted by Ent. Scop is the
|
||||
-- proper scope.
|
||||
@ -5745,8 +5823,21 @@ package body Sem_Ch10 is
|
||||
Decorate_Package (Shadow, Scop);
|
||||
|
||||
elsif Is_Type (Ent) then
|
||||
Decorate_Type (Shadow, Scop, Is_Tagged);
|
||||
Set_Non_Limited_View (Shadow, Ent);
|
||||
Decorate_Type (Shadow, Scop, Is_Tagged);
|
||||
|
||||
-- If Ent is a private type and we are analyzing the body of its
|
||||
-- scope, its private and full views are swapped and, therefore,
|
||||
-- we need to undo this swapping in order to build the same shadow
|
||||
-- entity as we would have in other contexts.
|
||||
|
||||
if Is_Private_Type (Ent)
|
||||
and then Present (Full_View (Ent))
|
||||
and then In_Package_Body (Scop)
|
||||
then
|
||||
Set_Non_Limited_View (Shadow, Full_View (Ent));
|
||||
else
|
||||
Set_Non_Limited_View (Shadow, Ent);
|
||||
end if;
|
||||
|
||||
if Is_Tagged then
|
||||
Set_Non_Limited_View
|
||||
@ -5786,72 +5877,6 @@ package body Sem_Ch10 is
|
||||
Set_Encapsulating_State (Ent, Empty);
|
||||
end Decorate_State;
|
||||
|
||||
-------------------
|
||||
-- Decorate_Type --
|
||||
-------------------
|
||||
|
||||
procedure Decorate_Type
|
||||
(Ent : Entity_Id;
|
||||
Scop : Entity_Id;
|
||||
Is_Tagged : Boolean := False;
|
||||
Materialize : Boolean := False)
|
||||
is
|
||||
CW_Typ : Entity_Id;
|
||||
|
||||
begin
|
||||
-- An unanalyzed type or a shadow entity of a type is treated as an
|
||||
-- incomplete type, and carries the corresponding attributes.
|
||||
|
||||
Mutate_Ekind (Ent, E_Incomplete_Type);
|
||||
Set_Etype (Ent, Ent);
|
||||
Set_Full_View (Ent, Empty);
|
||||
Set_Is_First_Subtype (Ent);
|
||||
Set_Scope (Ent, Scop);
|
||||
Set_Stored_Constraint (Ent, No_Elist);
|
||||
Reinit_Size_Align (Ent);
|
||||
|
||||
if From_Limited_With (Ent) then
|
||||
Set_Private_Dependents (Ent, New_Elmt_List);
|
||||
end if;
|
||||
|
||||
-- A tagged type and its corresponding shadow entity share one common
|
||||
-- class-wide type. The list of primitive operations for the shadow
|
||||
-- entity is empty.
|
||||
|
||||
if Is_Tagged then
|
||||
Set_Is_Tagged_Type (Ent);
|
||||
Set_Direct_Primitive_Operations (Ent, New_Elmt_List);
|
||||
|
||||
CW_Typ :=
|
||||
New_External_Entity
|
||||
(E_Void, Scope (Ent), Sloc (Ent), Ent, 'C', 0, 'T');
|
||||
|
||||
Set_Class_Wide_Type (Ent, CW_Typ);
|
||||
|
||||
-- Set parent to be the same as the parent of the tagged type.
|
||||
-- We need a parent field set, and it is supposed to point to
|
||||
-- the declaration of the type. The tagged type declaration
|
||||
-- essentially declares two separate types, the tagged type
|
||||
-- itself and the corresponding class-wide type, so it is
|
||||
-- reasonable for the parent fields to point to the declaration
|
||||
-- in both cases.
|
||||
|
||||
Set_Parent (CW_Typ, Parent (Ent));
|
||||
|
||||
Mutate_Ekind (CW_Typ, E_Class_Wide_Type);
|
||||
Set_Class_Wide_Type (CW_Typ, CW_Typ);
|
||||
Set_Etype (CW_Typ, Ent);
|
||||
Set_Equivalent_Type (CW_Typ, Empty);
|
||||
Set_From_Limited_With (CW_Typ, From_Limited_With (Ent));
|
||||
Set_Has_Unknown_Discriminants (CW_Typ);
|
||||
Set_Is_First_Subtype (CW_Typ);
|
||||
Set_Is_Tagged_Type (CW_Typ);
|
||||
Set_Materialize_Entity (CW_Typ, Materialize);
|
||||
Set_Scope (CW_Typ, Scop);
|
||||
Reinit_Size_Align (CW_Typ);
|
||||
end if;
|
||||
end Decorate_Type;
|
||||
|
||||
-----------------------
|
||||
-- Decorate_Variable --
|
||||
-----------------------
|
||||
@ -6577,6 +6602,10 @@ package body Sem_Ch10 is
|
||||
-- Remove_Shadow_Entities_With_Restore --
|
||||
-----------------------------------------
|
||||
|
||||
-- This code must be kept synchronized with the code that replaces the
|
||||
-- real entities by the shadow entities in Install_Limited_With_Clause,
|
||||
-- otherwise the contents of the homonym chains are not consistent.
|
||||
|
||||
procedure Remove_Shadow_Entities_With_Restore (Pack_Id : Entity_Id) is
|
||||
procedure Restore_Chain_For_Shadow (Shadow : Entity_Id);
|
||||
-- Remove shadow entity Shadow by updating the entity and homonym
|
||||
@ -6599,44 +6628,61 @@ package body Sem_Ch10 is
|
||||
------------------------------
|
||||
|
||||
procedure Restore_Chain_For_Shadow (Shadow : Entity_Id) is
|
||||
Prev : Entity_Id;
|
||||
Typ : Entity_Id;
|
||||
Is_E3 : Boolean;
|
||||
Prev : Entity_Id;
|
||||
Typ : Entity_Id;
|
||||
|
||||
begin
|
||||
-- If the package has incomplete types, the limited view of the
|
||||
-- incomplete type is in fact never visible (AI05-129) but we
|
||||
-- have created a shadow entity E1 for it, that points to E2,
|
||||
-- a nonlimited incomplete type. This in turn has a full view
|
||||
-- E3 that is the full declaration. There is a corresponding
|
||||
-- the incomplete type at stake. This in turn has a full view
|
||||
-- E3 that is the full declaration, with a corresponding
|
||||
-- shadow entity E4. When reinstalling the nonlimited view,
|
||||
-- E2 must become the current entity and E3 must be ignored.
|
||||
-- the nonvisible entity E1 is first replaced with E2, but then
|
||||
-- E3 must *not* become the visible entity as it is replacing E4
|
||||
-- in the homonyms list and simply be ignored.
|
||||
--
|
||||
-- regular views limited views
|
||||
--
|
||||
-- * E2 (incomplete) <-- E1 (shadow)
|
||||
--
|
||||
-- |
|
||||
-- V
|
||||
--
|
||||
-- E3 (full) <-- E4 (shadow) *
|
||||
--
|
||||
-- [*] denotes the visible entity (Current_Entity)
|
||||
|
||||
Typ := Non_Limited_View (Shadow);
|
||||
|
||||
-- Shadow is the limited view of a full type declaration that has
|
||||
-- a previous incomplete declaration, i.e. E3 from the previous
|
||||
-- description. Nothing to insert.
|
||||
|
||||
if Present (Current_Entity (Typ))
|
||||
and then Ekind (Current_Entity (Typ)) = E_Incomplete_Type
|
||||
and then Full_View (Current_Entity (Typ)) = Typ
|
||||
then
|
||||
return;
|
||||
end if;
|
||||
|
||||
pragma Assert (not In_Chain (Typ));
|
||||
|
||||
Is_E3 := Nkind (Parent (Typ)) = N_Full_Type_Declaration
|
||||
and then Present (Incomplete_View (Parent (Typ)));
|
||||
|
||||
Prev := Current_Entity (Shadow);
|
||||
|
||||
if Prev = Shadow then
|
||||
Set_Current_Entity (Typ);
|
||||
if Is_E3 then
|
||||
Set_Name_Entity_Id (Chars (Prev), Homonym (Prev));
|
||||
return;
|
||||
|
||||
else
|
||||
Set_Current_Entity (Typ);
|
||||
end if;
|
||||
|
||||
else
|
||||
while Present (Prev) and then Homonym (Prev) /= Shadow loop
|
||||
while Present (Homonym (Prev))
|
||||
and then Homonym (Prev) /= Shadow
|
||||
loop
|
||||
Prev := Homonym (Prev);
|
||||
end loop;
|
||||
|
||||
if Present (Prev) then
|
||||
if Is_E3 then
|
||||
Set_Homonym (Prev, Homonym (Shadow));
|
||||
return;
|
||||
|
||||
else
|
||||
Set_Homonym (Prev, Typ);
|
||||
end if;
|
||||
end if;
|
||||
@ -6760,9 +6806,6 @@ package body Sem_Ch10 is
|
||||
-- and the previously hidden entities must be entered back into direct
|
||||
-- visibility.
|
||||
|
||||
-- WARNING: This code must be kept synchronized with that of routine
|
||||
-- Install_Limited_Withed_Clause.
|
||||
|
||||
if Analyzed (Pack_Decl) then
|
||||
Remove_Shadow_Entities_With_Restore (Pack_Id);
|
||||
|
||||
|
||||
@ -34,6 +34,17 @@ package Sem_Ch10 is
|
||||
procedure Analyze_Protected_Body_Stub (N : Node_Id);
|
||||
procedure Analyze_Subunit (N : Node_Id);
|
||||
|
||||
procedure Decorate_Type
|
||||
(Ent : Entity_Id;
|
||||
Scop : Entity_Id;
|
||||
Is_Tagged : Boolean := False;
|
||||
Materialize : Boolean := False);
|
||||
-- Perform minimal decoration of a type or its corresponding shadow
|
||||
-- entity denoted by Ent. Scop is the proper scope. Flag Is_Tagged
|
||||
-- should be set when Ent is a tagged type. Flag Materialize should be
|
||||
-- set when Ent is a tagged type and its class-wide type needs to appear
|
||||
-- in the tree.
|
||||
|
||||
procedure Install_Context (N : Node_Id; Chain : Boolean := True);
|
||||
-- Installs the entities from the context clause of the given compilation
|
||||
-- unit into the visibility chains. This is done before analyzing a unit.
|
||||
|
||||
@ -61,6 +61,7 @@ with Sem_Cat; use Sem_Cat;
|
||||
with Sem_Ch6; use Sem_Ch6;
|
||||
with Sem_Ch7; use Sem_Ch7;
|
||||
with Sem_Ch8; use Sem_Ch8;
|
||||
with Sem_Ch10; use Sem_Ch10;
|
||||
with Sem_Ch13; use Sem_Ch13;
|
||||
with Sem_Dim; use Sem_Dim;
|
||||
with Sem_Disp; use Sem_Disp;
|
||||
@ -3158,7 +3159,7 @@ package body Sem_Ch3 is
|
||||
and then Present (Full_View (Prev))
|
||||
then
|
||||
T := Full_View (Prev);
|
||||
Set_Incomplete_View (N, Parent (Prev));
|
||||
Set_Incomplete_View (N, Prev);
|
||||
else
|
||||
T := Prev;
|
||||
end if;
|
||||
@ -11600,10 +11601,9 @@ package body Sem_Ch3 is
|
||||
|
||||
if H = Typ then
|
||||
Set_Name_Entity_Id (Chars (Typ), Homonym (Typ));
|
||||
|
||||
else
|
||||
while Present (H)
|
||||
and then Homonym (H) /= Typ
|
||||
loop
|
||||
while Present (Homonym (H)) and then Homonym (H) /= Typ loop
|
||||
H := Homonym (Typ);
|
||||
end loop;
|
||||
|
||||
@ -11613,16 +11613,48 @@ package body Sem_Ch3 is
|
||||
Insert_Before (Typ_Decl, Decl);
|
||||
Analyze (Decl);
|
||||
Set_Full_View (Inc_T, Typ);
|
||||
Set_Incomplete_View (Typ_Decl, Inc_T);
|
||||
|
||||
-- If the type is tagged, create a common class-wide type for
|
||||
-- both views, and set the Etype of the class-wide type to the
|
||||
-- full view.
|
||||
|
||||
if Is_Tagged then
|
||||
|
||||
-- Create a common class-wide type for both views, and set the
|
||||
-- Etype of the class-wide type to the full view.
|
||||
|
||||
Make_Class_Wide_Type (Inc_T);
|
||||
Set_Class_Wide_Type (Typ, Class_Wide_Type (Inc_T));
|
||||
Set_Etype (Class_Wide_Type (Typ), Typ);
|
||||
end if;
|
||||
|
||||
-- If the scope is a package with a limited view, create a shadow
|
||||
-- entity for the incomplete type like Build_Limited_Views, so as
|
||||
-- to make it possible for Remove_Limited_With_Unit to reinstall
|
||||
-- this incomplete type as the visible entity.
|
||||
|
||||
if Ekind (Scope (Inc_T)) = E_Package
|
||||
and then Present (Limited_View (Scope (Inc_T)))
|
||||
then
|
||||
declare
|
||||
Shadow : constant Entity_Id := Make_Temporary (Loc, 'Z');
|
||||
|
||||
begin
|
||||
-- This is modeled on Build_Shadow_Entity
|
||||
|
||||
Set_Chars (Shadow, Chars (Inc_T));
|
||||
Set_Parent (Shadow, Decl);
|
||||
Decorate_Type (Shadow, Scope (Inc_T), Is_Tagged);
|
||||
Set_Is_Internal (Shadow);
|
||||
Set_From_Limited_With (Shadow);
|
||||
Set_Non_Limited_View (Shadow, Inc_T);
|
||||
Set_Private_Dependents (Shadow, New_Elmt_List);
|
||||
|
||||
if Is_Tagged then
|
||||
Set_Non_Limited_View
|
||||
(Class_Wide_Type (Shadow), Class_Wide_Type (Inc_T));
|
||||
end if;
|
||||
|
||||
Append_Entity (Shadow, Limited_View (Scope (Inc_T)));
|
||||
end;
|
||||
end if;
|
||||
end if;
|
||||
end Build_Incomplete_Type_Declaration;
|
||||
|
||||
|
||||
@ -3733,6 +3733,7 @@ package body Sem_Ch6 is
|
||||
|
||||
procedure Detect_And_Exchange (Id : Entity_Id) is
|
||||
Typ : constant Entity_Id := Etype (Id);
|
||||
|
||||
begin
|
||||
if From_Limited_With (Typ)
|
||||
and then Has_Non_Limited_View (Typ)
|
||||
@ -5189,23 +5190,34 @@ package body Sem_Ch6 is
|
||||
-- is the limited view of a class-wide type and the non-limited view is
|
||||
-- available, update the return type accordingly.
|
||||
|
||||
if Ada_Version >= Ada_2005 and then Present (Spec_Id) then
|
||||
if Ada_Version >= Ada_2005
|
||||
and then Present (Spec_Id)
|
||||
and then Ekind (Etype (Spec_Id)) = E_Anonymous_Access_Type
|
||||
then
|
||||
declare
|
||||
Etyp : Entity_Id;
|
||||
Rtyp : Entity_Id;
|
||||
|
||||
begin
|
||||
Rtyp := Etype (Spec_Id);
|
||||
Etyp := Directly_Designated_Type (Etype (Spec_Id));
|
||||
|
||||
if Ekind (Rtyp) = E_Anonymous_Access_Type then
|
||||
Etyp := Directly_Designated_Type (Rtyp);
|
||||
if Is_Class_Wide_Type (Etyp)
|
||||
and then From_Limited_With (Etyp)
|
||||
and then Has_Non_Limited_View (Etyp)
|
||||
then
|
||||
Desig_View := Etyp;
|
||||
Etyp := Non_Limited_View (Etyp);
|
||||
|
||||
if Is_Class_Wide_Type (Etyp)
|
||||
and then From_Limited_With (Etyp)
|
||||
-- If the class-wide type has been created by the completion of
|
||||
-- an incomplete tagged type declaration, get the class-wide
|
||||
-- type of the incomplete tagged type to match Find_Type_Name.
|
||||
|
||||
if Nkind (Parent (Etyp)) = N_Full_Type_Declaration
|
||||
and then Present (Incomplete_View (Parent (Etyp)))
|
||||
then
|
||||
Desig_View := Etyp;
|
||||
Set_Directly_Designated_Type (Rtyp, Available_View (Etyp));
|
||||
Etyp := Class_Wide_Type (Incomplete_View (Parent (Etyp)));
|
||||
end if;
|
||||
|
||||
Set_Directly_Designated_Type (Etype (Spec_Id), Etyp);
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
|
||||
@ -6475,7 +6475,7 @@ package body Sem_Util is
|
||||
elsif Nkind (Parent (B_Type)) = N_Full_Type_Declaration
|
||||
and then Present (Incomplete_View (Parent (B_Type)))
|
||||
then
|
||||
Id := Defining_Entity (Incomplete_View (Parent (B_Type)));
|
||||
Id := Incomplete_View (Parent (B_Type));
|
||||
|
||||
-- If T is a derived from a type with an incomplete view declared
|
||||
-- elsewhere, that incomplete view is irrelevant, we want the
|
||||
|
||||
@ -1536,10 +1536,8 @@ package Sinfo is
|
||||
|
||||
-- Incomplete_View
|
||||
-- Present in full type declarations that are completions of incomplete
|
||||
-- type declarations. Denotes the corresponding incomplete type
|
||||
-- declaration. Used to simplify the retrieval of primitive operations
|
||||
-- that may be declared between the partial and the full view of an
|
||||
-- untagged type.
|
||||
-- type declarations. Denotes the corresponding incomplete view declared
|
||||
-- by the incomplete declaration.
|
||||
|
||||
-- Inherited_Discriminant
|
||||
-- This flag is present in N_Component_Association nodes. It indicates
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user