From c77a2cf0ec892256ef47edf373607d3b0a807210 Mon Sep 17 00:00:00 2001 From: squirek Date: Wed, 30 Oct 2024 16:33:29 +0000 Subject: 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. --- gcc/ada/exp_ch3.adb | 22 +++++++++++++++++----- 1 file changed, 17 insertions(+), 5 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 3dd4d9c..9d61d41 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 -- cgit v1.1