This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[PATCH] ada: Do not accept any discriminant names surrounded by parenthesis
- From: Samuel Tardieu <sam at rfc1149 dot net>
- To: gcc-patches at gcc dot gnu dot org
- Date: Mon, 26 Nov 2007 22:56:00 +0100
- Subject: [PATCH] ada: Do not accept any discriminant names surrounded by parenthesis
- Organisation: RFC1149 (see http://www.rfc1149.net/)
In a variant_part, a discriminant_direct_name may not be surrounded by
parenthesis.
gcc/ada/
PR ada/15803
* par-ch3.adb (P_Variant_Part): Signal an error when anything other
than an identifier is used after "case" in a variant_part.
gcc/testsuite/
PR ada/15803
* gnat.dg/specs/variant_part.ads: New test.
---
gcc/ada/par-ch3.adb | 19 +++++++++++++++++--
gcc/testsuite/gnat.dg/specs/variant_part.ads | 8 ++++++++
2 files changed, 25 insertions(+), 2 deletions(-)
create mode 100644 gcc/testsuite/gnat.dg/specs/variant_part.ads
diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb
index b28c93e..2ee275f 100644
--- a/gcc/ada/par-ch3.adb
+++ b/gcc/ada/par-ch3.adb
@@ -3395,6 +3395,7 @@ package body Ch3 is
Variant_Part_Node : Node_Id;
Variants_List : List_Id;
Case_Node : Node_Id;
+ Ident_Token : Token_Type;
begin
Variant_Part_Node := New_Node (N_Variant_Part, Token_Ptr);
@@ -3404,11 +3405,25 @@ package body Ch3 is
Scope.Table (Scope.Last).Ecol := Start_Column;
Scan; -- past CASE
+
+ -- A discriminant name between parenthesis will be returned as
+ -- a N_Identifier although it is not allowed by RM 3.8.1. We
+ -- save the token type to check it later. However, in case of
+ -- a discriminant name with parenthesis, we can continue the
+ -- analysis as if only the discriminant name had been given.
+
+ Ident_Token := Token;
Case_Node := P_Expression;
- Set_Name (Variant_Part_Node, Case_Node);
- if Nkind (Case_Node) /= N_Identifier then
+ if Nkind (Case_Node) = N_Identifier then
+ Set_Name (Variant_Part_Node, Case_Node);
+ else
Set_Name (Variant_Part_Node, Error);
+ end if;
+
+ if Nkind (Case_Node) /= N_Identifier
+ or else Ident_Token /= Tok_Identifier
+ then
Error_Msg ("discriminant name expected", Sloc (Case_Node));
end if;
diff --git a/gcc/testsuite/gnat.dg/specs/variant_part.ads b/gcc/testsuite/gnat.dg/specs/variant_part.ads
new file mode 100644
index 0000000..b7ac16c
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/variant_part.ads
@@ -0,0 +1,8 @@
+-- { dg-do compile }
+package Variant_Part is
+ type T1(b: boolean) is record
+ case (b) is -- { dg-error "discriminant name expected" }
+ when others => null;
+ end case;
+ end record;
+end Variant_Part;
--
1.5.3.6