This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[PATCH] ada: Do not accept any discriminant names surrounded by parenthesis


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


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]