From: Eric Botcazou <ebotcazou@adacore.com>
Date: Wed, 5 Nov 2025 20:15:35 +0000 (+0100)
Subject: Ada: Fix qualified name of discriminant incorrectly accepted in constraint
X-Git-Url: http://git.ipfire.org/gitweb.cgi?a=commitdiff_plain;h=35e029530f256bb6302a3cae650d7eaef5514a36;p=thirdparty%2Fgcc.git

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 --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index bf9d5e1c7a7..301894b6bbd 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 00000000000..889d37a25ae
--- /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;