https://gcc.gnu.org/g:35e029530f256bb6302a3cae650d7eaef5514a36
commit r16-5047-g35e029530f256bb6302a3cae650d7eaef5514a36 Author: Eric Botcazou <[email protected]> Date: Wed Nov 5 21:15:35 2025 +0100 Ada: Fix qualified name of discriminant incorrectly accepted in constraint The RM 3.8(12/3) subclause says that a discriminant mentioned in a constraint must appear alone as a direct name. The last part is not consistently checked and, while the first part is, it generates a slightly different error message depending on the form of the input. This fixes the last part and changes the first to use a single message. gcc/ada/ PR ada/35793 * sem_res.adb (Check_Discriminant_Use): In a constraint context, check that the discriminant appears alone as a direct name in all cases and give a consistent error message when it does not. gcc/testsuite/ * gnat.dg/specs/discr8.ads: New test. Diff: --- gcc/ada/sem_res.adb | 52 ++++++++++++++++------------------ gcc/testsuite/gnat.dg/specs/discr8.ads | 14 +++++++++ 2 files changed, 39 insertions(+), 27 deletions(-) diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index bf9d5e1c7a7d..301894b6bbd2 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -658,6 +658,24 @@ package body Sem_Res is P : Node_Id; D : Node_Id; + procedure Check_Legality_In_Constraint (Alone : Boolean); + -- RM 3.8(12/3): Check that the discriminant mentioned in a constraint + -- appears alone as a direct name. + + ---------------------------------- + -- Check_Legality_In_Constraint -- + ---------------------------------- + + procedure Check_Legality_In_Constraint (Alone : Boolean) is + begin + if not Alone then + Error_Msg_N ("discriminant in constraint must appear alone", N); + + elsif Nkind (N) = N_Expanded_Name and then Comes_From_Source (N) then + Error_Msg_N ("discriminant must appear alone as a direct name", N); + end if; + end Check_Legality_In_Constraint; + begin -- Any use in a spec-expression is legal @@ -694,19 +712,11 @@ package body Sem_Res is -- processing for records). See Sem_Ch3.Build_Derived_Record_Type -- for more info. - if Ekind (Current_Scope) = E_Record_Type - and then Scope (Disc) = Current_Scope - and then not - (Nkind (Parent (P)) = N_Subtype_Indication - and then - Nkind (Parent (Parent (P))) in N_Component_Definition - | N_Subtype_Declaration - and then Paren_Count (N) = 0) - then - Error_Msg_N - ("discriminant must appear alone in component constraint", N); - return; - end if; + Check_Legality_In_Constraint + (Nkind (Parent (P)) = N_Subtype_Indication + and then Nkind (Parent (Parent (P))) in N_Component_Definition + | N_Subtype_Declaration + and then Paren_Count (N) = 0); -- Detect a common error: @@ -817,18 +827,7 @@ package body Sem_Res is elsif Nkind (PN) in N_Index_Or_Discriminant_Constraint | N_Discriminant_Association then - if Paren_Count (N) > 0 then - Error_Msg_N - ("discriminant in constraint must appear alone", N); - - elsif Nkind (N) = N_Expanded_Name - and then Comes_From_Source (N) - then - Error_Msg_N - ("discriminant must appear alone as a direct name", N); - end if; - - return; + Check_Legality_In_Constraint (Paren_Count (N) = 0); -- Otherwise, context is an expression. It should not be within (i.e. a -- subexpression of) a constraint for a component. @@ -863,8 +862,7 @@ package body Sem_Res is or else Nkind (P) = N_Entry_Declaration or else Nkind (D) = N_Defining_Identifier then - Error_Msg_N - ("discriminant in constraint must appear alone", N); + Check_Legality_In_Constraint (False); end if; end if; end Check_Discriminant_Use; diff --git a/gcc/testsuite/gnat.dg/specs/discr8.ads b/gcc/testsuite/gnat.dg/specs/discr8.ads new file mode 100644 index 000000000000..889d37a25ae8 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/discr8.ads @@ -0,0 +1,14 @@ +-- { dg-do compile } + +package Discr8 is + + type T1 (N : Natural) is null record; + + type T2 (N : Natural) is record + C1 : string (1 .. T2.n); -- { dg-error "alone as a direct name" } + C2 : string (1 .. n); + C3 : T1 (T2.n); -- { dg-error "alone as a direct name" } + C4 : T1 (n); + end record; + +end Discr8;
