OSDN Git Service

gcc/ada/
authorsam <sam@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 28 Nov 2007 20:43:25 +0000 (20:43 +0000)
committersam <sam@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 28 Nov 2007 20:43:25 +0000 (20:43 +0000)
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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@130495 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/ada/ChangeLog
gcc/ada/par-ch3.adb
gcc/testsuite/ChangeLog
gcc/testsuite/gnat.dg/specs/variant_part.ads [new file with mode: 0644]

index 9ec4178..31f9d19 100644 (file)
@@ -1,3 +1,9 @@
+2007-11-28  Samuel Tardieu  <sam@rfc1149.net>
+
+       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  <krebbel1@de.ibm.com>
 
         PR 34081/C++
index b28c93e..910d161 100644 (file)
@@ -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;
 
index b1a58b8..fc5de7d 100644 (file)
@@ -1,3 +1,8 @@
+2007-11-28  Samuel Tardieu  <sam@rfc1149.net>
+
+       PR ada/15803
+       * gnat.dg/specs/variant_part.ads: New test.
+
 2007-11-28  Jakub Jelinek  <jakub@redhat.com>
 
        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 (file)
index 0000000..b7ac16c
--- /dev/null
@@ -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;