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]

committed: ada updates


Parser improvements and new package.

--
2003-10-30  Vasiliy Fofanov  <fofanov@act-europe.fr>

	* 3vtrasym.adb: 
	Demangle Ada symbols returned by TBK$SYMBOLIZE. Correctly align line
	numbers when symbol name is too long.

2003-10-30  Ed Falis  <falis@gnat.com>

	* g-signal.ads, g-signal.adb: New files

	* impunit.adb: (Non_Imp_File_Names): Added "g-signal"

	* Makefile.rtl: Introduce GNAT.Signals

2003-10-30  Robert Dewar  <dewar@gnat.com>

	* freeze.adb: Minor reformatting

	* lib-writ.adb (Write_ALI): Never write ali file if -gnats is specified

	* par.adb, par-ch12.adb, par-ch13.adb, par-ch2.adb, par-ch3.adb, 
	par-ch5.adb, par-ch6.adb, par-ch9.adb, par-util.adb: 
	New handling of Id_Check parameter to improve recognition of keywords
	used as identifiers.
	Update copyright notice to include 2003
--
Index: 3vtrasym.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/3vtrasym.adb,v
retrieving revision 1.2
diff -u -c -3 -p -r1.2 3vtrasym.adb
*** 3vtrasym.adb	29 Oct 2003 10:26:12 -0000	1.2
--- 3vtrasym.adb	30 Oct 2003 11:49:50 -0000
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 1999-2003 Ada Core Technologies, 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --           Copyright (C) 1999-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- --
***************
*** 26,32 ****
  -- however invalidate  any other reasons why  the executable file  might be --
  -- covered by the  GNU Public License.                                      --
  --                                                                          --
! -- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com).   --
  --                                                                          --
  ------------------------------------------------------------------------------
  
--- 26,33 ----
  -- however invalidate  any other reasons why  the executable file  might be --
  -- covered by the  GNU Public License.                                      --
  --                                                                          --
! -- GNAT was originally developed  by the GNAT team at  New York University. --
! -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  --                                                                          --
  ------------------------------------------------------------------------------
  
*************** package body GNAT.Traceback.Symbolic is
*** 96,107 ****
         Value, Value),
         User_Act_Proc);
  
     ------------------------
     -- Symbolic_Traceback --
     ------------------------
  
     function Symbolic_Traceback (Traceback : Tracebacks_Array) return String is
!       Status       : Cond_Value_Type;
        Image_Name        : ASCIC;
        Image_Name_Addr   : Address;
        Module_Name       : ASCIC;
--- 97,179 ----
         Value, Value),
         User_Act_Proc);
  
+    function Demangle_Ada (Mangled : String) return String;
+    --  Demangles an Ada symbol. Removes leading "_ada_" and trailing
+    --  __{DIGIT}+ or ${DIGIT}+, converts other "__" to '.'
+ 
+ 
+    ------------------
+    -- Demangle_Ada --
+    ------------------
+ 
+    function Demangle_Ada (Mangled : String) return String is
+       Demangled : String (1 .. Mangled'Length);
+       Pos  : Integer := Mangled'First;
+       Last : Integer := Mangled'Last;
+       DPos : Integer := 1;
+    begin
+ 
+       if Pos > Last then
+          return "";
+       end if;
+ 
+       --  Skip leading _ada_
+ 
+       if Mangled'Length > 4 and then Mangled (Pos .. Pos + 4) = "_ada_" then
+          Pos := Pos + 5;
+       end if;
+ 
+       --  Skip trailing __{DIGIT}+ or ${DIGIT}+
+ 
+       if Mangled (Last) in '0' .. '9' then
+ 
+          for J in reverse Pos + 2 .. Last - 1 loop
+ 
+             case Mangled (J) is
+                when '0' .. '9' =>
+                   null;
+                when '$' =>
+                   Last := J - 1;
+                   exit;
+                when '_' =>
+                   if Mangled (J - 1) = '_' then
+                      Last := J - 2;
+                   end if;
+                   exit;
+                when others =>
+                   exit;
+             end case;
+ 
+          end loop;
+ 
+       end if;
+ 
+       --  Now just copy Mangled to Demangled, converting "__" to '.' on the fly
+ 
+       while Pos <= Last loop
+ 
+          if Mangled (Pos) = '_' and then Mangled (Pos + 1) = '_'
+            and then Pos /= Mangled'First then
+             Demangled (DPos) := '.';
+             Pos := Pos + 2;
+          else
+             Demangled (DPos) := Mangled (Pos);
+             Pos := Pos + 1;
+          end if;
+ 
+          DPos := DPos + 1;
+ 
+       end loop;
+ 
+       return Demangled (1 .. DPos - 1);
+    end Demangle_Ada;
+ 
     ------------------------
     -- Symbolic_Traceback --
     ------------------------
  
     function Symbolic_Traceback (Traceback : Tracebacks_Array) return String is
!       Status            : Cond_Value_Type;
        Image_Name        : ASCIC;
        Image_Name_Addr   : Address;
        Module_Name       : ASCIC;
*************** package body GNAT.Traceback.Symbolic is
*** 152,157 ****
--- 224,234 ----
              declare
                 First : Integer := Len + 1;
                 Last  : Integer := First + 80 - 1;
+                Pos   : Integer;
+                Routine_Name_D : String := Demangle_Ada
+                  (To_Ada
+                     (Routine_Name.Data (1 .. size_t (Routine_Name.Count)),
+                      False));
  
              begin
                 Res (First .. Last) := (others => ' ');
*************** package body GNAT.Traceback.Symbolic is
*** 168,180 ****
                     False);
  
                 Res (First + 30 ..
!                     First + 30 + Integer (Routine_Name.Count) - 1) :=
!                  To_Ada
!                   (Routine_Name.Data (1 .. size_t (Routine_Name.Count)),
!                    False);
  
