From 39a974168f6929d8087c8f0eacc8a5cd01555532 Mon Sep 17 00:00:00 2001 From: Samuel Tardieu Date: Wed, 28 Nov 2007 20:43:25 +0000 Subject: re PR ada/15803 (Illegal program not detected, RM 8.3(19)) 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. From-SVN: r130495 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/par-ch3.adb | 19 +++++++++++++++++-- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gnat.dg/specs/variant_part.ads | 8 ++++++++ 4 files changed, 36 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/specs/variant_part.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 9ec4178..31f9d19 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2007-11-28 Samuel Tardieu + + 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. + 2007-11-26 Andreas Krebbel PR 34081/C++ diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb index b28c93e..910d161 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 parentheses 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 parentheses, 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/ChangeLog b/gcc/testsuite/ChangeLog index b1a58b8..fc5de7d 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2007-11-28 Samuel Tardieu + + PR ada/15803 + * gnat.dg/specs/variant_part.ads: New test. + 2007-11-28 Jakub Jelinek PR tree-optimization/34140 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; -- cgit v1.1