https://gcc.gnu.org/g:cabca4dd5aa70e9a175a3802bb43a31a9370da5e
commit r15-9879-gcabca4dd5aa70e9a175a3802bb43a31a9370da5e
Author: Ronan Desplanques <desplanq...@adacore.com>
Date: Fri Apr 18 16:45:10 2025 +0200
ada: Fix crash on nested access-to-subprogram types
This patch fixes a crash on some subprograms with anonymous
access-to-subprogram parameters by removing delayed freezing of
subprograms in some cases where it wasn't necessary. The -gnatD output
for itypes is also improved.
gcc/ada/ChangeLog:
* sem_ch6.adb (Check_Delayed_Subprogram, Possible_Freeze): Restrict
cases where freezing is delayed.
* sem_ch6.ads (Check_Delayed_Subprogram): Improve documentation
comment.
* sprint.adb (Write_Itype): Improve output.
Diff:
---
gcc/ada/sem_ch6.adb | 13 +++++++------
gcc/ada/sem_ch6.ads | 5 ++---
gcc/ada/sprint.adb | 4 ++--
3 files changed, 11 insertions(+), 11 deletions(-)
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 05bbeeddae41..aed983f7a311 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -6319,12 +6319,6 @@ package body Sem_Ch6 is
elsif Has_Delayed_Freeze (T) and then not Is_Frozen (T) then
Set_Has_Delayed_Freeze (Designator);
-
- elsif Is_Access_Type (T)
- and then Has_Delayed_Freeze (Designated_Type (T))
- and then not Is_Frozen (Designated_Type (T))
- then
- Set_Has_Delayed_Freeze (Designator);
end if;
end Possible_Freeze;
@@ -6351,6 +6345,13 @@ package body Sem_Ch6 is
Next_Formal (F);
end loop;
+ -- RM 13.14 (15.1/6): the primitive subprograms of a tagged type are
+ -- frozen at the place where the type is frozen.
+
+ if Is_Dispatching_Operation (Designator) then
+ Set_Has_Delayed_Freeze (Designator);
+ end if;
+
-- Mark functions that return by reference. Note that it cannot be done
-- for delayed_freeze subprograms because the underlying returned type
-- may not be known yet (for private types).
diff --git a/gcc/ada/sem_ch6.ads b/gcc/ada/sem_ch6.ads
index bd4b730dc607..ee9b2ef2d759 100644
--- a/gcc/ada/sem_ch6.ads
+++ b/gcc/ada/sem_ch6.ads
@@ -64,9 +64,8 @@ package Sem_Ch6 is
-- respective counterparts.
procedure Check_Delayed_Subprogram (Designator : Entity_Id);
- -- Designator can be a E_Subprogram_Type, E_Procedure or E_Function. If a
- -- type in its profile depends on a private type without a full
- -- declaration, indicate that the subprogram or type is delayed.
+ -- Designator can be a E_Subprogram_Type, E_Procedure or E_Function. Set
+ -- Has_Delayed_Freeze on Designator if its freezing needs to be delayed.
procedure Check_Discriminant_Conformance
(N : Node_Id;
diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb
index 938d2b23910a..6b74be14b40c 100644
--- a/gcc/ada/sprint.adb
+++ b/gcc/ada/sprint.adb
@@ -4634,7 +4634,7 @@ package body Sprint is
Param : Entity_Id;
begin
- Param := First_Entity (Typ);
+ Param := First_Formal (Typ);
loop
Write_Id (Param);
Write_Str (" : ");
@@ -4646,7 +4646,7 @@ package body Sprint is
end if;
Write_Id (Etype (Param));
- Next_Entity (Param);
+ Next_Formal (Param);
exit when No (Param);
Write_Str (", ");
end loop;
