diff options
Diffstat (limited to 'gcc/ada/sem_res.adb')
| -rw-r--r-- | gcc/ada/sem_res.adb | 17 |
1 files changed, 17 insertions, 0 deletions
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index d2eca7c..a0dd1f7 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -47,6 +47,7 @@ with Itypes; use Itypes; with Lib; use Lib; with Lib.Xref; use Lib.Xref; with Local_Restrict; +with Mutably_Tagged; use Mutably_Tagged; with Namet; use Namet; with Nmake; use Nmake; with Nlists; use Nlists; @@ -5034,12 +5035,21 @@ package body Sem_Res is -- Skip this check on helpers and indirect-call wrappers built to -- support class-wide preconditions. + -- We make special exception here for mutably tagged types and + -- related calls to their initialization procedures. + if (Is_Class_Wide_Type (A_Typ) or else Is_Dynamically_Tagged (A)) and then not Is_Class_Wide_Type (F_Typ) and then not Is_Controlling_Formal (F) and then not In_Instance and then (not Is_Subprogram (Nam) or else No (Class_Preconditions_Subprogram (Nam))) + + -- Ignore mutably tagged types and their use in calls to init + -- procs. + + and then not Is_Mutably_Tagged_CW_Equivalent_Type (A_Typ) + and then not Is_Init_Proc (Nam) then Error_Msg_N ("class-wide argument not allowed here!", A); @@ -14069,6 +14079,13 @@ package body Sem_Res is end; end if; + -- When we encounter a class-wide equivalent type used to represent + -- a fully sized mutably tagged type, pretend we are actually looking + -- at the class-wide mutably tagged type instead. + + Opnd_Type := + Get_Corresponding_Mutably_Tagged_Type_If_Present (Opnd_Type); + -- Deal with conversion of integer type to address if the pragma -- Allow_Integer_Address is in effect. We convert the conversion to -- an unchecked conversion in this case and we are all done. |