public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r13-476] [Ada] Fix spurious error on limited view with incomplete type
@ 2022-05-16 8:43 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2022-05-16 8:43 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:82ca7489e71d4792b5f242c144bc5bf7b4c4b2c6
commit r13-476-g82ca7489e71d4792b5f242c144bc5bf7b4c4b2c6
Author: Eric Botcazou <ebotcazou@adacore.com>
Date: Thu Mar 3 15:57:47 2022 +0100
[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.
Diff:
---
gcc/ada/exp_ch3.adb | 3 +-
gcc/ada/sem_ch10.adb | 291 +++++++++++++++++++++++++++++----------------------
gcc/ada/sem_ch10.ads | 11 ++
gcc/ada/sem_ch3.adb | 48 +++++++--
gcc/ada/sem_ch6.adb | 30 ++++--
gcc/ada/sem_util.adb | 2 +-
gcc/ada/sinfo.ads | 6 +-
7 files changed, 243 insertions(+), 148 deletions(-)
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index d1b33883af1..018f88b1752 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -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
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index 9dbb87100a8..80a729fec0c 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -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);
diff --git a/gcc/ada/sem_ch10.ads b/gcc/ada/sem_ch10.ads
index bc8eec1bb00..3dfae84fc0a 100644
--- a/gcc/ada/sem_ch10.ads
+++ b/gcc/ada/sem_ch10.ads
@@ -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.
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 054648b34f4..d2605f5a308 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -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 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;
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 17e7d262534..be093d6863f 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -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 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 Is_Class_Wide_Type (Etyp)
- and then From_Limited_With (Etyp)
+ 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;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index b0cca0896e3..ea0a55a8e31 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -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
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index a5f348f33e6..dcfe75e6528 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -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
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2022-05-16 8:43 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-05-16 8:43 [gcc r13-476] [Ada] Fix spurious error on limited view with incomplete type Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).