-- --
-- B o d y --
-- --
--- Copyright (C) 1999-2003 Ada Core Technologies, Inc. --
+-- 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- --
-- 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). --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
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;
+ Status : Cond_Value_Type;
Image_Name : ASCIC;
Image_Name_Addr : Address;
Module_Name : ASCIC;
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 => ' ');
False);
Res (First + 30 ..
- First + 30 + Integer (Routine_Name.Count) - 1) :=
- To_Ada
- (Routine_Name.Data (1 .. size_t (Routine_Name.Count)),
- False);
+ 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 (First + 50 ..
- First + 50 + Integer'Image (Line_Number)'Length - 1) :=
+ Res (Pos .. Pos + Integer'Image (Line_Number)'Length - 1) :=
Integer'Image (Line_Number);
Res (Last) := ASCII.LF;
+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
+
2003-10-29 Robert Dewar <dewar@gnat.com>
* 3vtrasym.adb, 5vtraent.ads, sprint.adb,
2003-10-29 Vasiliy Fofanov <fofanov@act-europe.fr>
- * 3vtrasym.adb:
- * 5vtraent.adb:
- * 5vtraent.ads:
- * tb-alvms.c:
+ * 3vtrasym.adb, 5vtraent.adb, 5vtraent.ads, tb-alvms.c:
Support for TBK$SYMBOLIZE-based symbolic traceback.
2003-10-29 Jose Ruiz <ruiz@act-europe.fr>
g-boubuf$(objext) \
g-boumai$(objext) \
g-semaph$(objext) \
+ g-signal$(objext) \
g-thread$(objext) \
s-asthan$(objext) \
s-inmaop$(objext) \
-- 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
+ -- 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
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);
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUNTIME COMPONENTS --
+-- --
+-- G N A T . S I G N A L S --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 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- --
+-- ware Foundation; either version 2, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING. If not, write --
+-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
+-- MA 02111-1307, USA. --
+-- --
+-- As a special exception, if other files instantiate generics from this --
+-- unit, or you link this unit with other files to produce an executable, --
+-- this unit does not by itself cause the resulting executable to be --
+-- covered by the GNU General Public License. This exception does not --
+-- 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. --
+-- --
+------------------------------------------------------------------------------
+
+with System.Interrupts;
+
+package body GNAT.Signals is
+
+ package SI renames System.Interrupts;
+
+ ------------------
+ -- Block_Signal --
+ ------------------
+
+ procedure Block_Signal (Signal : Ada.Interrupts.Interrupt_ID) is
+ begin
+ SI.Block_Interrupt (SI.Interrupt_ID (Signal));
+ end Block_Signal;
+
+ ----------------
+ -- Is_Blocked --
+ ----------------
+
+ function Is_Blocked
+ (Signal : Ada.Interrupts.Interrupt_ID)
+ return Boolean
+ is
+ begin
+ return SI.Is_Blocked (SI.Interrupt_ID (Signal));
+ end Is_Blocked;
+
+ --------------------
+ -- Unblock_Signal --
+ --------------------
+
+ procedure Unblock_Signal (Signal : Ada.Interrupts.Interrupt_ID) is
+ begin
+ SI.Unblock_Interrupt (SI.Interrupt_ID (Signal));
+ end Unblock_Signal;
+
+end GNAT.Signals;
+
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUNTIME COMPONENTS --
+-- --
+-- G N A T . S I G N A L S --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 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- --
+-- ware Foundation; either version 2, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING. If not, write --
+-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
+-- MA 02111-1307, USA. --
+-- --
+-- As a special exception, if other files instantiate generics from this --
+-- unit, or you link this unit with other files to produce an executable, --
+-- this unit does not by itself cause the resulting executable to be --
+-- covered by the GNU General Public License. This exception does not --
+-- 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. --
+-- --
+------------------------------------------------------------------------------
+
+with Ada.Interrupts;
+
+-- This package provides operations for querying and setting the blocked
+-- status of signals.
+
+-- This package is supported only on targets where Ada.Interrupts.Interrupt_ID
+-- corresponds to software signals on the target, and where System.Interrupts
+-- provides the ability to block and unblock signals.
+
+package GNAT.Signals is
+
+ procedure Block_Signal (Signal : Ada.Interrupts.Interrupt_ID);
+ -- Block "Signal" at the process level
+
+ procedure Unblock_Signal (Signal : Ada.Interrupts.Interrupt_ID);
+ -- Unblock "Signal" at the process level
+
+ function Is_Blocked (Signal : Ada.Interrupts.Interrupt_ID)
+ return Boolean;
+ -- "Signal" blocked at the process level?
+
+end GNAT.Signals;
"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
-- 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.
-- --
-- B o d y --
-- --
--- 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- --
-- bother to check for it being exceeded.
begin
- Idents (1) := P_Defining_Identifier;
+ 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;
+ Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon);
end loop;
T_Colon;
begin
Def_Node := New_Node (N_Formal_Package_Declaration, Prev_Token_Ptr);
Scan; -- past PACKAGE
- Set_Defining_Identifier (Def_Node, P_Defining_Identifier);
+ Set_Defining_Identifier (Def_Node, P_Defining_Identifier (C_Is));
T_Is;
T_New;
Set_Name (Def_Node, P_Qualified_Simple_Name);
-- --
-- B o d y --
-- --
--- 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- --
-- 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;
+ Identifier_Node := P_Identifier (C_Use);
-- Check case of qualified name to give good error message
-- 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
-- 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
-- Error recovery: can raise Error_Resync
- function P_Defining_Identifier return Node_Id is
+ function P_Defining_Identifier (C : Id_Check := None) return Node_Id is
Ident_Node : Node_Id;
begin
-- 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 => True);
-- Otherwise we have junk that cannot be interpreted as an identifier
Type_Loc := Token_Ptr;
Type_Start_Col := Start_Column;
T_Type;
- Ident_Node := P_Defining_Identifier;
+ Ident_Node := P_Defining_Identifier (C_Is);
Discr_Sloc := Token_Ptr;
if P_Unknown_Discriminant_Part_Opt then
begin
Decl_Node := New_Node (N_Subtype_Declaration, Token_Ptr);
Scan; -- past SUBTYPE
- Set_Defining_Identifier (Decl_Node, P_Defining_Identifier);
+ Set_Defining_Identifier (Decl_Node, P_Defining_Identifier (C_Is));
TF_Is;
if Token = Tok_New then
begin
Ident_Sloc := Token_Ptr;
Save_Scan_State (Scan_State); -- at first identifier
- Idents (1) := P_Defining_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.
while Comma_Present loop
Num_Idents := Num_Idents + 1;
- Idents (Num_Idents) := P_Defining_Identifier;
+ Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon);
end loop;
Save_Scan_State (Scan_State); -- at colon
if Token = Tok_Char_Literal then
return P_Defining_Character_Literal;
else
- return P_Defining_Identifier;
+ return P_Defining_Identifier (C_Comma_Right_Paren);
end if;
end P_Enumeration_Literal_Specification;
Specification_Loop : loop
Ident_Sloc := Token_Ptr;
- Idents (1) := P_Defining_Identifier;
+ 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;
+ Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon);
end loop;
T_Colon;
Names_List := New_List;
loop
- Append (P_Identifier, Names_List);
+ Append (P_Identifier (C_Vertical_Bar_Arrow), Names_List);
exit when Token /= Tok_Vertical_Bar;
Scan; -- past |
end loop;
end if;
Ident_Sloc := Token_Ptr;
- Idents (1) := P_Defining_Identifier;
+ 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;
+ Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon);
end loop;
T_Colon;
begin
Label_Node := New_Node (N_Label, Token_Ptr);
Scan; -- past <<
- Set_Identifier (Label_Node, P_Identifier);
+ Set_Identifier (Label_Node, P_Identifier (C_Greater_Greater));
T_Greater_Greater;
Append_Elmt (Label_Node, Label_List);
return Label_Node;
New_Node (N_Loop_Parameter_Specification, Token_Ptr);
Save_Scan_State (Scan_State);
- ID_Node := P_Defining_Identifier;
+ ID_Node := P_Defining_Identifier (C_In);
Set_Defining_Identifier (Loop_Param_Specification_Node, ID_Node);
if Token = Tok_Left_Paren then
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2002 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- --
-- 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;
Set_Identifier_Casing (Current_Source_File, Determine_Token_Casing);
end if;
- Ident_Node := P_Identifier;
+ Ident_Node := P_Identifier (C_Dot);
Merge_Identifier (Ident_Node, Tok_Return);
-- Normal case (not child library unit name)
Name_Node := New_Node (N_Selected_Component, Token_Ptr);
Scan; -- past period
Set_Prefix (Name_Node, Prefix_Node);
- Ident_Node := P_Identifier;
+ Ident_Node := P_Identifier (C_Dot);
Set_Selector_Name (Name_Node, Ident_Node);
Prefix_Node := Name_Node;
end loop;
Ignore (Tok_Left_Paren);
Ident_Sloc := Token_Ptr;
- Idents (1) := P_Defining_Identifier;
+ Idents (1) := P_Defining_Identifier (C_Comma_Colon);
Num_Idents := 1;
Ident_Loop : loop
T_Comma;
Num_Idents := Num_Idents + 1;
- Idents (Num_Idents) := P_Defining_Identifier;
+ Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon);
end loop Ident_Loop;
-- Fall through the loop on encountering a colon, or deciding
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2002 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- --
if Token = Tok_Body then
Scan; -- past BODY
- Name_Node := P_Defining_Identifier;
+ Name_Node := P_Defining_Identifier (C_Is);
Scope.Table (Scope.Last).Labl := Name_Node;
if Token = Tok_Left_Paren then
else
Task_Node := New_Node (N_Single_Task_Declaration, Task_Sloc);
- Name_Node := P_Defining_Identifier;
+ Name_Node := P_Defining_Identifier (C_Is);
Set_Defining_Identifier (Task_Node, Name_Node);
Scope.Table (Scope.Last).Labl := Name_Node;
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
if Token = Tok_Body then
Scan; -- past BODY
- Name_Node := P_Defining_Identifier;
+ Name_Node := P_Defining_Identifier (C_Is);
Scope.Table (Scope.Last).Labl := Name_Node;
if Token = Tok_Left_Paren then
Scan; -- past TYPE
Protected_Node :=
New_Node (N_Protected_Type_Declaration, Protected_Sloc);
- Name_Node := P_Defining_Identifier;
+ Name_Node := P_Defining_Identifier (C_Is);
Set_Defining_Identifier (Protected_Node, Name_Node);
Scope.Table (Scope.Last).Labl := Name_Node;
Set_Discriminant_Specifications
else
Protected_Node :=
New_Node (N_Single_Protected_Declaration, Protected_Sloc);
- Name_Node := P_Defining_Identifier;
+ Name_Node := P_Defining_Identifier (C_Is);
Set_Defining_Identifier (Protected_Node, Name_Node);
if Token = Tok_Left_Paren then
Decl_Node := New_Node (N_Entry_Declaration, Token_Ptr);
Scan; -- past ENTRY
- Set_Defining_Identifier (Decl_Node, P_Defining_Identifier);
+ Set_Defining_Identifier
+ (Decl_Node, P_Defining_Identifier (C_Left_Paren_Semicolon));
-- If left paren, could be (Discrete_Subtype_Definition) or Formal_Part
Scan; -- past ACCEPT
Scope.Table (Scope.Last).Labl := Token_Node;
- Set_Entry_Direct_Name (Accept_Node, P_Identifier);
+ Set_Entry_Direct_Name (Accept_Node, P_Identifier (C_Do));
-- Left paren could be (Entry_Index) or Formal_Part, determine which
begin
Iterator_Node := New_Node (N_Entry_Index_Specification, Token_Ptr);
T_For; -- past FOR
- Set_Defining_Identifier (Iterator_Node, P_Defining_Identifier);
+ Set_Defining_Identifier (Iterator_Node, P_Defining_Identifier (C_In));
T_In;
Set_Discrete_Subtype_Definition
(Iterator_Node, P_Discrete_Subtype_Definition);
-- --
------------------------------------------------------------------------------
+with Csets; use Csets;
with Uintp; use Uintp;
with GNAT.Spelling_Checker; use GNAT.Spelling_Checker;
-- Is_Reserved_Identifier --
----------------------------
- function Is_Reserved_Identifier return Boolean is
+ function Is_Reserved_Identifier (C : Id_Check := None) return Boolean is
begin
if not Is_Reserved_Keyword (Token) then
return False;
-- 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
+ if Ident_Casing = Unknown
+ or else Key_Casing = Unknown
+ or else Ident_Casing = Key_Casing
+ or else Determine_Token_Casing /= Key_Casing
then
- return False;
+ return True;
- -- Otherwise assume that an identifier was intended
+ -- 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
- else
- return True;
+ 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;
----------------------
with Atree; use Atree;
with Casing; use Casing;
-with Csets; use Csets;
with Debug; use Debug;
with Elists; use Elists;
with Errout; use Errout;
-- 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 --
--------------------------------------------
-- List that is created.
package Ch2 is
- function P_Identifier return Node_Id;
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 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;
-- 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
-- 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;
+ 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).
+ -- 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
OSDN Git Service
