aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorJustin Squirek <squirek@adacore.com>2024-06-18 08:38:18 +0000
committerMarc Poulhiès <dkm@gcc.gnu.org>2024-07-02 15:20:35 +0200
commit03308301c7bb2eed0bc8990db7038aac3a2dcb97 (patch)
tree44bc82e89aea15f89081006a1c05a662a1bdf7b1 /gcc
parentd33104429a6662f33e05b9fcae65c87a87005749 (diff)
downloadgcc-03308301c7bb2eed0bc8990db7038aac3a2dcb97.zip
gcc-03308301c7bb2eed0bc8990db7038aac3a2dcb97.tar.gz
gcc-03308301c7bb2eed0bc8990db7038aac3a2dcb97.tar.bz2
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.
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/sem_ch5.adb14
1 files changed, 14 insertions, 0 deletions
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 644bd21..5739fe0 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;