* [COMMITTED] ada: Fix infinite loop with multiple limited with clauses
@ 2023-10-10 12:14 Marc Poulhiès
0 siblings, 0 replies; only message in thread
From: Marc Poulhiès @ 2023-10-10 12:14 UTC (permalink / raw)
To: gcc-patches; +Cc: Eric Botcazou
From: Eric Botcazou <ebotcazou@adacore.com>
This occurs when one of the types has an incomplete declaration in addition
to its full declaration in its package. In this case AI05-129 says that the
incomplete type is not part of the limited view of the package, i.e. only
the full view is. Now, in the GNAT implementation, it's the opposite in the
regular view of the package, i.e. the incomplete type is the visible one.
That's why the implementation needs to also swap the types on the visibility
chain while it is swapping the views when the clauses are either installed
or removed. This works correctly for the installation, but does not for the
removal, so this change rewrites the code doing the latter.
gcc/ada/
PR ada/111434
* sem_ch10.adb (Replace): New procedure to replace an entity with
another on the homonym chain.
(Install_Limited_With_Clause): Rename Non_Lim_View to Typ for the
sake of consistency. Call Replace to do the replacements and split
the code into the regular and the special cases. Add debuggging
output controlled by -gnatdi.
(Install_With_Clause): Print the Parent_With and Implicit_With flags
in the debugging output controlled by -gnatdi.
(Remove_Limited_With_Unit.Restore_Chain_For_Shadow (Shadow)): Rewrite
using a direct replacement of E4 by E2. Call Replace to do the
replacements. Add debuggging output controlled by -gnatdi.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_ch10.adb | 170 +++++++++++++++++++++++++++----------------
1 file changed, 107 insertions(+), 63 deletions(-)
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index a6cbe466b75..ba4beae2851 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -238,6 +238,9 @@ package body Sem_Ch10 is
-- Reset all visibility flags on unit after compiling it, either as a main
-- unit or as a unit in the context.
+ procedure Replace (Old_E, New_E : Entity_Id);
+ -- Replace Old_E by New_E on visibility list
+
procedure Unchain (E : Entity_Id);
-- Remove single entity from visibility list
@@ -5310,15 +5313,12 @@ 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);
+ Typ : constant Entity_Id := Non_Limited_View (Lim_Typ);
Prev : Entity_Id;
begin
- Prev := Current_Entity (Lim_Typ);
-
- -- Replace Non_Lim_View in the homonyms list, so that the
+ -- Replace Typ by Lim_Typ in the homonyms list, so that the
-- limited view becomes available.
-- If the nonlimited view is a record with an anonymous
@@ -5350,38 +5350,47 @@ package body Sem_Ch10 is
--
-- [*] denotes the visible entity (Current_Entity)
- if Prev = Non_Lim_View
- or else
- (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_Current_Entity (Lim_Typ);
+ Prev := Current_Entity (Lim_Typ);
- else
- while Present (Homonym (Prev))
- and then Homonym (Prev) /= Non_Lim_View
- loop
- Prev := Homonym (Prev);
- end loop;
+ while Present (Prev) loop
+ -- This is a regular replacement
- Set_Homonym (Prev, Lim_Typ);
- end if;
+ if Prev = Typ
+ or else (Ekind (Prev) = E_Incomplete_Type
+ and then Full_View (Prev) = Typ)
+ then
+ Replace (Prev, Lim_Typ);
- Set_Homonym (Lim_Typ, Homonym (Non_Lim_View));
- end;
+ if Debug_Flag_I then
+ Write_Str (" (homonym) replace ");
+ Write_Name (Chars (Typ));
+ Write_Eol;
+ end if;
- if Debug_Flag_I then
- Write_Str (" (homonym) chain ");
- Write_Name (Chars (Lim_Typ));
- Write_Eol;
- end if;
+ exit;
+
+ -- This is where E1 is replaced with E4
+
+ elsif 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)) = Typ
+ then
+ Replace (Prev, Lim_Typ);
+
+ if Debug_Flag_I then
+ Write_Str (" (homonym) E1 -> E4 ");
+ Write_Name (Chars (Typ));
+ Write_Eol;
+ end if;
+
+ exit;
+ end if;
+
+ Prev := Homonym (Prev);
+ end loop;
+ end;
end if;
Next_Entity (Lim_Typ);
@@ -5474,6 +5483,10 @@ package body Sem_Ch10 is
if Debug_Flag_I then
if Private_Present (With_Clause) then
Write_Str ("install private withed unit ");
+ elsif Parent_With (With_Clause) then
+ Write_Str ("install parent withed unit ");
+ elsif Implicit_With (With_Clause) then
+ Write_Str ("install implicit withed unit ");
else
Write_Str ("install withed unit ");
end if;
@@ -6816,9 +6829,10 @@ package body Sem_Ch10 is
------------------------------
procedure Restore_Chain_For_Shadow (Shadow : Entity_Id) is
- Is_E3 : Boolean;
+ Typ : constant Entity_Id := Non_Limited_View (Shadow);
+ pragma Assert (not In_Chain (Typ));
+
Prev : Entity_Id;
- Typ : Entity_Id;
begin
-- If the package has incomplete types, the limited view of the
@@ -6827,9 +6841,8 @@ package body Sem_Ch10 is
-- 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,
- -- 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.
+ -- the visible entity E4 is replaced directly with E2 in the
+ -- the homonyms list and E3 is simply ignored.
--
-- regular views limited views
--
@@ -6842,40 +6855,42 @@ package body Sem_Ch10 is
--
-- [*] denotes the visible entity (Current_Entity)
- Typ := Non_Limited_View (Shadow);
- pragma Assert (not In_Chain (Typ));
+ Prev := Current_Entity (Shadow);
- Is_E3 := Nkind (Parent (Typ)) = N_Full_Type_Declaration
- and then Present (Incomplete_View (Parent (Typ)));
+ while Present (Prev) loop
+ -- This is a regular replacement
- Prev := Current_Entity (Shadow);
+ if Prev = Shadow then
+ Replace (Prev, Typ);
- if Prev = Shadow then
- if Is_E3 then
- Set_Name_Entity_Id (Chars (Prev), Homonym (Prev));
- return;
+ if Debug_Flag_I then
+ Write_Str (" (homonym) replace ");
+ Write_Name (Chars (Typ));
+ Write_Eol;
+ end if;
- else
- Set_Current_Entity (Typ);
- end if;
+ exit;
- else
- while Present (Homonym (Prev))
- and then Homonym (Prev) /= Shadow
- loop
- Prev := Homonym (Prev);
- end loop;
+ -- This is where E4 is replaced with E2
- if Is_E3 then
- Set_Homonym (Prev, Homonym (Shadow));
- return;
+ elsif Ekind (Prev) = E_Incomplete_Type
+ and then From_Limited_With (Prev)
+ and then Ekind (Typ) = E_Incomplete_Type
+ and then Full_View (Typ) = Non_Limited_View (Prev)
+ then
+ Replace (Prev, Typ);
- else
- Set_Homonym (Prev, Typ);
+ if Debug_Flag_I then
+ Write_Str (" (homonym) E4 -> E2 ");
+ Write_Name (Chars (Typ));
+ Write_Eol;
+ end if;
+
+ exit;
end if;
- end if;
- Set_Homonym (Typ, Homonym (Shadow));
+ Prev := Homonym (Prev);
+ end loop;
end Restore_Chain_For_Shadow;
--------------------
@@ -7177,6 +7192,35 @@ package body Sem_Ch10 is
null;
end sm;
+ -------------
+ -- Replace --
+ -------------
+
+ procedure Replace (Old_E, New_E : Entity_Id) is
+ Prev : Entity_Id;
+
+ begin
+ Prev := Current_Entity (Old_E);
+
+ if No (Prev) then
+ return;
+
+ elsif Prev = Old_E then
+ Set_Current_Entity (New_E);
+ Set_Homonym (New_E, Homonym (Old_E));
+
+ else
+ while Present (Prev) and then Homonym (Prev) /= Old_E loop
+ Prev := Homonym (Prev);
+ end loop;
+
+ if Present (Prev) then
+ Set_Homonym (Prev, New_E);
+ Set_Homonym (New_E, Homonym (Old_E));
+ end if;
+ end if;
+ end Replace;
+
-------------
-- Unchain --
-------------
--
2.42.0
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2023-10-10 12:15 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-10-10 12:14 [COMMITTED] ada: Fix infinite loop with multiple limited with clauses Marc Poulhiès
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).