2005-06-14 Robert Dewar <dewar@adacore.com>

	PR ada/15613

	* par-ch2.adb (Scan_Pragma_Argument): New procedure
	(P_Pragma): Implement RM 2.8(4) check for no pos args after named args

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

diff --git a/gcc/ada/par-ch2.adb b/gcc/ada/par-ch2.adb
index 8b843e5..0790ead 100644 (file)
--- a/gcc/ada/par-ch2.adb
+++ b/gcc/ada/par-ch2.adb
@@ -33,7 +33,14 @@ package body Ch2 is
 
    --  Local functions, used only in this chapter
 
-   function P_Pragma_Argument_Association return Node_Id;
+   procedure Scan_Pragma_Argument_Association
+     (Identifier_Seen : in out Boolean;
+      Association     : out Node_Id);
+   --  Scans out a pragma argument association. Identifier_Seen is true on
+   --  entry if a previous association had an identifier, and gets set True if
+   --  the scanned association has an identifier (this is used to check the
+   --  rule that no associations without identifiers can follow an association
+   --  which has an identifier). The result is returned in Association.
 
    ---------------------
    -- 2.3  Identifier --
@@ -55,11 +62,12 @@ package body Ch2 is
 
       if Token = Tok_Identifier then
 
-         --  Ada 2005 (AI-284): Compiling in Ada95 mode we notify
-         --  that interface, overriding, and synchronized are
-         --  new reserved words
+         --  Ada 2005 (AI-284): Compiling in Ada95 mode we warn that INTERFACE,
+         --  OVERRIDING, and SYNCHRONIZED are new reserved words.
 
-         if Ada_Version = Ada_95 then
+         if Ada_Version = Ada_95
+           and then Warn_On_Ada_2005_Compatibility
+         then
             if Token_Name = Name_Overriding
               or else Token_Name = Name_Synchronized
               or else (Token_Name = Name_Interface
@@ -231,6 +239,10 @@ package body Ch2 is
       Arg_Count : Int := 0;
       --  Number of argument associations processed
 
+      Identifier_Seen : Boolean := False;
+      --  Set True if an identifier is encountered for a pragma argument. Used
+      --  to check that there are no more arguments without identifiers.
+
       Pragma_Node   : Node_Id;
       Pragma_Name   : Name_Id;
       Semicolon_Loc : Source_Ptr;
@@ -305,7 +317,7 @@ package body Ch2 is
 
          loop
             Arg_Count := Arg_Count + 1;
-            Assoc_Node := P_Pragma_Argument_Association;
+            Scan_Pragma_Argument_Association (Identifier_Seen, Assoc_Node);
 
             if Arg_Count = 2
               and then (Interface_Check_Required or else Import_Check_Required)
@@ -438,14 +450,16 @@ package body Ch2 is
 
    --  Error recovery: cannot raise Error_Resync
 
-   function P_Pragma_Argument_Association return Node_Id is
+   procedure Scan_Pragma_Argument_Association
+     (Identifier_Seen : in out Boolean;
+      Association     : out Node_Id)
+   is
       Scan_State      : Saved_Scan_State;
-      Pragma_Arg_Node : Node_Id;
       Identifier_Node : Node_Id;
 
    begin
-      Pragma_Arg_Node := New_Node (N_Pragma_Argument_Association, Token_Ptr);
-      Set_Chars (Pragma_Arg_Node, No_Name);
+      Association := New_Node (N_Pragma_Argument_Association, Token_Ptr);
+      Set_Chars (Association, No_Name);
 
       if Token = Tok_Identifier then
          Identifier_Node := Token_Node;
@@ -453,17 +467,24 @@ package body Ch2 is
          Scan; -- past Identifier
 
          if Token = Tok_Arrow then
+            Identifier_Seen := True;
             Scan; -- past arrow
-            Set_Chars (Pragma_Arg_Node, Chars (Identifier_Node));
+            Set_Chars (Association, Chars (Identifier_Node));
             Delete_Node (Identifier_Node);
+
+            --  Case of argument with no identifier
+
          else
             Restore_Scan_State (Scan_State); -- to Identifier
+
+            if Identifier_Seen then
+               Error_Msg_SC
+                 ("|pragma argument identifier required here ('R'M' 2.8(4))");
+            end if;
          end if;
       end if;
 
-      Set_Expression (Pragma_Arg_Node, P_Expression);
-      return Pragma_Arg_Node;
-
-   end P_Pragma_Argument_Association;
+      Set_Expression (Association, P_Expression);
+   end Scan_Pragma_Argument_Association;
 
 end Ch2;