https://gcc.gnu.org/g:c77a2cf0ec892256ef47edf373607d3b0a807210
commit r15-5161-gc77a2cf0ec892256ef47edf373607d3b0a807210
Author: squirek <squi...@adacore.com>
Date: Wed Oct 30 16:33:29 2024 +0000
ada: Compile time crash on limited object in extended return
This patch fixes an error in the compiler whereby using an extended return
on
an object of limited tagged type which extends a tagged protected type may
lead
to a compile-time crash.
gcc/ada/ChangeLog:
* exp_ch3.adb (Build_Assignment): Add condition to fetch
corresponding
record types for concurrent tagged types.
Diff:
---
gcc/ada/exp_ch3.adb | 22 +++++++++++++++++-----
1 file changed, 17 insertions(+), 5 deletions(-)
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 3dd4d9cd07e1..9d61d4174e98 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -2692,11 +2692,23 @@ package body Exp_Ch3 is
and then Tagged_Type_Expansion
and then Nkind (Exp_Q) /= N_Raise_Expression
then
- Append_To (Res,
- Make_Tag_Assignment_From_Type
- (Default_Loc,
- New_Copy_Tree (Lhs, New_Scope => Proc_Id),
- Underlying_Type (Typ)));
+ -- Get the relevant type for the call to
+ -- Make_Tag_Assignment_From_Type, which, for concurrent types is
+ -- their corresponding record.
+
+ declare
+ T : Entity_Id := Underlying_Type (Typ);
+ begin
+ if Ekind (T) in E_Protected_Type | E_Task_Type then
+ T := Corresponding_Record_Type (T);
+ end if;
+
+ Append_To (Res,
+ Make_Tag_Assignment_From_Type
+ (Default_Loc,
+ New_Copy_Tree (Lhs, New_Scope => Proc_Id),
+ T));
+ end;
end if;
-- Adjust the component if controlled except if it is an aggregate
