Skip to content

Commit 35e0295

Browse files
author
Eric Botcazou
committed
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.
1 parent 90f2ab4 commit 35e0295

File tree

2 files changed

+39
-27
lines changed

2 files changed

+39
-27
lines changed

gcc/ada/sem_res.adb

Lines changed: 25 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -658,6 +658,24 @@ package body Sem_Res is
658658
P : Node_Id;
659659
D : Node_Id;
660660

661+
procedure Check_Legality_In_Constraint (Alone : Boolean);
662+
-- RM 3.8(12/3): Check that the discriminant mentioned in a constraint
663+
-- appears alone as a direct name.
664+
665+
----------------------------------
666+
-- Check_Legality_In_Constraint --
667+
----------------------------------
668+
669+
procedure Check_Legality_In_Constraint (Alone : Boolean) is
670+
begin
671+
if not Alone then
672+
Error_Msg_N ("discriminant in constraint must appear alone", N);
673+
674+
elsif Nkind (N) = N_Expanded_Name and then Comes_From_Source (N) then
675+
Error_Msg_N ("discriminant must appear alone as a direct name", N);
676+
end if;
677+
end Check_Legality_In_Constraint;
678+
661679
begin
662680
-- Any use in a spec-expression is legal
663681

@@ -694,19 +712,11 @@ package body Sem_Res is
694712
-- processing for records). See Sem_Ch3.Build_Derived_Record_Type
695713
-- for more info.
696714

697-
if Ekind (Current_Scope) = E_Record_Type
698-
and then Scope (Disc) = Current_Scope
699-
and then not
700-
(Nkind (Parent (P)) = N_Subtype_Indication
701-
and then
702-
Nkind (Parent (Parent (P))) in N_Component_Definition
703-
| N_Subtype_Declaration
704-
and then Paren_Count (N) = 0)
705-
then
706-
Error_Msg_N
707-
("discriminant must appear alone in component constraint", N);
708-
return;
709-
end if;
715+
Check_Legality_In_Constraint
716+
(Nkind (Parent (P)) = N_Subtype_Indication
717+
and then Nkind (Parent (Parent (P))) in N_Component_Definition
718+
| N_Subtype_Declaration
719+
and then Paren_Count (N) = 0);
710720

711721
-- Detect a common error:
712722

@@ -817,18 +827,7 @@ package body Sem_Res is
817827
elsif Nkind (PN) in N_Index_Or_Discriminant_Constraint
818828
| N_Discriminant_Association
819829
then
820-
if Paren_Count (N) > 0 then
821-
Error_Msg_N
822-
("discriminant in constraint must appear alone", N);
823-
824-
elsif Nkind (N) = N_Expanded_Name
825-
and then Comes_From_Source (N)
826-
then
827-
Error_Msg_N
828-
("discriminant must appear alone as a direct name", N);
829-
end if;
830-
831-
return;
830+
Check_Legality_In_Constraint (Paren_Count (N) = 0);
832831

833832
-- Otherwise, context is an expression. It should not be within (i.e. a
834833
-- subexpression of) a constraint for a component.
@@ -863,8 +862,7 @@ package body Sem_Res is
863862
or else Nkind (P) = N_Entry_Declaration
864863
or else Nkind (D) = N_Defining_Identifier
865864
then
866-
Error_Msg_N
867-
("discriminant in constraint must appear alone", N);
865+
Check_Legality_In_Constraint (False);
868866
end if;
869867
end if;
870868
end Check_Discriminant_Use;
Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,14 @@
1+
-- { dg-do compile }
2+
3+
package Discr8 is
4+
5+
type T1 (N : Natural) is null record;
6+
7+
type T2 (N : Natural) is record
8+
C1 : string (1 .. T2.n); -- { dg-error "alone as a direct name" }
9+
C2 : string (1 .. n);
10+
C3 : T1 (T2.n); -- { dg-error "alone as a direct name" }
11+
C4 : T1 (n);
12+
end record;
13+
14+
end Discr8;

0 commit comments

Comments
 (0)