* stor-layout.c (initialize_sizetypes): Set SIZETYPE earlier,

[pf3gnuchains/gcc-fork.git] / gcc / ada / par-ch2.adb

diff --git a/gcc/ada/par-ch2.adb b/gcc/ada/par-ch2.adb
index 0eeacea..dd58e1f 100644 (file)
--- a/gcc/ada/par-ch2.adb
+++ b/gcc/ada/par-ch2.adb
@@ -6,9 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                            $Revision: 1.35 $                             --
---                                                                          --
---          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2003 Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -22,7 +20,7 @@
 -- MA 02111-1307, USA.                                                      --
 --                                                                          --
 -- GNAT was originally developed  by the GNAT team at  New York University. --
--- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
 --                                                                          --
 ------------------------------------------------------------------------------
 
@@ -49,7 +47,7 @@ package body Ch2 is
 
    --  Error recovery: can raise Error_Resync (cannot return Error)
 
-   function P_Identifier return Node_Id is
+   function P_Identifier (C : Id_Check := None) return Node_Id is
       Ident_Node : Node_Id;
 
    begin
@@ -63,7 +61,7 @@ package body Ch2 is
       --  If we have a reserved identifier, manufacture an identifier with
       --  a corresponding name after posting an appropriate error message
 
-      elsif Is_Reserved_Identifier then
+      elsif Is_Reserved_Identifier (C) then
          Scan_Reserved_Identifier (Force_Msg => False);
          Ident_Node := Token_Node;
          Scan; -- past the node
@@ -223,6 +221,26 @@ package body Ch2 is
       Semicolon_Loc : Source_Ptr;
       Ident_Node    : Node_Id;
       Assoc_Node    : Node_Id;
+      Result        : Node_Id;
+
+      procedure Skip_Pragma_Semicolon;
+      --  Skip past semicolon at end of pragma
+
+      ---------------------------
+      -- Skip_Pragma_Semicolon --
+      ---------------------------
+
+      procedure Skip_Pragma_Semicolon is
+      begin
+         if Token /= Tok_Semicolon then
+            T_Semicolon;
+            Resync_Past_Semicolon;
+         else
+            Scan; -- past semicolon
+         end if;
+      end Skip_Pragma_Semicolon;
+
+   --  Start of processing for P_Pragma
 
    begin
       Pragma_Node := New_Node (N_Pragma, Token_Ptr);
@@ -280,25 +298,44 @@ package body Ch2 is
             Scan; -- past comma
          end loop;
 
-         T_Right_Paren;
-      end if;
+         --  If we have := for pragma Debug, it is worth special casing
+         --  the error message (it is easy to think of pragma Debug as
+         --  taking a statement, and an assignment statement is the most
+         --  likely candidate for this error)
 
-      Semicolon_Loc := Token_Ptr;
+         if Token = Tok_Colon_Equal and then Pragma_Name = Name_Debug then
+            Error_Msg_SC ("argument for pragma Debug must be procedure call");
+            Resync_To_Semicolon;
 
-      if Token /= Tok_Semicolon then
-         T_Semicolon;
-         Resync_Past_Semicolon;
-      else
-         Scan; -- past semicolon
+         --  Normal case, we expect a right paren here
+
+         else
+            T_Right_Paren;
+         end if;
       end if;
 
-      if Is_Pragma_Name (Chars (Pragma_Node)) then
-         return Par.Prag (Pragma_Node, Semicolon_Loc);
+      Semicolon_Loc := Token_Ptr;
 
+      --  Now we have two tasks left, we need to scan out the semicolon
+      --  following the pragma, and we have to call Par.Prag to process
+      --  the pragma. Normally we do them in this order, however, there
+      --  is one exception namely pragma Style_Checks where we like to
+      --  skip the semicolon after processing the pragma, since that way
+      --  the style checks for the scanning of the semicolon follow the
+      --  settings of the pragma.
+
+      --  You might think we could just unconditionally do things in
+      --  the opposite order, but there are other pragmas, notably the
+      --  case of pragma Source_File_Name, which assume the semicolon
+      --  is already scanned out.
+
+      if Chars (Pragma_Node) = Name_Style_Checks then
+         Result := Par.Prag (Pragma_Node, Semicolon_Loc);
+         Skip_Pragma_Semicolon;
+         return Result;
       else
-         --  Unrecognized pragma, warning generated in Sem_Prag
-
-         return Pragma_Node;
+         Skip_Pragma_Semicolon;
+         return Par.Prag (Pragma_Node, Semicolon_Loc);
       end if;
 
    exception