From: Ronan Desplanques <desplanq...@adacore.com> Before this patch, the compiler would fail to examine the corresponding record types of concurrent types when building aggregate components. This patch fixes this, and adds a precondition and additional documentation on the subprogram that triggered the crash, as it never makes sense to call it with a concurrent type.
gcc/ada/ * exp_aggr.adb (Initialize_Component): Use corresponding record types of concurrent types. * exp_util.ads (Make_Tag_Assignment_From_Type): Add precondition and extend documentation. Co-authored-by: Javier Miranda <mira...@adacore.com> Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_aggr.adb | 15 ++++++++++++--- gcc/ada/exp_util.ads | 8 ++++++-- 2 files changed, 18 insertions(+), 5 deletions(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index d61fbbc8c73..50063ed819e 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -8509,9 +8509,18 @@ package body Exp_Aggr is Set_No_Ctrl_Actions (Init_Stmt); if Tagged_Type_Expansion and then Is_Tagged_Type (Comp_Typ) then - Append_To (Blk_Stmts, - Make_Tag_Assignment_From_Type - (Loc, New_Copy_Tree (Comp), Underlying_Type (Comp_Typ))); + declare + Typ : Entity_Id := Underlying_Type (Comp_Typ); + + begin + if Is_Concurrent_Type (Typ) then + Typ := Corresponding_Record_Type (Typ); + end if; + + Append_To (Blk_Stmts, + Make_Tag_Assignment_From_Type + (Loc, New_Copy_Tree (Comp), Typ)); + end; end if; end if; diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index 267a127ec5e..d15e4f90865 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -941,9 +941,13 @@ package Exp_Util is function Make_Tag_Assignment_From_Type (Loc : Source_Ptr; Target : Node_Id; - Typ : Entity_Id) return Node_Id; + Typ : Entity_Id) return Node_Id + with + Pre => (not Is_Concurrent_Type (Typ)); -- Return an assignment of the tag of tagged type Typ to prefix Target, - -- which must be a record object of a descendant of Typ. + -- which must be a record object of a descendant of Typ. Typ cannot be a + -- concurrent type; for concurrent types, the corresponding record types + -- should be passed to this function instead. function Make_Variant_Comparison (Loc : Source_Ptr; -- 2.43.0