524 lines
17 KiB
Ada
524 lines
17 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- GNAT COMPILER COMPONENTS --
|
|
-- --
|
|
-- P A R . C H 2 --
|
|
-- --
|
|
-- B o d y --
|
|
-- --
|
|
-- Copyright (C) 1992-2010, 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 3, 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 COPYING3. If not, go to --
|
|
-- http://www.gnu.org/licenses for a complete copy of the license. --
|
|
-- --
|
|
-- GNAT was originally developed by the GNAT team at New York University. --
|
|
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
-- --
|
|
------------------------------------------------------------------------------
|
|
|
|
pragma Style_Checks (All_Checks);
|
|
-- Turn off subprogram body ordering check. Subprograms are in order
|
|
-- by RM section rather than alphabetical
|
|
|
|
separate (Par)
|
|
package body Ch2 is
|
|
|
|
-- Local functions, used only in this chapter
|
|
|
|
procedure Scan_Pragma_Argument_Association
|
|
(Identifier_Seen : in out Boolean;
|
|
Association : out Node_Id);
|
|
-- Scans out a pragma argument association. Identifier_Seen is true on
|
|
-- entry if a previous association had an identifier, and gets set True if
|
|
-- the scanned association has an identifier (this is used to check the
|
|
-- rule that no associations without identifiers can follow an association
|
|
-- which has an identifier). The result is returned in Association.
|
|
|
|
---------------------
|
|
-- 2.3 Identifier --
|
|
---------------------
|
|
|
|
-- IDENTIFIER ::= LETTER {[UNDERLINE] LETTER_OR_DIGIT}
|
|
|
|
-- LETTER_OR_DIGIT ::= IDENTIFIER_LETTER | DIGIT
|
|
|
|
-- An IDENTIFIER shall not be a reserved word
|
|
|
|
-- 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
|
|
-- All set if we do indeed have an identifier
|
|
|
|
if Token = Tok_Identifier then
|
|
|
|
-- Ada 2005 (AI-284): Compiling in Ada95 mode we warn that INTERFACE,
|
|
-- OVERRIDING, and SYNCHRONIZED are new reserved words.
|
|
|
|
if Ada_Version = Ada_95
|
|
and then Warn_On_Ada_2005_Compatibility
|
|
then
|
|
if Token_Name = Name_Overriding
|
|
or else Token_Name = Name_Synchronized
|
|
or else (Token_Name = Name_Interface
|
|
and then Prev_Token /= Tok_Pragma)
|
|
then
|
|
Error_Msg_N ("& is a reserved word in Ada 2005?", Token_Node);
|
|
end if;
|
|
end if;
|
|
|
|
Ident_Node := Token_Node;
|
|
Scan; -- past Identifier
|
|
return Ident_Node;
|
|
|
|
-- 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
|
|
return Ident_Node;
|
|
|
|
-- Otherwise we have junk that cannot be interpreted as an identifier
|
|
|
|
else
|
|
T_Identifier; -- to give message
|
|
raise Error_Resync;
|
|
end if;
|
|
end P_Identifier;
|
|
|
|
--------------------------
|
|
-- 2.3 Letter Or Digit --
|
|
--------------------------
|
|
|
|
-- Parsed by P_Identifier (2.3)
|
|
|
|
--------------------------
|
|
-- 2.4 Numeric Literal --
|
|
--------------------------
|
|
|
|
-- NUMERIC_LITERAL ::= DECIMAL_LITERAL | BASED_LITERAL
|
|
|
|
-- Numeric literal is returned by the scanner as either
|
|
-- Tok_Integer_Literal or Tok_Real_Literal
|
|
|
|
----------------------------
|
|
-- 2.4.1 Decimal Literal --
|
|
----------------------------
|
|
|
|
-- DECIMAL_LITERAL ::= NUMERAL [.NUMERAL] [EXPONENT]
|
|
|
|
-- Handled by scanner as part of numeric literal handing (see 2.4)
|
|
|
|
--------------------
|
|
-- 2.4.1 Numeral --
|
|
--------------------
|
|
|
|
-- NUMERAL ::= DIGIT {[UNDERLINE] DIGIT}
|
|
|
|
-- Handled by scanner as part of numeric literal handling (see 2.4)
|
|
|
|
---------------------
|
|
-- 2.4.1 Exponent --
|
|
---------------------
|
|
|
|
-- EXPONENT ::= E [+] NUMERAL | E - NUMERAL
|
|
|
|
-- Handled by scanner as part of numeric literal handling (see 2.4)
|
|
|
|
--------------------------
|
|
-- 2.4.2 Based Literal --
|
|
--------------------------
|
|
|
|
-- BASED_LITERAL ::=
|
|
-- BASE # BASED_NUMERAL [.BASED_NUMERAL] # [EXPONENT]
|
|
|
|
-- Handled by scanner as part of numeric literal handling (see 2.4)
|
|
|
|
-----------------
|
|
-- 2.4.2 Base --
|
|
-----------------
|
|
|
|
-- BASE ::= NUMERAL
|
|
|
|
-- Handled by scanner as part of numeric literal handling (see 2.4)
|
|
|
|
--------------------------
|
|
-- 2.4.2 Based Numeral --
|
|
--------------------------
|
|
|
|
-- BASED_NUMERAL ::=
|
|
-- EXTENDED_DIGIT {[UNDERLINE] EXTENDED_DIGIT}
|
|
|
|
-- Handled by scanner as part of numeric literal handling (see 2.4)
|
|
|
|
---------------------------
|
|
-- 2.4.2 Extended Digit --
|
|
---------------------------
|
|
|
|
-- EXTENDED_DIGIT ::= DIGIT | A | B | C | D | E | F
|
|
|
|
-- Handled by scanner as part of numeric literal handling (see 2.4)
|
|
|
|
----------------------------
|
|
-- 2.5 Character Literal --
|
|
----------------------------
|
|
|
|
-- CHARACTER_LITERAL ::= ' GRAPHIC_CHARACTER '
|
|
|
|
-- Handled by the scanner and returned as Tok_Char_Literal
|
|
|
|
-------------------------
|
|
-- 2.6 String Literal --
|
|
-------------------------
|
|
|
|
-- STRING LITERAL ::= "{STRING_ELEMENT}"
|
|
|
|
-- Handled by the scanner and returned as Tok_String_Literal
|
|
-- or if the string looks like an operator as Tok_Operator_Symbol.
|
|
|
|
-------------------------
|
|
-- 2.6 String Element --
|
|
-------------------------
|
|
|
|
-- STRING_ELEMENT ::= "" | non-quotation_mark_GRAPHIC_CHARACTER
|
|
|
|
-- A STRING_ELEMENT is either a pair of quotation marks ("),
|
|
-- or a single GRAPHIC_CHARACTER other than a quotation mark.
|
|
|
|
-- Handled by scanner as part of string literal handling (see 2.4)
|
|
|
|
------------------
|
|
-- 2.7 Comment --
|
|
------------------
|
|
|
|
-- A COMMENT starts with two adjacent hyphens and extends up to the
|
|
-- end of the line. A COMMENT may appear on any line of a program.
|
|
|
|
-- Handled by the scanner which simply skips past encountered comments
|
|
|
|
-----------------
|
|
-- 2.8 Pragma --
|
|
-----------------
|
|
|
|
-- PRAGMA ::= pragma IDENTIFIER
|
|
-- [(PRAGMA_ARGUMENT_ASSOCIATION {, PRAGMA_ARGUMENT_ASSOCIATION})];
|
|
|
|
-- The caller has checked that the initial token is PRAGMA
|
|
|
|
-- Error recovery: cannot raise Error_Resync
|
|
|
|
-- One special piece of processing is needed in this routine. As described
|
|
-- in the section on "Handling semicolon used in place of IS" in module
|
|
-- Parse, the parser detects the case of missing subprogram bodies to
|
|
-- allow recovery from this syntactic error. Pragma INTERFACE (and, for
|
|
-- Ada 95, pragma IMPORT) can appear in place of the body. The parser must
|
|
-- recognize the use of these two pragmas in this context, otherwise it
|
|
-- will think there are missing bodies, and try to change ; to IS, when
|
|
-- in fact the bodies ARE present, supplied by these pragmas.
|
|
|
|
function P_Pragma (Skipping : Boolean := False) return Node_Id is
|
|
Interface_Check_Required : Boolean := False;
|
|
-- Set True if check of pragma INTERFACE is required
|
|
|
|
Import_Check_Required : Boolean := False;
|
|
-- Set True if check of pragma IMPORT is required
|
|
|
|
Arg_Count : Int := 0;
|
|
-- Number of argument associations processed
|
|
|
|
Identifier_Seen : Boolean := False;
|
|
-- Set True if an identifier is encountered for a pragma argument. Used
|
|
-- to check that there are no more arguments without identifiers.
|
|
|
|
Prag_Node : Node_Id;
|
|
Prag_Name : Name_Id;
|
|
Semicolon_Loc : Source_Ptr;
|
|
Ident_Node : Node_Id;
|
|
Assoc_Node : Node_Id;
|
|
Result : Node_Id;
|
|
|
|
procedure Skip_Pragma_Semicolon;
|
|
-- Skip past semicolon at end of pragma
|
|
|
|
---------------------------
|
|
-- Skip_Pragma_Semicolon --
|
|
---------------------------
|
|
|
|
procedure Skip_Pragma_Semicolon is
|
|
begin
|
|
if Token /= Tok_Semicolon then
|
|
|
|
-- If skipping the pragma, ignore a missing semicolon
|
|
|
|
if Skipping then
|
|
null;
|
|
|
|
-- Otherwise demand a semicolon
|
|
|
|
else
|
|
T_Semicolon;
|
|
end if;
|
|
|
|
-- Scan past semicolon if present
|
|
|
|
else
|
|
Scan;
|
|
end if;
|
|
end Skip_Pragma_Semicolon;
|
|
|
|
-- Start of processing for P_Pragma
|
|
|
|
begin
|
|
Prag_Node := New_Node (N_Pragma, Token_Ptr);
|
|
Scan; -- past PRAGMA
|
|
Prag_Name := Token_Name;
|
|
|
|
if Style_Check then
|
|
Style.Check_Pragma_Name;
|
|
end if;
|
|
|
|
-- Ada 2005 (AI-284): INTERFACE is a new reserved word but it is
|
|
-- allowed as a pragma name.
|
|
|
|
if Ada_Version >= Ada_2005
|
|
and then Token = Tok_Interface
|
|
then
|
|
Prag_Name := Name_Interface;
|
|
Ident_Node := Make_Identifier (Token_Ptr, Name_Interface);
|
|
Scan; -- past INTERFACE
|
|
else
|
|
Ident_Node := P_Identifier;
|
|
end if;
|
|
|
|
Set_Pragma_Identifier (Prag_Node, Ident_Node);
|
|
|
|
-- See if special INTERFACE/IMPORT check is required
|
|
|
|
if SIS_Entry_Active then
|
|
Interface_Check_Required := (Prag_Name = Name_Interface);
|
|
Import_Check_Required := (Prag_Name = Name_Import);
|
|
else
|
|
Interface_Check_Required := False;
|
|
Import_Check_Required := False;
|
|
end if;
|
|
|
|
-- Scan arguments. We assume that arguments are present if there is
|
|
-- a left paren, or if a semicolon is missing and there is another
|
|
-- token on the same line as the pragma name.
|
|
|
|
if Token = Tok_Left_Paren
|
|
or else (Token /= Tok_Semicolon
|
|
and then not Token_Is_At_Start_Of_Line)
|
|
then
|
|
Set_Pragma_Argument_Associations (Prag_Node, New_List);
|
|
T_Left_Paren;
|
|
|
|
loop
|
|
Arg_Count := Arg_Count + 1;
|
|
Scan_Pragma_Argument_Association (Identifier_Seen, Assoc_Node);
|
|
|
|
if Arg_Count = 2
|
|
and then (Interface_Check_Required or else Import_Check_Required)
|
|
then
|
|
-- Here is where we cancel the SIS active status if this pragma
|
|
-- supplies a body for the currently active subprogram spec.
|
|
|
|
if Nkind (Expression (Assoc_Node)) in N_Direct_Name
|
|
and then Chars (Expression (Assoc_Node)) = Chars (SIS_Labl)
|
|
then
|
|
SIS_Entry_Active := False;
|
|
end if;
|
|
end if;
|
|
|
|
Append (Assoc_Node, Pragma_Argument_Associations (Prag_Node));
|
|
exit when Token /= Tok_Comma;
|
|
Scan; -- past comma
|
|
end loop;
|
|
|
|
-- If we have := for pragma Debug, it is worth special casing the
|
|
-- error message (it is easy to think of pragma Debug as taking a
|
|
-- statement, and an assignment statement is the most likely
|
|
-- candidate for this error)
|
|
|
|
if Token = Tok_Colon_Equal and then Prag_Name = Name_Debug then
|
|
Error_Msg_SC ("argument for pragma Debug must be procedure call");
|
|
Resync_To_Semicolon;
|
|
|
|
-- Normal case, we expect a right paren here
|
|
|
|
else
|
|
T_Right_Paren;
|
|
end if;
|
|
end if;
|
|
|
|
Semicolon_Loc := Token_Ptr;
|
|
|
|
-- Now we have two tasks left, we need to scan out the semicolon
|
|
-- following the pragma, and we have to call Par.Prag to process
|
|
-- the pragma. Normally we do them in this order, however, there
|
|
-- is one exception namely pragma Style_Checks where we like to
|
|
-- skip the semicolon after processing the pragma, since that way
|
|
-- the style checks for the scanning of the semicolon follow the
|
|
-- settings of the pragma.
|
|
|
|
-- You might think we could just unconditionally do things in
|
|
-- the opposite order, but there are other pragmas, notably the
|
|
-- case of pragma Source_File_Name, which assume the semicolon
|
|
-- is already scanned out.
|
|
|
|
if Prag_Name = Name_Style_Checks then
|
|
Result := Par.Prag (Prag_Node, Semicolon_Loc);
|
|
Skip_Pragma_Semicolon;
|
|
return Result;
|
|
else
|
|
Skip_Pragma_Semicolon;
|
|
return Par.Prag (Prag_Node, Semicolon_Loc);
|
|
end if;
|
|
|
|
exception
|
|
when Error_Resync =>
|
|
Resync_Past_Semicolon;
|
|
return Error;
|
|
|
|
end P_Pragma;
|
|
|
|
-- This routine is called if a pragma is encountered in an inappropriate
|
|
-- position, the pragma is scanned out and control returns to continue.
|
|
|
|
-- The caller has checked that the initial token is pragma
|
|
|
|
-- Error recovery: cannot raise Error_Resync
|
|
|
|
procedure P_Pragmas_Misplaced is
|
|
begin
|
|
while Token = Tok_Pragma loop
|
|
Error_Msg_SC ("pragma not allowed here");
|
|
Discard_Junk_Node (P_Pragma (Skipping => True));
|
|
end loop;
|
|
end P_Pragmas_Misplaced;
|
|
|
|
-- This function is called to scan out an optional sequence of pragmas.
|
|
-- If no pragmas are found, then No_List is returned.
|
|
|
|
-- Error recovery: Cannot raise Error_Resync
|
|
|
|
function P_Pragmas_Opt return List_Id is
|
|
L : List_Id;
|
|
|
|
begin
|
|
if Token = Tok_Pragma then
|
|
L := New_List;
|
|
P_Pragmas_Opt (L);
|
|
return L;
|
|
|
|
else
|
|
return No_List;
|
|
end if;
|
|
end P_Pragmas_Opt;
|
|
|
|
-- This procedure is called to scan out an optional sequence of pragmas.
|
|
-- Any pragmas found are appended to the list provided as an argument.
|
|
|
|
-- Error recovery: Cannot raise Error_Resync
|
|
|
|
procedure P_Pragmas_Opt (List : List_Id) is
|
|
P : Node_Id;
|
|
|
|
begin
|
|
while Token = Tok_Pragma loop
|
|
P := P_Pragma;
|
|
|
|
if Nkind (P) /= N_Error
|
|
and then (Pragma_Name (P) = Name_Assert
|
|
or else
|
|
Pragma_Name (P) = Name_Debug)
|
|
then
|
|
Error_Msg_Name_1 := Pragma_Name (P);
|
|
Error_Msg_N
|
|
("pragma% must be in declaration/statement context", P);
|
|
else
|
|
Append (P, List);
|
|
end if;
|
|
end loop;
|
|
end P_Pragmas_Opt;
|
|
|
|
--------------------------------------
|
|
-- 2.8 Pragma_Argument Association --
|
|
--------------------------------------
|
|
|
|
-- PRAGMA_ARGUMENT_ASSOCIATION ::=
|
|
-- [pragma_argument_IDENTIFIER =>] NAME
|
|
-- | [pragma_argument_IDENTIFIER =>] EXPRESSION
|
|
|
|
-- Error recovery: cannot raise Error_Resync
|
|
|
|
procedure Scan_Pragma_Argument_Association
|
|
(Identifier_Seen : in out Boolean;
|
|
Association : out Node_Id)
|
|
is
|
|
Scan_State : Saved_Scan_State;
|
|
Identifier_Node : Node_Id;
|
|
Id_Present : Boolean;
|
|
|
|
begin
|
|
Association := New_Node (N_Pragma_Argument_Association, Token_Ptr);
|
|
Set_Chars (Association, No_Name);
|
|
|
|
-- Argument starts with identifier
|
|
|
|
if Token = Tok_Identifier then
|
|
Identifier_Node := Token_Node;
|
|
Save_Scan_State (Scan_State); -- at Identifier
|
|
Scan; -- past Identifier
|
|
|
|
if Token = Tok_Arrow then
|
|
Identifier_Seen := True;
|
|
Scan; -- past arrow
|
|
Set_Chars (Association, Chars (Identifier_Node));
|
|
Id_Present := True;
|
|
|
|
-- Case of argument with no identifier
|
|
|
|
else
|
|
Restore_Scan_State (Scan_State); -- to Identifier
|
|
Id_Present := False;
|
|
end if;
|
|
|
|
-- Argument does not start with identifier
|
|
|
|
else
|
|
Id_Present := False;
|
|
end if;
|
|
|
|
-- Diagnose error of "positional" argument for pragma appearing after
|
|
-- a "named" argument (quotes here are because that's not quite accurate
|
|
-- Ada RM terminology).
|
|
|
|
-- Since older GNAT versions did not generate this error, disable this
|
|
-- message in codepeer mode to help legacy code using codepeer.
|
|
|
|
if Identifier_Seen and not Id_Present and not CodePeer_Mode then
|
|
Error_Msg_SC ("|pragma argument identifier required here");
|
|
Error_Msg_SC ("\since previous argument had identifier (RM 2.8(4))");
|
|
end if;
|
|
|
|
if Id_Present then
|
|
Set_Expression (Association, P_Expression);
|
|
else
|
|
Set_Expression (Association, P_Expression_If_OK);
|
|
end if;
|
|
end Scan_Pragma_Argument_Association;
|
|
|
|
end Ch2;
|