!                Res (First + 50 ..
!                     First + 50 + Integer'Image (Line_Number)'Length - 1) :=
                   Integer'Image (Line_Number);
  
                 Res (Last) := ASCII.LF;
--- 245,267 ----
                     False);
  
                 Res (First + 30 ..
!                     First + 30 + Routine_Name_D'Length - 1) :=
!                  Routine_Name_D;
! 
!                --  If routine name doesn't fit 20 characters, output
!                --  the line number on next line at 50th position
! 
!                if Routine_Name_D'Length > 20 then
!                   Pos := First + 30 + Routine_Name_D'Length;
!                   Res (Pos) := ASCII.LF;
!                   Last := Pos + 80;
!                   Res (Pos + 1 .. Last) := (others => ' ');
!                   Pos := Pos + 51;
!                else
!                   Pos := First + 50;
!                end if;
  
!                Res (Pos .. Pos + Integer'Image (Line_Number)'Length - 1) :=
                   Integer'Image (Line_Number);
  
                 Res (Last) := ASCII.LF;
Index: freeze.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/freeze.adb,v
retrieving revision 1.8
diff -u -c -3 -p -r1.8 freeze.adb
*** freeze.adb	29 Oct 2003 10:26:14 -0000	1.8
--- freeze.adb	30 Oct 2003 11:49:50 -0000
*************** package body Freeze is
*** 124,130 ****
     --  a subprogram type (i.e. an access to a subprogram).
  
     function Is_Fully_Defined (T : Entity_Id) return Boolean;
!    --  true if T is not private and has no private components, or has a full
     --  view. Used to determine whether the designated type of an access type
     --  should be frozen when the access type is frozen. This is done when an
     --  allocator is frozen, or an expression that may involve attributes of
--- 124,130 ----
     --  a subprogram type (i.e. an access to a subprogram).
  
     function Is_Fully_Defined (T : Entity_Id) return Boolean;
!    --  True if T is not private and has no private components, or has a full
     --  view. Used to determine whether the designated type of an access type
     --  should be frozen when the access type is frozen. This is done when an
     --  allocator is frozen, or an expression that may involve attributes of
*************** package body Freeze is
*** 4262,4273 ****
        elsif Is_Record_Type (T)
          and not Is_Private_Type (T)
        then
- 
           --  Verify that the record type has no components with
           --  private types without completion.
  
           declare
              Comp : Entity_Id;
           begin
              Comp := First_Component (T);
  
--- 4262,4273 ----
        elsif Is_Record_Type (T)
          and not Is_Private_Type (T)
        then
           --  Verify that the record type has no components with
           --  private types without completion.
  
           declare
              Comp : Entity_Id;
+ 
           begin
              Comp := First_Component (T);
  
Index: impunit.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/impunit.adb,v
retrieving revision 1.8
diff -u -c -3 -p -r1.8 impunit.adb
*** impunit.adb	21 Oct 2003 13:42:09 -0000	1.8
--- impunit.adb	30 Oct 2003 11:49:50 -0000
*************** package body Impunit is
*** 229,234 ****
--- 229,235 ----
       "g-regist",    -- GNAT.Registry
       "g-regpat",    -- GNAT.Regpat
       "g-semaph",    -- GNAT.Semaphores
+      "g-signal",    -- GNAT.Signals
       "g-socket",    -- GNAT.Sockets
       "g-souinf",    -- GNAT.Source_Info
       "g-speche",    -- GNAT.Spell_Checker
Index: lib-writ.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/lib-writ.adb,v
retrieving revision 1.7
diff -u -c -3 -p -r1.7 lib-writ.adb
*** lib-writ.adb	21 Oct 2003 13:42:09 -0000	1.7
--- lib-writ.adb	30 Oct 2003 11:49:50 -0000
*************** package body Lib.Writ is
*** 680,685 ****
--- 680,692 ----
     --  Start of processing for Writ_ALI
  
     begin
+       --  We never write an ALI file if the original operating mode was
+       --  syntax-only (-gnats switch used in compiler invocation line)
+ 
+       if Original_Operating_Mode = Check_Syntax then
+          return;
+       end if;
+ 
        --  Build sorted source dependency table. We do this right away,
        --  because it is referenced by Up_To_Date_ALI_File_Exists.
  
Index: Makefile.rtl
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/Makefile.rtl,v
retrieving revision 1.1
diff -u -c -3 -p -r1.1 Makefile.rtl
*** Makefile.rtl	21 Oct 2003 13:41:53 -0000	1.1
--- Makefile.rtl	30 Oct 2003 11:49:50 -0000
*************** GNATRTL_TASKING_OBJS= \
*** 38,43 ****
--- 38,44 ----
    g-boubuf$(objext) \
    g-boumai$(objext) \
    g-semaph$(objext) \
+   g-signal$(objext) \
    g-thread$(objext) \
    s-asthan$(objext) \
    s-inmaop$(objext) \
Index: par.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/par.adb,v
retrieving revision 1.8
diff -u -c -3 -p -r1.8 par.adb
*** par.adb	21 Oct 2003 13:42:12 -0000	1.8
--- par.adb	30 Oct 2003 11:49:50 -0000
***************
*** 26,32 ****
  
  with Atree;    use Atree;
  with Casing;   use Casing;
- with Csets;    use Csets;
  with Debug;    use Debug;
  with Elists;   use Elists;
  with Errout;   use Errout;
--- 26,31 ----
*************** function Par (Configuration_Pragmas : Bo
*** 189,194 ****
--- 188,260 ----
     --   that there is a missing body, but it seems more reasonable to let the
     --   later semantic checking discover this.
  
+    ----------------------------------------------------
+    -- Handling of Reserved Words Used as Identifiers --
+    ----------------------------------------------------
+ 
+    --  Note: throughout the parser, the terms reserved word and keyword
+    --  are used interchangably to refer to the same set of reserved
+    --  keywords (including until, protected, etc).
+ 
+    --  If a reserved word is used in place of an identifier, the parser
+    --  where possible tries to recover gracefully. In particular, if the
+    --  keyword is clearly spelled using identifier casing, e.g. Until in
+    --  a source program using mixed case identifiers and lower case keywords,
+    --  then the keyword is treated as an identifier if it appears in a place
+    --  where an identifier is required.
+ 
+    --  The situation is more complex if the keyword is spelled with normal
+    --  keyword casing. In this case, the parser is more reluctant to
+    --  consider it to be intended as an identifier, unless it has some
+    --  further confirmation.
+ 
+    --  In the case of an identifier appearing in the identifier list of a
+    --  declaration, the appearence of a comma or colon right after the
+    --  keyword on the same line is taken as confirmation. For an enumeration
+    --  literal, a comma or right paren right after the identifier is also
+    --  treated as adequate confirmation.
+ 
+    --  The following type is used in calls to Is_Reserved_Identifier and
+    --  also to P_Defining_Identifier and P_Identifier. The default for all
+    --  these functins is that reserved words in reserved word case are not
+    --  considered to be reserved identifiers. The Id_Check value indicates
+    --  tokens, which if they appear immediately after the identifier, are
+    --  taken as confirming that the use of an identifier was expected
+ 
+    type Id_Check is
+      (None,
+       --  Default, no special token test
+ 
+       C_Comma_Right_Paren,
+       --  Consider as identifier if followed by comma or right paren
+ 
+       C_Comma_Colon,
+       --  Consider as identifier if followed by comma or colon
+ 
+       C_Do,
+       --  Consider as identifier if followed by DO
+ 
+       C_Dot,
+       --  Consider as identifier if followed by period
+ 
+       C_Greater_Greater,
+       --  Consider as identifier if followed by >>
+ 
+       C_In,
+       --  Consider as identifier if followed by IN
+ 
+       C_Is,
+       --  Consider as identifier if followed by IS
+ 
+       C_Left_Paren_Semicolon,
+       --  Consider as identifier if followed by left paren or semicolon
+ 
+       C_Use,
+       --  Consider as identifier if followed by USE
+ 
+       C_Vertical_Bar_Arrow);
+       --  Consider as identifier if followed by | or =>
+ 
     --------------------------------------------
     -- Handling IS Used in Place of Semicolon --
     --------------------------------------------
*************** function Par (Configuration_Pragmas : Bo
*** 450,458 ****
     --  List that is created.
  
     package Ch2 is
-       function P_Identifier                           return Node_Id;
        function P_Pragma                               return Node_Id;
  
        function P_Pragmas_Opt return List_Id;
        --  This function scans for a sequence of pragmas in other than a
        --  declaration sequence or statement sequence context. All pragmas
--- 516,527 ----
     --  List that is created.
  
     package Ch2 is
        function P_Pragma                               return Node_Id;
  
+       function P_Identifier (C : Id_Check := None) return Node_Id;
+       --  Scans out an identifier. The parameter C determines the treatment
+       --  of reserved identifiers. See declaration of Id_Check for details.
+ 
        function P_Pragmas_Opt return List_Id;
        --  This function scans for a sequence of pragmas in other than a
        --  declaration sequence or statement sequence context. All pragmas
*************** function Par (Configuration_Pragmas : Bo
*** 482,488 ****
        function P_Basic_Declarative_Items              return List_Id;
        function P_Constraint_Opt                       return Node_Id;
        function P_Declarative_Part                     return List_Id;
-       function P_Defining_Identifier                  return Node_Id;
        function P_Discrete_Choice_List                 return List_Id;
        function P_Discrete_Range                       return Node_Id;
        function P_Discrete_Subtype_Definition          return Node_Id;
--- 551,556 ----
*************** function Par (Configuration_Pragmas : Bo
*** 503,508 ****
--- 571,581 ----
        --  case where the source has a single declaration with multiple
        --  defining identifiers.
  
+       function P_Defining_Identifier (C : Id_Check := None) return Node_Id;
+       --  Scan out a defining identifier. The parameter C controls the
+       --  treatment of errors in case a reserved word is scanned. See the
+       --  declaration of this type for details.
+ 
        function Init_Expr_Opt (P : Boolean := False) return Node_Id;
        --  If an initialization expression is present (:= expression), then
        --  it is scanned out and returned, otherwise Empty is returned if no
*************** function Par (Configuration_Pragmas : Bo
*** 908,917 ****
        --  past it, otherwise the call has no effect at all. T may be any
        --  reserved word token, or comma, left or right paren, or semicolon.
  
!       function Is_Reserved_Identifier return Boolean;
        --  Test if current token is a reserved identifier. This test is based
        --  on the token being a keyword and being spelled in typical identifier
!       --  style (i.e. starting with an upper case letter).
  
        procedure Merge_Identifier (Prev : Node_Id; Nxt : Token_Type);
        --  Called when the previous token is an identifier (whose Token_Node
--- 981,992 ----
        --  past it, otherwise the call has no effect at all. T may be any
        --  reserved word token, or comma, left or right paren, or semicolon.
  
!       function Is_Reserved_Identifier (C : Id_Check := None) return Boolean;
        --  Test if current token is a reserved identifier. This test is based
        --  on the token being a keyword and being spelled in typical identifier
!       --  style (i.e. starting with an upper case letter). The parameter C
!       --  determines the special treatment if a reserved word is encountered
!       --  that has the normal casing of a reserved word.
  
        procedure Merge_Identifier (Prev : Node_Id; Nxt : Token_Type);
        --  Called when the previous token is an identifier (whose Token_Node
Index: par-ch12.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/par-ch12.adb,v
retrieving revision 1.7
diff -u -c -3 -p -r1.7 par-ch12.adb
*** par-ch12.adb	24 Apr 2003 17:54:07 -0000	1.7
--- par-ch12.adb	30 Oct 2003 11:49:50 -0000
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2001 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          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- --
*************** package body Ch12 is
*** 367,378 ****
        --  bother to check for it being exceeded.
  
     begin
!       Idents (1) := P_Defining_Identifier;
        Num_Idents := 1;
  
        while Comma_Present loop
           Num_Idents := Num_Idents + 1;
!          Idents (Num_Idents) := P_Defining_Identifier;
        end loop;
  
        T_Colon;
--- 367,378 ----
        --  bother to check for it being exceeded.
  
     begin
!       Idents (1) := P_Defining_Identifier (C_Comma_Colon);
        Num_Idents := 1;
  
        while Comma_Present loop
           Num_Idents := Num_Idents + 1;
!          Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon);
        end loop;
  
        T_Colon;
*************** package body Ch12 is
*** 873,879 ****
     begin
        Def_Node := New_Node (N_Formal_Package_Declaration, Prev_Token_Ptr);
        Scan; -- past PACKAGE
!       Set_Defining_Identifier (Def_Node, P_Defining_Identifier);
        T_Is;
        T_New;
        Set_Name (Def_Node, P_Qualified_Simple_Name);
--- 873,879 ----
     begin
        Def_Node := New_Node (N_Formal_Package_Declaration, Prev_Token_Ptr);
        Scan; -- past PACKAGE
!       Set_Defining_Identifier (Def_Node, P_Defining_Identifier (C_Is));
        T_Is;
        T_New;
        Set_Name (Def_Node, P_Qualified_Simple_Name);
Index: par-ch13.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/par-ch13.adb,v
retrieving revision 1.4
diff -u -c -3 -p -r1.4 par-ch13.adb
*** par-ch13.adb	24 Apr 2003 17:54:07 -0000	1.4
--- par-ch13.adb	30 Oct 2003 11:49:50 -0000
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2001 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          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- --
*************** package body Ch13 is
*** 92,98 ****
        --  Note that the name in a representation clause is always a simple
        --  name, even in the attribute case, see AI-300 which made this so!
  
!       Identifier_Node := P_Identifier;
  
        --  Check case of qualified name to give good error message
  
--- 92,98 ----
        --  Note that the name in a representation clause is always a simple
        --  name, even in the attribute case, see AI-300 which made this so!
  
!       Identifier_Node := P_Identifier (C_Use);
  
        --  Check case of qualified name to give good error message
  
Index: par-ch2.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/par-ch2.adb,v
retrieving revision 1.6
diff -u -c -3 -p -r1.6 par-ch2.adb
*** par-ch2.adb	21 Oct 2003 13:42:10 -0000	1.6
--- par-ch2.adb	30 Oct 2003 11:49:50 -0000
*************** package body Ch2 is
*** 47,53 ****
  
     --  Error recovery: can raise Error_Resync (cannot return Error)
  
!    function P_Identifier return Node_Id is
        Ident_Node : Node_Id;
  
     begin
--- 47,53 ----
  
     --  Error recovery: can raise Error_Resync (cannot return Error)
  
!    function P_Identifier (C : Id_Check := None) return Node_Id is
        Ident_Node : Node_Id;
  
     begin
*************** package body Ch2 is
*** 61,67 ****
        --  If we have a reserved identifier, manufacture an identifier with
        --  a corresponding name after posting an appropriate error message
  
!       elsif Is_Reserved_Identifier then
           Scan_Reserved_Identifier (Force_Msg => False);
           Ident_Node := Token_Node;
           Scan; -- past the node
--- 61,67 ----
        --  If we have a reserved identifier, manufacture an identifier with
        --  a corresponding name after posting an appropriate error message
  
!       elsif Is_Reserved_Identifier (C) then
           Scan_Reserved_Identifier (Force_Msg => False);
           Ident_Node := Token_Node;
           Scan; -- past the node
Index: par-ch3.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/par-ch3.adb,v
retrieving revision 1.8
diff -u -c -3 -p -r1.8 par-ch3.adb
*** par-ch3.adb	21 Oct 2003 13:42:10 -0000	1.8
--- par-ch3.adb	30 Oct 2003 11:49:51 -0000
*************** package body Ch3 is
*** 164,170 ****
  
     --  Error recovery: can raise Error_Resync
  
!    function P_Defining_Identifier return Node_Id is
        Ident_Node : Node_Id;
  
     begin
--- 164,170 ----
  
     --  Error recovery: can raise Error_Resync
  
!    function P_Defining_Identifier (C : Id_Check := None) return Node_Id is
        Ident_Node : Node_Id;
  
     begin
*************** package body Ch3 is
*** 179,185 ****
        --  If we have a reserved identifier, manufacture an identifier with
        --  a corresponding name after posting an appropriate error message
  
!       elsif Is_Reserved_Identifier then
           Scan_Reserved_Identifier (Force_Msg => True);
  
        --  Otherwise we have junk that cannot be interpreted as an identifier
--- 179,185 ----
        --  If we have a reserved identifier, manufacture an identifier with
        --  a corresponding name after posting an appropriate error message
  
!       elsif Is_Reserved_Identifier (C) then
           Scan_Reserved_Identifier (Force_Msg => True);
  
        --  Otherwise we have junk that cannot be interpreted as an identifier
*************** package body Ch3 is
*** 262,268 ****
        Type_Loc := Token_Ptr;
        Type_Start_Col := Start_Column;
        T_Type;
!       Ident_Node := P_Defining_Identifier;
        Discr_Sloc := Token_Ptr;
  
        if P_Unknown_Discriminant_Part_Opt then
--- 262,268 ----
        Type_Loc := Token_Ptr;
        Type_Start_Col := Start_Column;
        T_Type;
!       Ident_Node := P_Defining_Identifier (C_Is);
        Discr_Sloc := Token_Ptr;
  
        if P_Unknown_Discriminant_Part_Opt then
*************** package body Ch3 is
*** 732,738 ****
     begin
        Decl_Node := New_Node (N_Subtype_Declaration, Token_Ptr);
        Scan; -- past SUBTYPE
!       Set_Defining_Identifier (Decl_Node, P_Defining_Identifier);
        TF_Is;
  
        if Token = Tok_New then
--- 732,738 ----
     begin
        Decl_Node := New_Node (N_Subtype_Declaration, Token_Ptr);
        Scan; -- past SUBTYPE
!       Set_Defining_Identifier (Decl_Node, P_Defining_Identifier (C_Is));
        TF_Is;
  
        if Token = Tok_New then
*************** package body Ch3 is
*** 1090,1096 ****
     begin
        Ident_Sloc := Token_Ptr;
        Save_Scan_State (Scan_State); -- at first identifier
!       Idents (1) := P_Defining_Identifier;
  
        --  If we have a colon after the identifier, then we can assume that
        --  this is in fact a valid identifier declaration and can steam ahead.
--- 1090,1096 ----
     begin
        Ident_Sloc := Token_Ptr;
        Save_Scan_State (Scan_State); -- at first identifier
!       Idents (1) := P_Defining_Identifier (C_Comma_Colon);
  
        --  If we have a colon after the identifier, then we can assume that
        --  this is in fact a valid identifier declaration and can steam ahead.
*************** package body Ch3 is
*** 1104,1110 ****
  
           while Comma_Present loop
              Num_Idents := Num_Idents + 1;
!             Idents (Num_Idents) := P_Defining_Identifier;
           end loop;
  
           Save_Scan_State (Scan_State); -- at colon
--- 1104,1110 ----
  
           while Comma_Present loop
              Num_Idents := Num_Idents + 1;
!             Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon);
           end loop;
  
           Save_Scan_State (Scan_State); -- at colon
*************** package body Ch3 is
*** 1685,1691 ****
        if Token = Tok_Char_Literal then
           return P_Defining_Character_Literal;
        else
!          return P_Defining_Identifier;
        end if;
     end P_Enumeration_Literal_Specification;
  
--- 1685,1691 ----
        if Token = Tok_Char_Literal then
           return P_Defining_Character_Literal;
        else
!          return P_Defining_Identifier (C_Comma_Right_Paren);
        end if;
     end P_Enumeration_Literal_Specification;
  
*************** package body Ch3 is
*** 2278,2289 ****
           Specification_Loop : loop
  
              Ident_Sloc := Token_Ptr;
!             Idents (1) := P_Defining_Identifier;
              Num_Idents := 1;
  
              while Comma_Present loop
                 Num_Idents := Num_Idents + 1;
!                Idents (Num_Idents) := P_Defining_Identifier;
              end loop;
  
              T_Colon;
--- 2278,2289 ----
           Specification_Loop : loop
  
              Ident_Sloc := Token_Ptr;
!             Idents (1) := P_Defining_Identifier (C_Comma_Colon);
              Num_Idents := 1;
  
              while Comma_Present loop
                 Num_Idents := Num_Idents + 1;
!                Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon);
              end loop;
  
              T_Colon;
*************** package body Ch3 is
*** 2518,2524 ****
        Names_List := New_List;
  
        loop
!          Append (P_Identifier, Names_List);
           exit when Token /= Tok_Vertical_Bar;
           Scan; -- past |
        end loop;
--- 2518,2524 ----
        Names_List := New_List;
  
        loop
!          Append (P_Identifier (C_Vertical_Bar_Arrow), Names_List);
           exit when Token /= Tok_Vertical_Bar;
           Scan; -- past |
        end loop;
*************** package body Ch3 is
*** 2747,2758 ****
        end if;
  
        Ident_Sloc := Token_Ptr;
!       Idents (1) := P_Defining_Identifier;
        Num_Idents := 1;
  
        while Comma_Present loop
           Num_Idents := Num_Idents + 1;
!          Idents (Num_Idents) := P_Defining_Identifier;
        end loop;
  
        T_Colon;
--- 2747,2758 ----
        end if;
  
        Ident_Sloc := Token_Ptr;
!       Idents (1) := P_Defining_Identifier (C_Comma_Colon);
        Num_Idents := 1;
  
        while Comma_Present loop
           Num_Idents := Num_Idents + 1;
!          Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon);
        end loop;
  
        T_Colon;
Index: par-ch5.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/par-ch5.adb,v
retrieving revision 1.7
diff -u -c -3 -p -r1.7 par-ch5.adb
*** par-ch5.adb	21 Oct 2003 13:42:10 -0000	1.7
--- par-ch5.adb	30 Oct 2003 11:49:51 -0000
*************** package body Ch5 is
*** 1004,1010 ****
     begin
        Label_Node := New_Node (N_Label, Token_Ptr);
        Scan; -- past <<
!       Set_Identifier (Label_Node, P_Identifier);
        T_Greater_Greater;
        Append_Elmt (Label_Node, Label_List);
        return Label_Node;
--- 1004,1010 ----
     begin
        Label_Node := New_Node (N_Label, Token_Ptr);
        Scan; -- past <<
!       Set_Identifier (Label_Node, P_Identifier (C_Greater_Greater));
        T_Greater_Greater;
        Append_Elmt (Label_Node, Label_List);
        return Label_Node;
*************** package body Ch5 is
*** 1621,1627 ****
          New_Node (N_Loop_Parameter_Specification, Token_Ptr);
  
        Save_Scan_State (Scan_State);
!       ID_Node := P_Defining_Identifier;
        Set_Defining_Identifier (Loop_Param_Specification_Node, ID_Node);
  
        if Token = Tok_Left_Paren then
--- 1621,1627 ----
          New_Node (N_Loop_Parameter_Specification, Token_Ptr);
  
        Save_Scan_State (Scan_State);
!       ID_Node := P_Defining_Identifier (C_In);
        Set_Defining_Identifier (Loop_Param_Specification_Node, ID_Node);
  
        if Token = Tok_Left_Paren then
Index: par-ch6.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/par-ch6.adb,v
retrieving revision 1.6
diff -u -c -3 -p -r1.6 par-ch6.adb
*** par-ch6.adb	21 Oct 2003 13:42:10 -0000	1.6
--- par-ch6.adb	30 Oct 2003 11:49:51 -0000
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2002 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          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- --
*************** package body Ch6 is
*** 593,598 ****
--- 593,602 ----
        --  True, a real dot has been scanned and we are positioned past it,
        --  if the result is False, the scan position is unchanged.
  
+       --------------
+       -- Real_Dot --
+       --------------
+ 
        function Real_Dot return Boolean is
           Scan_State  : Saved_Scan_State;
  
*************** package body Ch6 is
*** 715,721 ****
           Set_Identifier_Casing (Current_Source_File, Determine_Token_Casing);
        end if;
  
!       Ident_Node := P_Identifier;
        Merge_Identifier (Ident_Node, Tok_Return);
  
        --  Normal case (not child library unit name)
--- 719,725 ----
           Set_Identifier_Casing (Current_Source_File, Determine_Token_Casing);
        end if;
  
!       Ident_Node := P_Identifier (C_Dot);
        Merge_Identifier (Ident_Node, Tok_Return);
  
        --  Normal case (not child library unit name)
*************** package body Ch6 is
*** 746,752 ****
              Name_Node := New_Node (N_Selected_Component, Token_Ptr);
              Scan; -- past period
              Set_Prefix (Name_Node, Prefix_Node);
!             Ident_Node := P_Identifier;
              Set_Selector_Name (Name_Node, Ident_Node);
              Prefix_Node := Name_Node;
           end loop;
--- 750,756 ----
              Name_Node := New_Node (N_Selected_Component, Token_Ptr);
              Scan; -- past period
              Set_Prefix (Name_Node, Prefix_Node);
!             Ident_Node := P_Identifier (C_Dot);
              Set_Selector_Name (Name_Node, Ident_Node);
              Prefix_Node := Name_Node;
           end loop;
*************** package body Ch6 is
*** 870,876 ****
  
              Ignore (Tok_Left_Paren);
              Ident_Sloc := Token_Ptr;
!             Idents (1) := P_Defining_Identifier;
              Num_Idents := 1;
  
              Ident_Loop : loop
--- 874,880 ----
  
              Ignore (Tok_Left_Paren);
              Ident_Sloc := Token_Ptr;
!             Idents (1) := P_Defining_Identifier (C_Comma_Colon);
              Num_Idents := 1;
  
              Ident_Loop : loop
*************** package body Ch6 is
*** 924,930 ****
  
                 T_Comma;
                 Num_Idents := Num_Idents + 1;
!                Idents (Num_Idents) := P_Defining_Identifier;
              end loop Ident_Loop;
  
              --  Fall through the loop on encountering a colon, or deciding
--- 928,934 ----
  
                 T_Comma;
                 Num_Idents := Num_Idents + 1;
!                Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon);
              end loop Ident_Loop;
  
              --  Fall through the loop on encountering a colon, or deciding
Index: par-ch9.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/par-ch9.adb,v
retrieving revision 1.5
diff -u -c -3 -p -r1.5 par-ch9.adb
*** par-ch9.adb	21 Oct 2003 13:42:10 -0000	1.5
--- par-ch9.adb	30 Oct 2003 11:49:51 -0000
***************
*** 6,12 ****
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          Copyright (C) 1992-2002 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- --
--- 6,12 ----
  --                                                                          --
  --                                 B o d y                                  --
  --                                                                          --
! --          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- --
*************** package body Ch9 is
*** 90,96 ****
  
        if Token = Tok_Body then
           Scan; -- past BODY
!          Name_Node := P_Defining_Identifier;
           Scope.Table (Scope.Last).Labl := Name_Node;
  
           if Token = Tok_Left_Paren then
--- 90,96 ----
  
        if Token = Tok_Body then
           Scan; -- past BODY
!          Name_Node := P_Defining_Identifier (C_Is);
           Scope.Table (Scope.Last).Labl := Name_Node;
  
           if Token = Tok_Left_Paren then
*************** package body Ch9 is
*** 133,139 ****
  
           else
              Task_Node := New_Node (N_Single_Task_Declaration, Task_Sloc);
!             Name_Node := P_Defining_Identifier;
              Set_Defining_Identifier (Task_Node, Name_Node);
              Scope.Table (Scope.Last).Labl := Name_Node;
  
--- 133,139 ----
  
           else
              Task_Node := New_Node (N_Single_Task_Declaration, Task_Sloc);
!             Name_Node := P_Defining_Identifier (C_Is);
              Set_Defining_Identifier (Task_Node, Name_Node);
              Scope.Table (Scope.Last).Labl := Name_Node;
  
*************** package body Ch9 is
*** 141,147 ****
                 Error_Msg_SC ("discriminant part not allowed for single task");
                 Discard_Junk_List (P_Known_Discriminant_Part_Opt);
              end if;
- 
           end if;
  
           --  Parse optional task definition. Note that P_Task_Definition scans
--- 141,146 ----
*************** package body Ch9 is
*** 344,350 ****
  
        if Token = Tok_Body then
           Scan; -- past BODY
!          Name_Node := P_Defining_Identifier;
           Scope.Table (Scope.Last).Labl := Name_Node;
  
           if Token = Tok_Left_Paren then
--- 343,349 ----
  
        if Token = Tok_Body then
           Scan; -- past BODY
!          Name_Node := P_Defining_Identifier (C_Is);
           Scope.Table (Scope.Last).Labl := Name_Node;
  
           if Token = Tok_Left_Paren then
*************** package body Ch9 is
*** 381,387 ****
              Scan; -- past TYPE
              Protected_Node :=
                New_Node (N_Protected_Type_Declaration, Protected_Sloc);
!             Name_Node := P_Defining_Identifier;
              Set_Defining_Identifier (Protected_Node, Name_Node);
              Scope.Table (Scope.Last).Labl := Name_Node;
              Set_Discriminant_Specifications
--- 380,386 ----
              Scan; -- past TYPE
              Protected_Node :=
                New_Node (N_Protected_Type_Declaration, Protected_Sloc);
!             Name_Node := P_Defining_Identifier (C_Is);
              Set_Defining_Identifier (Protected_Node, Name_Node);
              Scope.Table (Scope.Last).Labl := Name_Node;
              Set_Discriminant_Specifications
*************** package body Ch9 is
*** 390,396 ****
           else
              Protected_Node :=
                New_Node (N_Single_Protected_Declaration, Protected_Sloc);
!             Name_Node := P_Defining_Identifier;
              Set_Defining_Identifier (Protected_Node, Name_Node);
  
              if Token = Tok_Left_Paren then
--- 389,395 ----
           else
              Protected_Node :=
                New_Node (N_Single_Protected_Declaration, Protected_Sloc);
!             Name_Node := P_Defining_Identifier (C_Is);
              Set_Defining_Identifier (Protected_Node, Name_Node);
  
              if Token = Tok_Left_Paren then
*************** package body Ch9 is
*** 631,637 ****
        Decl_Node := New_Node (N_Entry_Declaration, Token_Ptr);
        Scan; -- past ENTRY
  
!       Set_Defining_Identifier (Decl_Node, P_Defining_Identifier);
  
        --  If left paren, could be (Discrete_Subtype_Definition) or Formal_Part
  
--- 630,637 ----
        Decl_Node := New_Node (N_Entry_Declaration, Token_Ptr);
        Scan; -- past ENTRY
  
!       Set_Defining_Identifier
!         (Decl_Node, P_Defining_Identifier (C_Left_Paren_Semicolon));
  
        --  If left paren, could be (Discrete_Subtype_Definition) or Formal_Part
  
*************** package body Ch9 is
*** 719,725 ****
        Scan; -- past ACCEPT
        Scope.Table (Scope.Last).Labl := Token_Node;
  
!       Set_Entry_Direct_Name (Accept_Node, P_Identifier);
  
        --  Left paren could be (Entry_Index) or Formal_Part, determine which
  
--- 719,725 ----
        Scan; -- past ACCEPT
        Scope.Table (Scope.Last).Labl := Token_Node;
  
!       Set_Entry_Direct_Name (Accept_Node, P_Identifier (C_Do));
  
        --  Left paren could be (Entry_Index) or Formal_Part, determine which
  
*************** package body Ch9 is
*** 932,938 ****
     begin
        Iterator_Node := New_Node (N_Entry_Index_Specification, Token_Ptr);
        T_For; -- past FOR
!       Set_Defining_Identifier (Iterator_Node, P_Defining_Identifier);
        T_In;
        Set_Discrete_Subtype_Definition
          (Iterator_Node, P_Discrete_Subtype_Definition);
--- 932,938 ----
     begin
        Iterator_Node := New_Node (N_Entry_Index_Specification, Token_Ptr);
        T_For; -- past FOR
!       Set_Defining_Identifier (Iterator_Node, P_Defining_Identifier (C_In));
        T_In;
        Set_Discrete_Subtype_Definition
          (Iterator_Node, P_Discrete_Subtype_Definition);
Index: par-util.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/par-util.adb,v
retrieving revision 1.6
diff -u -c -3 -p -r1.6 par-util.adb
*** par-util.adb	21 Oct 2003 13:42:12 -0000	1.6
--- par-util.adb	30 Oct 2003 11:49:51 -0000
***************
*** 24,29 ****
--- 24,30 ----
  --                                                                          --
  ------------------------------------------------------------------------------
  
+ with Csets; use Csets;
  with Uintp; use Uintp;
  
  with GNAT.Spelling_Checker; use GNAT.Spelling_Checker;
*************** package body Util is
*** 419,425 ****
     -- Is_Reserved_Identifier --
     ----------------------------
  
!    function Is_Reserved_Identifier return Boolean is
     begin
        if not Is_Reserved_Keyword (Token) then
           return False;
--- 420,426 ----
     -- Is_Reserved_Identifier --
     ----------------------------
  
!    function Is_Reserved_Identifier (C : Id_Check := None) return Boolean is
     begin
        if not Is_Reserved_Keyword (Token) then
           return False;
*************** package body Util is
*** 438,457 ****
              --  keyword casing, then we return False, since it is pretty
              --  clearly intended to be a keyword.
  
!             if Ident_Casing /= Unknown
!               and then Key_Casing /= Unknown
!               and then Ident_Casing /= Key_Casing
!               and then Determine_Token_Casing = Key_Casing
              then
-                return False;
- 
-             --  Otherwise assume that an identifier was intended
- 
-             else
                 return True;
              end if;
           end;
        end if;
     end Is_Reserved_Identifier;
  
     ----------------------
--- 439,526 ----
              --  keyword casing, then we return False, since it is pretty
              --  clearly intended to be a keyword.
  
!             if Ident_Casing = Unknown
!               or else Key_Casing = Unknown
!               or else Ident_Casing = Key_Casing
!               or else Determine_Token_Casing /= Key_Casing
              then
                 return True;
+ 
+             --  Here we have a keyword written clearly with keyword casing.
+             --  In default mode, we would not be willing to consider this as
+             --  a reserved identifier, but if C is set, we may still accept it
+ 
+             elsif C /= None then
+                declare
+                   Scan_State  : Saved_Scan_State;
+                   OK_Next_Tok : Boolean;
+ 
+                begin
+                   Save_Scan_State (Scan_State);
+                   Scan;
+ 
+                   if Token_Is_At_Start_Of_Line then
+                      return False;
+                   end if;
+ 
+                   case C is
+                      when None =>
+                         raise Program_Error;
+ 
+                      when C_Comma_Right_Paren =>
+                         OK_Next_Tok :=
+                           Token = Tok_Comma or else Token = Tok_Right_Paren;
+ 
+                      when C_Comma_Colon =>
+                         OK_Next_Tok :=
+                           Token = Tok_Comma or else Token = Tok_Colon;
+ 
+                      when C_Do =>
+                         OK_Next_Tok :=
+                           Token = Tok_Do;
+ 
+                      when C_Dot =>
+                         OK_Next_Tok :=
+                           Token = Tok_Dot;
+ 
+                      when C_Greater_Greater =>
+                         OK_Next_Tok :=
+                           Token = Tok_Greater_Greater;
+ 
+                      when C_In =>
+                         OK_Next_Tok :=
+                           Token = Tok_In;
+ 
+                      when C_Is =>
+                         OK_Next_Tok :=
+                           Token = Tok_Is;
+ 
+                      when C_Left_Paren_Semicolon =>
+                         OK_Next_Tok :=
+                           Token = Tok_Left_Paren or else Token = Tok_Semicolon;
+ 
+                      when C_Use =>
+                         OK_Next_Tok :=
+                           Token = Tok_Use;
+ 
+                      when C_Vertical_Bar_Arrow =>
+                         OK_Next_Tok :=
+                           Token = Tok_Vertical_Bar or else Token = Tok_Arrow;
+                   end case;
+ 
+                   Restore_Scan_State (Scan_State);
+ 
+                   if OK_Next_Tok then
+                      return True;
+                   end if;
+                end;
              end if;
           end;
        end if;
+ 
+       --  If we fall through it is not a reserved identifier
+ 
+       return False;
     end Is_Reserved_Identifier;
  
     ----------------------


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