3vtrasym.adb: Demangle Ada symbols returned by TBK$SYMBOLIZE.
* 3vtrasym.adb: Demangle Ada symbols returned by TBK$SYMBOLIZE. Correctly align line numbers when symbol name is too long. * g-signal.ads, g-signal.adb: New files * impunit.adb: (Non_Imp_File_Names): Added "g-signal" * Makefile.rtl: Introduce GNAT.Signals * 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 From-SVN: r73083
This commit is contained in:
Arnaud Charlet
parent
577d63287a
commit
bde58e3208
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- 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- --
|
||||
|
|
@ -26,7 +26,8 @@
|
|||
-- 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. --
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
|
|
@ -96,12 +97,83 @@ package body GNAT.Traceback.Symbolic is
|
|||
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;
|
||||
|
|
@ -152,6 +224,11 @@ package body GNAT.Traceback.Symbolic is
|
|||
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 => ' ');
|
||||
|
|
@ -168,13 +245,23 @@ package body GNAT.Traceback.Symbolic is
|
|||
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;
|
||||
|
||||
Res (First + 50 ..
|
||||
First + 50 + Integer'Image (Line_Number)'Length - 1) :=
|
||||
-- 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;
|
||||
|
|
|
|||
|
|
@ -1,3 +1,29 @@
|
|||
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,
|
||||
|
|
@ -8,10 +34,7 @@
|
|||
|
||||
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>
|
||||
|
|
|
|||
|
|
@ -38,6 +38,7 @@ GNATRTL_TASKING_OBJS= \
|
|||
g-boubuf$(objext) \
|
||||
g-boumai$(objext) \
|
||||
g-semaph$(objext) \
|
||||
g-signal$(objext) \
|
||||
g-thread$(objext) \
|
||||
s-asthan$(objext) \
|
||||
s-inmaop$(objext) \
|
||||
|
|
|
|||
|
|
@ -124,7 +124,7 @@ package body Freeze is
|
|||
-- 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
|
||||
|
|
@ -4262,12 +4262,12 @@ package body Freeze is
|
|||
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);
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,71 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- 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;
|
||||
|
||||
|
|
@ -0,0 +1,55 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- 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;
|
||||
|
|
@ -229,6 +229,7 @@ package body Impunit is
|
|||
"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
|
||||
|
|
|
|||
|
|
@ -680,6 +680,13 @@ package body Lib.Writ is
|
|||
-- 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.
|
||||
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- 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- --
|
||||
|
|
@ -367,12 +367,12 @@ package body Ch12 is
|
|||
-- 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;
|
||||
|
|
@ -873,7 +873,7 @@ package body Ch12 is
|
|||
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);
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- 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- --
|
||||
|
|
@ -92,7 +92,7 @@ package body Ch13 is
|
|||
-- 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
|
||||
|
||||
|
|
|
|||
|
|
@ -47,7 +47,7 @@ package body Ch2 is
|
|||
|
||||
-- Error recovery: can raise Error_Resync (cannot return Error)
|
||||
|
||||
function P_Identifier return Node_Id is
|
||||
function P_Identifier (C : Id_Check := None) return Node_Id is
|
||||
Ident_Node : Node_Id;
|
||||
|
||||
begin
|
||||
|
|
@ -61,7 +61,7 @@ package body Ch2 is
|
|||
-- If we have a reserved identifier, manufacture an identifier with
|
||||
-- a corresponding name after posting an appropriate error message
|
||||
|
||||
elsif Is_Reserved_Identifier then
|
||||
elsif Is_Reserved_Identifier (C) then
|
||||
Scan_Reserved_Identifier (Force_Msg => False);
|
||||
Ident_Node := Token_Node;
|
||||
Scan; -- past the node
|
||||
|
|
|
|||
|
|
@ -164,7 +164,7 @@ package body Ch3 is
|
|||
|
||||
-- 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
|
||||
|
|
@ -179,7 +179,7 @@ package body Ch3 is
|
|||
-- If we have a reserved identifier, manufacture an identifier with
|
||||
-- a corresponding name after posting an appropriate error message
|
||||
|
||||
elsif Is_Reserved_Identifier then
|
||||
elsif Is_Reserved_Identifier (C) then
|
||||
Scan_Reserved_Identifier (Force_Msg => True);
|
||||
|
||||
-- Otherwise we have junk that cannot be interpreted as an identifier
|
||||
|
|
@ -262,7 +262,7 @@ package body Ch3 is
|
|||
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
|
||||
|
|
@ -732,7 +732,7 @@ package body Ch3 is
|
|||
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
|
||||
|
|
@ -1090,7 +1090,7 @@ package body Ch3 is
|
|||
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.
|
||||
|
|
@ -1104,7 +1104,7 @@ package body Ch3 is
|
|||
|
||||
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
|
||||
|
|
@ -1685,7 +1685,7 @@ package body Ch3 is
|
|||
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;
|
||||
|
||||
|
|
@ -2278,12 +2278,12 @@ package body Ch3 is
|
|||
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;
|
||||
|
|
@ -2518,7 +2518,7 @@ package body Ch3 is
|
|||
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;
|
||||
|
|
@ -2747,12 +2747,12 @@ package body Ch3 is
|
|||
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;
|
||||
|
|
|
|||
|
|
@ -1004,7 +1004,7 @@ package body Ch5 is
|
|||
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;
|
||||
|
|
@ -1621,7 +1621,7 @@ package body Ch5 is
|
|||
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
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- 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- --
|
||||
|
|
@ -593,6 +593,10 @@ package body Ch6 is
|
|||
-- 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;
|
||||
|
||||
|
|
@ -715,7 +719,7 @@ package body Ch6 is
|
|||
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)
|
||||
|
|
@ -746,7 +750,7 @@ package body Ch6 is
|
|||
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;
|
||||
|
|
@ -870,7 +874,7 @@ package body Ch6 is
|
|||
|
||||
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
|
||||
|
|
@ -924,7 +928,7 @@ package body Ch6 is
|
|||
|
||||
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
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- 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- --
|
||||
|
|
@ -90,7 +90,7 @@ package body Ch9 is
|
|||
|
||||
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
|
||||
|
|
@ -133,7 +133,7 @@ package body Ch9 is
|
|||
|
||||
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;
|
||||
|
||||
|
|
@ -141,7 +141,6 @@ package body Ch9 is
|
|||
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
|
||||
|
|
@ -344,7 +343,7 @@ package body Ch9 is
|
|||
|
||||
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
|
||||
|
|
@ -381,7 +380,7 @@ package body Ch9 is
|
|||
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
|
||||
|
|
@ -390,7 +389,7 @@ package body Ch9 is
|
|||
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
|
||||
|
|
@ -631,7 +630,8 @@ package body Ch9 is
|
|||
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
|
||||
|
||||
|
|
@ -719,7 +719,7 @@ package body Ch9 is
|
|||
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
|
||||
|
||||
|
|
@ -932,7 +932,7 @@ package body Ch9 is
|
|||
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);
|
||||
|
|
|
|||
|
|
@ -24,6 +24,7 @@
|
|||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with Csets; use Csets;
|
||||
with Uintp; use Uintp;
|
||||
|
||||
with GNAT.Spelling_Checker; use GNAT.Spelling_Checker;
|
||||
|
|
@ -419,7 +420,7 @@ package body Util is
|
|||
-- 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;
|
||||
|
|
@ -438,20 +439,88 @@ package body Util is
|
|||
-- 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;
|
||||
|
||||
-- Otherwise assume that an identifier was intended
|
||||
|
||||
else
|
||||
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;
|
||||
|
||||
----------------------
|
||||
|
|
|
|||
|
|
@ -26,7 +26,6 @@
|
|||
|
||||
with Atree; use Atree;
|
||||
with Casing; use Casing;
|
||||
with Csets; use Csets;
|
||||
with Debug; use Debug;
|
||||
with Elists; use Elists;
|
||||
with Errout; use Errout;
|
||||
|
|
@ -189,6 +188,73 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
|
|||
-- 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 --
|
||||
--------------------------------------------
|
||||
|
|
@ -450,9 +516,12 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
|
|||
-- 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
|
||||
|
|
@ -482,7 +551,6 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
|
|||
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;
|
||||
|
|
@ -503,6 +571,11 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
|
|||
-- 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
|
||||
|
|
@ -908,10 +981,12 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
|
|||
-- 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
|
||||
|
|
|
|||
Loading…
Reference in New Issue