-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, 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- --
+-- 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 COPYING. If not, write --
--- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
--- Boston, MA 02110-1301, USA. --
+-- 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. --
with Nmake; use Nmake;
with Opt; use Opt;
with Output; use Output;
+with Par_SCO; use Par_SCO;
with Scans; use Scans;
with Scn; use Scn;
with Sinput; use Sinput;
with Sinfo; use Sinfo;
with Snames; use Snames;
with Style;
+with Stylesw; use Stylesw;
with Table;
with Tbuild; use Tbuild;
-- Par --
---------
-function Par
- (Configuration_Pragmas : Boolean) return List_Id
-is
+function Par (Configuration_Pragmas : Boolean) return List_Id is
+
Num_Library_Units : Natural := 0;
-- Count number of units parsed (relevant only in syntax check only mode,
-- since in semantics check mode only a single unit is permitted anyway)
-- 4. We encounter a valid pragma INTERFACE or IMPORT that effectively
-- supplies the missing body. In this case we reset the entry.
- -- 5. We encounter the end of the declarative region without encoutering
+ -- 5. We encounter the end of the declarative region without encountering
-- a BEGIN first. In this situation we simply reset the entry. We know
-- 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).
+ -- Note: throughout the parser, the terms reserved word and keyword are
+ -- used interchangeably 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.
+ -- 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.
+ -- 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.
+ -- declaration, the appearance 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
+ -- these functions 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
-- end;
-- The trouble is that the section of text from PROCEDURE B through END;
- -- consitutes a valid procedure body, and the danger is that we find out
+ -- constitutes a valid procedure body, and the danger is that we find out
-- far too late that something is wrong (indeed most compilers will behave
-- uncomfortably on the above example).
-- We have two approaches to helping to control this situation. First we
- -- make every attempt to avoid swallowing the last END; if we can be
- -- sure that some error will result from doing so. In particular, we won't
+ -- make every attempt to avoid swallowing the last END; if we can be sure
+ -- that some error will result from doing so. In particular, we won't
-- accept the END; unless it is exactly correct (in particular it must not
-- have incorrect name tokens), and we won't accept it if it is immediately
-- followed by end of file, WITH or SEPARATE (all tokens that unmistakeably
-- reserve the END; for the outer level.) For more details on this aspect
-- of the handling, see package Par.Endh.
- -- If we can avoid eating up the END; then the result in the absense of
+ -- If we can avoid eating up the END; then the result in the absence of
-- any additional steps would be to post a missing END referring back to
-- the subprogram with the bogus IS. Similarly, if the enclosing package
-- has no BEGIN, then the result is a missing BEGIN message, which again
-- Scope Table --
-----------------
- -- The scope table, also referred to as the scope stack, is used to
- -- record the current scope context. It is organized as a stack, with
- -- inner nested entries corresponding to higher entries on the stack.
- -- An entry is made when the parser encounters the opening of a nested
- -- construct (such as a record, task, package etc.), and then package
- -- Par.Endh uses this stack to deal with END lines (including properly
- -- dealing with END nesting errors).
+ -- The scope table, also referred to as the scope stack, is used to record
+ -- the current scope context. It is organized as a stack, with inner nested
+ -- entries corresponding to higher entries on the stack. An entry is made
+ -- when the parser encounters the opening of a nested construct (such as a
+ -- record, task, package etc.), and then package Par.Endh uses this stack
+ -- to deal with END lines (including properly dealing with END nesting
+ -- errors).
type SS_End_Type is
-- Type of end entry required for this scope. The last two entries are
Lreq : Boolean;
-- A flag indicating whether the label, if present, is required to
- -- appear on the end line. It is referenced only in the case of
- -- Etyp = E_Name or E_Suspicious_Is where the name may or may not be
+ -- appear on the end line. It is referenced only in the case of Etyp is
+ -- equal to E_Name or E_Suspicious_Is where the name may or may not be
-- required (yes for labeled block, no in other cases). Note that for
-- all cases except begin, the question of whether a label is required
-- can be determined from the other fields (for loop, it is required if
Ecol : Column_Number;
-- Contains the absolute column number (with tabs expanded) of the
- -- the expected column of the end assuming normal Ada indentation
- -- usage. If the RM_Column_Check mode is set, this value is used for
- -- generating error messages about indentation. Otherwise it is used
- -- only to control heuristic error recovery actions.
+ -- expected column of the end assuming normal Ada indentation usage. If
+ -- the RM_Column_Check mode is set, this value is used for generating
+ -- error messages about indentation. Otherwise it is used only to
+ -- control heuristic error recovery actions.
Labl : Node_Id;
-- This field is used only for the LOOP and BEGIN cases, and is the
-- the proper location for implicit label declarations.
Node : Node_Id;
- -- Empty except in the case of entries for IF and CASE statements,
- -- in which case it contains the N_If_Statement or N_Case_Statement
- -- node. This is used for setting the End_Span field.
+ -- Empty except in the case of entries for IF and CASE statements, in
+ -- which case it contains the N_If_Statement or N_Case_Statement node.
+ -- This is used for setting the End_Span field.
Sloc : Source_Ptr;
- -- Source location of the opening token of the construct. This is
- -- used to refer back to this line in error messages (such as missing
- -- or incorrect end lines). The Sloc field is not used, and is not set,
- -- if a label is present (the Labl field provides the text name of the
+ -- Source location of the opening token of the construct. This is used
+ -- to refer back to this line in error messages (such as missing or
+ -- incorrect end lines). The Sloc field is not used, and is not set, if
+ -- a label is present (the Labl field provides the text name of the
-- label in this case, which is fine for error messages).
S_Is : Source_Ptr;
- -- S_Is is relevant only if Etyp is set to E_Suspicious_Is or
- -- E_Bad_Is. It records the location of the IS that is considered
- -- to be suspicious.
+ -- S_Is is relevant only if Etyp is set to E_Suspicious_Is or E_Bad_Is.
+ -- It records the location of the IS that is considered to be
+ -- suspicious.
Junk : Boolean;
-- A boolean flag that is set true if the opening entry is the dubious
-------------
package Ch2 is
- function P_Pragma return Node_Id;
+ function P_Pragma (Skipping : Boolean := False) return Node_Id;
+ -- Scan out a pragma. If Skipping is True, then the caller is skipping
+ -- the pragma in the context of illegal placement (this is used to avoid
+ -- some junk cascaded messages).
function P_Identifier (C : Id_Check := None) return Node_Id;
-- Scans out an identifier. The parameter C determines the treatment
function P_Known_Discriminant_Part_Opt return List_Id;
function P_Signed_Integer_Type_Definition return Node_Id;
function P_Range return Node_Id;
- function P_Range_Or_Subtype_Mark return Node_Id;
function P_Range_Constraint return Node_Id;
function P_Record_Definition return Node_Id;
function P_Subtype_Mark return Node_Id;
-- removed the ACCESS token
procedure P_Component_Items (Decls : List_Id);
- -- Scan out one or more component items and append them to the
- -- given list. Only scans out more than one declaration in the
- -- case where the source has a single declaration with multiple
- -- defining identifiers.
+ -- Scan out one or more component items and append them to the given
+ -- list. Only scans out more than one declaration in the 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
(Allow_Anonymous_In_95 : Boolean := False) return Boolean;
-- Ada 2005 (AI-231): Parse the null-excluding part. A True result
-- indicates that the null-excluding part was present.
+ --
-- Allow_Anonymous_In_95 is True if we are in a context that allows
-- anonymous access types in Ada 95, in which case "not null" is legal
-- if it precedes "access".
-- Ada 2005 (AI-231): The flag Not_Null_Present indicates that the
-- null-excluding part has been scanned out and it was present.
+ function P_Range_Or_Subtype_Mark
+ (Allow_Simple_Expression : Boolean := False) return Node_Id;
+ -- Scans out a range or subtype mark, and also permits a general simple
+ -- expression if Allow_Simple_Expresion is set to True.
+
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
-- allowed).
procedure Skip_Declaration (S : List_Id);
- -- Used when scanning statements to skip past a mispaced declaration
+ -- Used when scanning statements to skip past a misplaced declaration
-- The declaration is scanned out and appended to the given list.
-- Token is known to be a declaration token (in Token_Class_Declk)
-- on entry, so there definition is a declaration to be scanned.
package Ch4 is
function P_Aggregate return Node_Id;
function P_Expression return Node_Id;
- function P_Expression_No_Right_Paren return Node_Id;
function P_Expression_Or_Range_Attribute return Node_Id;
function P_Function_Name return Node_Id;
function P_Name return Node_Id;
function P_Simple_Expression return Node_Id;
function P_Simple_Expression_Or_Range_Attribute return Node_Id;
- function P_Qualified_Expression
- (Subtype_Mark : Node_Id)
- return Node_Id;
+ function P_Conditional_Expression return Node_Id;
+ -- Scans out a conditional expression. Called with token pointing to
+ -- the IF keyword, and returns pointing to the terminating right paren,
+ -- semicolon or comma, but does not consume this terminating token.
+
+ function P_Expression_If_OK return Node_Id;
+ -- Scans out an expression in a context where a conditional expression
+ -- is permitted to appear without surrounding parentheses.
+
+ function P_Expression_No_Right_Paren return Node_Id;
+ -- Scans out an expression in contexts where the expression cannot be
+ -- terminated by a right paren (gives better error recovery if an errant
+ -- right paren is found after the expression).
+
+ function P_Expression_Or_Range_Attribute_If_OK return Node_Id;
+ -- Scans out an expression or range attribute where a conditional
+ -- expression is permitted to appear without surrounding parentheses.
+
+ function P_Qualified_Expression (Subtype_Mark : Node_Id) return Node_Id;
-- This routine scans out a qualified expression when the caller has
-- already scanned out the name and apostrophe of the construct.
end Ch4;
function P_Subprogram_Specification return Node_Id;
procedure P_Mode (Node : Node_Id);
- -- Sets In_Present and/or Out_Present flags in Node scanning past
- -- IN, OUT or IN OUT tokens in the source.
+ -- Sets In_Present and/or Out_Present flags in Node scanning past IN,
+ -- OUT or IN OUT tokens in the source.
function P_Subprogram (Pf_Flags : Pf_Rec) return Node_Id;
-- Scans out any construct starting with either of the keywords
package Ch10 is
function P_Compilation_Unit return Node_Id;
- -- Note: this function scans a single compilation unit, and
- -- checks that an end of file follows this unit, diagnosing
- -- any unexpected input as an error, and then skipping it, so
- -- that Token is set to Tok_EOF on return. An exception is in
- -- syntax-only mode, where multiple compilation units are
- -- permitted. In this case, P_Compilation_Unit does not check
- -- for end of file and there may be more compilation units to
- -- scan. The caller can uniquely detect this situation by the
+ -- Note: this function scans a single compilation unit, and checks that
+ -- an end of file follows this unit, diagnosing any unexpected input as
+ -- an error, and then skipping it, so that Token is set to Tok_EOF on
+ -- return. An exception is in syntax-only mode, where multiple
+ -- compilation units are permitted. In this case, P_Compilation_Unit
+ -- does not check for end of file and there may be more compilation
+ -- units to scan. The caller can uniquely detect this situation by the
-- fact that Token is not set to Tok_EOF on return.
--
- -- The Ignore parameter is normally set False. It is set True
- -- in multiple unit per file mode if we are skipping past a unit
- -- that we are not interested in.
+ -- What about multiple unit/file capability that now exists???
+ --
+ -- The Ignore parameter is normally set False. It is set True in the
+ -- multiple unit per file mode if we are skipping past a unit that we
+ -- are not interested in.
end Ch10;
--------------
function Parse_Exception_Handlers return List_Id;
-- Parses the partial construct EXCEPTION followed by a list of
- -- exception handlers which appears in a number of productions,
- -- and returns the list of exception handlers.
+ -- exception handlers which appears in a number of productions, and
+ -- returns the list of exception handlers.
end Ch11;
--------------
-- left pointing to the semicolon rather than past it.
procedure Resync_Past_Semicolon_Or_To_Loop_Or_Then;
- -- Used if an error occurs while scanning a sequence of statements.
- -- The scan pointer is positioned past the next semicolon, or to the
- -- next occurrence of either then or loop, and the scan resumes.
+ -- Used if an error occurs while scanning a sequence of statements. The
+ -- scan pointer is positioned past the next semicolon, or to the next
+ -- occurrence of either then or loop, and the scan resumes.
procedure Resync_To_When;
- -- Used when an error occurs scanning an entry index specification.
- -- The scan pointer is positioned to the next WHEN (or to IS or
- -- semicolon if either of these appear before WHEN, indicating
- -- another error has occurred).
+ -- Used when an error occurs scanning an entry index specification. The
+ -- scan pointer is positioned to the next WHEN (or to IS or semicolon if
+ -- either of these appear before WHEN, indicating another error has
+ -- occurred).
procedure Resync_Semicolon_List;
-- Used if an error occurs while scanning a parenthesized list of items
-- separated by semicolons. The scan pointer is advanced to the next
-- semicolon or right parenthesis at the outer parenthesis level, or
- -- to the next is or RETURN keyword occurence, whichever comes first.
+ -- to the next is or RETURN keyword occurrence, whichever comes first.
procedure Resync_Cunit;
-- Synchronize to next token which could be the start of a compilation
procedure T_When;
procedure T_With;
- -- Procedures have names of the form TF_xxx, where Tok_xxx is a token
+ -- Procedures having names of the form TF_xxx, where Tok_xxx is a token
-- name check that the current token matches the required token, and
-- if so, scan past it. If not, an error message is issued indicating
-- that the required token is not present (xxx expected).
procedure TF_Semicolon;
procedure TF_Then;
procedure TF_Use;
+
+ -- Procedures with names of the form U_xxx, where Tok_xxx is a token
+ -- name, are just like the corresponding T_xxx procedures except that
+ -- an error message, if given, is unconditional.
+
+ procedure U_Left_Paren;
+ procedure U_Right_Paren;
end Tchk;
--------------
-- it is returned unchanged. Otherwise an error message is issued
-- and Error is returned.
- procedure Check_No_Right_Paren;
- -- Called to check that the current token is not a right paren. If it
- -- is, then an error is given, and the right parenthesis is scanned out.
-
function Comma_Present return Boolean;
-- Used in comma delimited lists to determine if a comma is present, or
-- can reasonably be assumed to have been present (an error message is
-- conditions are met, an error message is issued, and the merge is
-- carried out, modifying the Chars field of Prev.
+ function Next_Token_Is (Tok : Token_Type) return Boolean;
+ -- Looks at token after current one and returns True if the token type
+ -- matches Tok. The scan is unconditionally restored on return.
+
procedure No_Constraint;
-- Called in a place where no constraint is allowed, but one might
-- appear due to a common error (e.g. after the type mark in a procedure
pragma Inline (Push_Scope_Stack);
-- Push a new entry onto the scope stack. Scope.Last (the stack pointer)
-- is incremented. The Junk field is preinitialized to False. The caller
- -- is expected to fill in all remaining entries of the new new top stack
+ -- is expected to fill in all remaining entries of the new top stack
-- entry at Scope.Table (Scope.Last).
procedure Pop_Scope_Stack;
function Token_Is_At_End_Of_Line return Boolean;
-- Determines if the current token is the last token on the line
+
end Util;
--------------
-- Give error if bad pragma
- if Chars (P_Node) > Last_Configuration_Pragma_Name
- and then Chars (P_Node) /= Name_Source_Reference
+ if not Is_Configuration_Pragma_Name (Pragma_Name (P_Node))
+ and then Pragma_Name (P_Node) /= Name_Source_Reference
then
- if Is_Pragma_Name (Chars (P_Node)) then
+ if Is_Pragma_Name (Pragma_Name (P_Node)) then
Error_Msg_N
("only configuration pragmas allowed " &
"in configuration file", P_Node);
if Ucount < Multiple_Unit_Index then
- -- We skip in syntax check only mode, since we don't want
- -- to do anything more than skip past the unit and ignore it.
- -- This causes processing like setting up a unit table entry
- -- to be skipped.
+ -- We skip in syntax check only mode, since we don't want to do
+ -- anything more than skip past the unit and ignore it. This means
+ -- we skip processing like setting up a unit table entry.
declare
Save_Operating_Mode : constant Operating_Mode_Type :=
Operating_Mode := Save_Operating_Mode;
Style_Check := Save_Style_Check;
- -- If we are at an end of file, and not yet at the right
- -- unit, then we have a fatal error. The unit is missing.
+ -- If we are at an end of file, and not yet at the right unit,
+ -- then we have a fatal error. The unit is missing.
if Token = Tok_EOF then
Error_Msg_SC ("file has too few compilation units");
end if;
end;
- -- Here if we are not skipping a file in multiple unit per file
- -- mode. Parse the unit that we are interested in. Note that in
- -- check syntax mode we are interested in all units in the file.
+ -- Here if we are not skipping a file in multiple unit per file mode.
+ -- Parse the unit that we are interested in. Note that in check
+ -- syntax mode we are interested in all units in the file.
else
declare
begin
-- If parsing was successful and we are not in check syntax
- -- mode, check that language defined units are compiled in
- -- GNAT mode. For this purpose we do NOT consider renamings
- -- in annex J as predefined. That allows users to compile
- -- their own versions of these files, and in particular,
- -- in the VMS implementation, the DEC versions can be
- -- substituted for the standard Ada 95 versions. Another
- -- exception is System.RPC and its children. This allows
- -- a user to supply their own communication layer.
+ -- mode, check that language defined units are compiled in GNAT
+ -- mode. For this purpose we do NOT consider renamings in annex
+ -- J as predefined. That allows users to compile their own
+ -- versions of these files, and in particular, in the VMS
+ -- implementation, the DEC versions can be substituted for the
+ -- standard Ada 95 versions. Another exception is System.RPC
+ -- and its children. This allows a user to supply their own
+ -- communication layer.
if Comp_Unit_Node /= Error
and then Operating_Mode = Generate_Code
Name : String (1 .. Uname'Length - 2);
begin
- -- Because Unit_Name includes "%s" or "%b", we need to
- -- strip the last two characters to get the real unit
- -- name.
+ -- Because Unit_Name includes "%s"/"%b", we need to strip
+ -- the last two characters to get the real unit name.
Name := Uname (Uname'First .. Uname'Last - 2);
Restore_Opt_Config_Switches (Save_Config_Switches);
end loop;
- -- Now that we have completely parsed the source file, we can
- -- complete the source file table entry.
+ -- Now that we have completely parsed the source file, we can complete
+ -- the source file table entry.
Complete_Source_File_Entry;
pragma Assert (Scope.Last = 0);
- -- Remaining steps are to create implicit label declarations and to
- -- load required subsidiary sources. These steps are required only
- -- if we are doing semantic checking.
+ -- Here we make the SCO table entries for the main unit
+
+ if Generate_SCO then
+ SCO_Record (Main_Unit);
+ end if;
+
+ -- Remaining steps are to create implicit label declarations and to load
+ -- required subsidiary sources. These steps are required only if we are
+ -- doing semantic checking.
if Operating_Mode /= Check_Syntax or else Debug_Flag_F then
Par.Labl;
OSDN Git Service
