This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
committed: ada updates
- From: Arnaud Charlet <charlet at ACT-Europe dot FR>
- To: gcc-patches at gcc dot gnu dot org
- Date: Thu, 30 Oct 2003 12:51:57 +0100
- Subject: 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;
----------------------