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 --
------------------------
-- 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
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
-- 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
-- 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
-- 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.
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
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 --
-----------------------
-- 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
------------------------------
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;
-- 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);
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;
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;
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;
Insert_Before (Typ_Decl, Decl);
Analyze (Decl);
Set_Full_View (Inc_T, Typ);
+ Set_Incomplete_View (Typ_Decl, Inc_T);
- 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.
+ -- 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
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;
projects / thirdparty / gcc.git / commitdiff
