diff options
| author | Javier Miranda <miranda@adacore.com> | 2024-01-07 13:37:15 +0000 |
|---|---|---|
| committer | Marc Poulhiès <poulhies@adacore.com> | 2024-05-07 09:55:52 +0200 |
| commit | 15a8d0dd59dd8c92600a89b6f5fe339e5ce74a11 (patch) | |
| tree | 7ae8468cef805d0aaa3c55fd1bcc69a8ee696b67 /gcc/ada | |
| parent | 26b2fa8d30b5fd84a371469721af7b8f5a41f06a (diff) | |
| download | gcc-15a8d0dd59dd8c92600a89b6f5fe339e5ce74a11.zip gcc-15a8d0dd59dd8c92600a89b6f5fe339e5ce74a11.tar.gz gcc-15a8d0dd59dd8c92600a89b6f5fe339e5ce74a11.tar.bz2 | |
ada: Reject non-statically compatible extended return statement
Add missing check of RM 6.5(5.3/5): when the result subtype of the
function is defined by a subtype mark, the subtype defined by the
subtype indication of the extended return statement shall be
statically compatible with the result subtype of the function.
gcc/ada/
* sem_ch3.adb (Check_Return_Subtype_Indication): Add missing check
on statically compatible subtypes.
* sem_eval.adb (Subtypes_Statically_Compatible): Ensure that both
types are either scalar types or access types to evaluate this
predicate.
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 25 | ||||
| -rw-r--r-- | gcc/ada/sem_eval.adb | 4 |
2 files changed, 27 insertions, 2 deletions
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 578c57c..c15f0bf 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -4129,6 +4129,31 @@ package body Sem_Ch3 is if not Subtypes_Statically_Match (Obj_Typ, R_Typ) then Error_No_Match (Indic); end if; + + -- If the result subtype of the function is defined by a + -- subtype_mark, the return_subtype_indication shall be a + -- subtype_indication. The subtype defined by the subtype_ + -- indication shall be statically compatible with the result + -- subtype of the function (RM 6.5(5.3/5)). + + -- We exclude the extended return statement of the predefined + -- stream input to avoid reporting spurious errors, because its + -- code is expanded on the basis of the base type (see subprogram + -- Stream_Base_Type). + + elsif Nkind (Indic) = N_Subtype_Indication + and then not Subtypes_Statically_Compatible (Obj_Typ, R_Typ) + and then not Is_TSS (Func_Id, TSS_Stream_Input) + then + Error_Msg_N + ("result subtype must be statically compatible with the " & + "function result type", Indic); + + if not Predicates_Compatible (Obj_Typ, R_Typ) then + Error_Msg_NE + ("\predicate on result subtype is not compatible with &", + Indic, R_Typ); + end if; end if; -- All remaining cases are illegal diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 42f2668..03006b6 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -6507,7 +6507,7 @@ package body Sem_Eval is -- Scalar types - elsif Is_Scalar_Type (T1) then + elsif Is_Scalar_Type (T1) and then Is_Scalar_Type (T2) then -- Definitely compatible if we match @@ -6560,7 +6560,7 @@ package body Sem_Eval is -- Access types - elsif Is_Access_Type (T1) then + elsif Is_Access_Type (T1) and then Is_Access_Type (T2) then return (not Is_Constrained (T2) or else Subtypes_Statically_Match |