From 03308301c7bb2eed0bc8990db7038aac3a2dcb97 Mon Sep 17 00:00:00 2001 From: Justin Squirek Date: Tue, 18 Jun 2024 08:38:18 +0000 Subject: [PATCH] ada: Allow mutably tagged types to work with qualified expressions This patch modifies the experimental 'Size'Class feature such that objects of mutably tagged types can be assigned qualified expressions featuring a definite type (e.g. Mutable_Obj := Root_Child_T'(Root_T with others => <>)). gcc/ada/ * sem_ch5.adb: (Analyze_Assignment): Add special expansion for qualified expressions in certain cases dealing with mutably tagged types. --- gcc/ada/sem_ch5.adb | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 644bd21ce93..5739fe06ea2 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -697,6 +697,19 @@ package body Sem_Ch5 is then Resolve (Rhs, Base_Type (T1)); + -- When the right hand side is a qualified expression and the left hand + -- side is mutably tagged we force the right hand side to be class-wide + -- so that they are compatible both for the purposes of checking + -- legality rules as well as assignment expansion. + + elsif Is_Mutably_Tagged_Type (T1) + and then Nkind (Rhs) = N_Qualified_Expression + then + Make_Mutably_Tagged_Conversion (Rhs, T1); + Resolve (Rhs, T1); + + -- Otherwise, resolve the right hand side normally + else Resolve (Rhs, T1); end if; @@ -765,6 +778,7 @@ package body Sem_Ch5 is and then not Is_Class_Wide_Type (T2) and then not Is_Tag_Indeterminate (Rhs) and then not Is_Dynamically_Tagged (Rhs) + and then not Is_Mutably_Tagged_Type (T1) then Error_Msg_N ("dynamically tagged expression required!", Rhs); end if;