blob: 075af019fee567c23498d3ba1f8ba05223832f97 [file] [log] [blame]
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- P A R . C H 1 3 --
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2023, 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. --
-- --
------------------------------------------------------------------------------
with Rident; use Rident;
with Restrict; use Restrict;
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 Ch13 is
-- Local functions, used only in this chapter
function P_Component_Clause return Node_Id;
function P_Mod_Clause return Node_Id;
-----------------------------------
-- Aspect_Specifications_Present --
-----------------------------------
function Aspect_Specifications_Present
(Strict : Boolean := Ada_Version < Ada_2012) return Boolean
is
Scan_State : Saved_Scan_State;
Result : Boolean;
function With_Present return Boolean;
-- Returns True if WITH is present, indicating presence of aspect
-- specifications. Also allows incorrect use of WHEN in place of WITH.
------------------
-- With_Present --
------------------
function With_Present return Boolean is
begin
if Token = Tok_With then
return True;
-- Check for WHEN used in place of WITH
elsif Token = Tok_When then
declare
Scan_State : Saved_Scan_State;
begin
Save_Scan_State (Scan_State);
Scan; -- past WHEN
if Token = Tok_Identifier
and then Is_Aspect_Id (Token_Name)
then
Error_Msg_SC ("WHEN should be WITH");
Restore_Scan_State (Scan_State);
return True;
else
Restore_Scan_State (Scan_State);
return False;
end if;
end;
else
return False;
end if;
end With_Present;
-- Start of processing for Aspect_Specifications_Present
begin
-- Definitely must have WITH to consider aspect specs to be present
-- Note that this means that if we have a semicolon, we immediately
-- return False. There is a case in which this is not optimal, namely
-- something like
-- type R is new Integer;
-- with bla bla;
-- where the semicolon is redundant, but scanning forward for it would
-- be too expensive. Instead we pick up the aspect specifications later
-- as a bogus declaration, and diagnose the semicolon at that point.
if not With_Present then
return False;
end if;
-- Have a WITH or some token that we accept as a legitimate bad attempt
-- at writing WITH. See if it looks like an aspect specification
Save_Scan_State (Scan_State);
Scan; -- past WITH (or WHEN or other bad keyword)
-- If no identifier, then consider that we definitely do not have an
-- aspect specification.
if Token /= Tok_Identifier then
Result := False;
-- This is where we pay attention to the Strict mode. Normally when
-- we are in Ada 2012 mode, Strict is False, and we consider that we
-- have an aspect specification if the identifier is an aspect name
-- or a likely misspelling of one (even if not followed by =>) or
-- the identifier is not an aspect name but is followed by =>, by
-- a comma, or by a semicolon. The last two cases correspond to
-- (misspelled) Boolean aspects with a defaulted value of True.
-- P_Aspect_Specifications will generate messages if the aspect
-- specification is ill-formed.
elsif not Strict then
if Is_Aspect_Id (Token_Name)
or else Aspect_Spell_Check (Token_Name)
then
Result := True;
else
Scan; -- past identifier
Result := Token in
Tok_Arrow | Tok_Comma | Tok_Is | Tok_Semicolon | Tok_Right_Paren;
end if;
-- If earlier than Ada 2012, check for valid aspect identifier (possibly
-- completed with 'CLASS) followed by an arrow, and consider that this
-- is still an aspect specification so we give an appropriate message.
else
if not Is_Aspect_Id (Token_Name) then
Result := False;
else
Scan; -- past aspect name
Result := False;
if Token = Tok_Arrow then
Result := True;
-- The identifier may be the name of a boolean aspect with a
-- defaulted True value. Further checks when analyzing aspect
-- specification, which may include further aspects.
elsif Token in Tok_Comma | Tok_Semicolon then
Result := True;
elsif Token = Tok_Apostrophe then
Scan; -- past apostrophe
if Token = Tok_Identifier
and then Token_Name = Name_Class
then
Scan; -- past CLASS
if Token = Tok_Arrow then
Result := True;
end if;
end if;
end if;
if Result then
Restore_Scan_State (Scan_State);
Error_Msg_Ada_2012_Feature ("|aspect specification", Token_Ptr);
return True;
end if;
end if;
end if;
Restore_Scan_State (Scan_State);
return Result;
end Aspect_Specifications_Present;
-------------------------------
-- Get_Aspect_Specifications --
-------------------------------
function Get_Aspect_Specifications
(Semicolon : Boolean := True) return List_Id
is
A_Id : Aspect_Id;
Aspect : Node_Id;
Aspects : List_Id;
OK : Boolean;
Opt : Boolean;
-- True if current aspect takes an optional argument
begin
Aspects := Empty_List;
-- Check if aspect specification present
if not Aspect_Specifications_Present then
if Semicolon then
TF_Semicolon;
end if;
return Aspects;
end if;
Scan; -- past WITH (or possible WHEN after error)
Aspects := Empty_List;
-- Loop to scan aspects
loop
OK := True;
-- The aspect mark is not an identifier
if Token /= Tok_Identifier then
Error_Msg_SC ("aspect identifier expected");
-- Skip the whole aspect specification list
if Semicolon then
Resync_Past_Semicolon;
end if;
return Aspects;
end if;
A_Id := Get_Aspect_Id (Token_Name);
Aspect :=
Make_Aspect_Specification (Token_Ptr,
Identifier => Token_Node);
-- The aspect mark is not recognized
if A_Id = No_Aspect then
declare
Msg_Issued : Boolean := False;
begin
Check_Restriction (Msg_Issued, No_Unrecognized_Aspects, Aspect);
if not Msg_Issued then
Bad_Aspect (Token_Node, Token_Name, not Debug_Flag_2);
OK := False;
end if;
end;
Scan; -- past incorrect identifier
if Token = Tok_Apostrophe then
Scan; -- past apostrophe
Scan; -- past presumably CLASS
end if;
-- Attempt to parse the aspect definition by assuming it is an
-- expression.
if Token = Tok_Arrow then
Scan; -- past arrow
Set_Expression (Aspect, P_Expression);
-- If we have a correct terminator (comma or semicolon, or a
-- reasonable likely missing comma), then just proceed.
elsif Token = Tok_Comma or else
Token = Tok_Semicolon or else
Token = Tok_Identifier
then
null;
-- Otherwise the aspect contains a junk definition
else
if Semicolon then
Resync_Past_Semicolon;
end if;
return Aspects;
end if;
-- Aspect mark is OK
else
Scan; -- past identifier
Opt := Aspect_Argument (A_Id) = Optional_Expression
or else
Aspect_Argument (A_Id) = Optional_Name;
-- Check for 'Class present
if Token = Tok_Apostrophe then
if Class_Aspect_OK (A_Id) then
Scan; -- past apostrophe
if Token = Tok_Identifier
and then Token_Name = Name_Class
then
Scan; -- past CLASS
Set_Class_Present (Aspect);
else
Error_Msg_SC ("Class attribute expected here");
OK := False;
if Token = Tok_Identifier then
Scan; -- past identifier not CLASS
end if;
end if;
-- The aspect does not allow 'Class
else
Error_Msg_Node_1 := Identifier (Aspect);
Error_Msg_SC ("aspect& does not permit attribute here");
OK := False;
Scan; -- past apostrophe
Scan; -- past presumably CLASS
end if;
end if;
-- Check for a missing aspect definition. Aspects with optional
-- definitions are not considered.
if Token in Tok_Comma | Tok_Semicolon then
if not Opt then
Error_Msg_Node_1 := Identifier (Aspect);
Error_Msg_AP ("aspect& requires an aspect definition");
OK := False;
end if;
-- Here we do not have a comma or a semicolon, we are done if we
-- do not have an arrow and the aspect does not need an argument
elsif Opt and then Token /= Tok_Arrow then
null;
-- Here we have either an arrow, or an aspect that definitely
-- needs an aspect definition, and we will look for one even if
-- no arrow is preseant.
-- Otherwise we have an aspect definition
else
if Token = Tok_Arrow then
Scan; -- past arrow
else
T_Arrow;
OK := False;
end if;
-- Detect a common error where the non-null definition of
-- aspect Depends, Global, Refined_Depends, Refined_Global
-- or Refined_State lacks enclosing parentheses.
if Token not in Tok_Left_Paren | Tok_Null then
-- [Refined_]Depends
if A_Id = Aspect_Depends
or else
A_Id = Aspect_Refined_Depends
then
Error_Msg_SC -- CODEFIX
("missing ""(""");
Resync_Past_Malformed_Aspect;
-- Return when the current aspect is the last in the list
-- of specifications and the list applies to a body.
if Token = Tok_Is then
return Aspects;
end if;
-- [Refined_]Global
elsif A_Id = Aspect_Global
or else
A_Id = Aspect_Refined_Global
then
declare
Scan_State : Saved_Scan_State;
begin
Save_Scan_State (Scan_State);
Scan; -- past item or mode_selector
-- Emit an error when the aspect has a mode_selector
-- as the moded_global_list must be parenthesized:
-- with Global => Output => Item
if Token = Tok_Arrow then
Restore_Scan_State (Scan_State);
Error_Msg_SC -- CODEFIX
("missing ""(""");
Resync_Past_Malformed_Aspect;
-- Return when the current aspect is the last in
-- the list of specifications and the list applies
-- to a body.
if Token = Tok_Is then
return Aspects;
end if;
elsif Token = Tok_Comma then
Scan; -- past comma
-- An item followed by a comma does not need to
-- be parenthesized if the next token is a valid
-- aspect name:
-- with Global => Item,
-- Aspect => ...
if Token = Tok_Identifier
and then Is_Aspect_Id (Token_Name)
then
Restore_Scan_State (Scan_State);
-- Otherwise this is a list of items in which case
-- the list must be parenthesized.
else
Restore_Scan_State (Scan_State);
Error_Msg_SC -- CODEFIX
("missing ""(""");
Resync_Past_Malformed_Aspect;
-- Return when the current aspect is the last
-- in the list of specifications and the list
-- applies to a body.
if Token = Tok_Is then
return Aspects;
end if;
end if;
-- The definition of [Refined_]Global does not need to
-- be parenthesized.
else
Restore_Scan_State (Scan_State);
end if;
end;
-- Refined_State
elsif A_Id = Aspect_Refined_State then
if Token = Tok_Identifier then
declare
Scan_State : Saved_Scan_State;
begin
Save_Scan_State (Scan_State);
Scan; -- past state
-- The refinement contains a constituent, the whole
-- argument of Refined_State must be parenthesized.
-- with Refined_State => State => Constit
if Token = Tok_Arrow then
Restore_Scan_State (Scan_State);
Error_Msg_SC -- CODEFIX
("missing ""(""");
Resync_Past_Malformed_Aspect;
-- Return when the current aspect is the last
-- in the list of specifications and the list
-- applies to a body.
if Token = Tok_Is then
return Aspects;
end if;
-- The refinement lacks constituents. Do not flag
-- this case as the error would be misleading. The
-- diagnostic is left to the analysis.
-- with Refined_State => State
else
Restore_Scan_State (Scan_State);
end if;
end;
end if;
end if;
end if;
-- Note if inside Depends or Refined_Depends aspect
if A_Id = Aspect_Depends
or else A_Id = Aspect_Refined_Depends
then
Inside_Depends := True;
end if;
-- Note that we have seen an Import aspect specification.
-- This matters only while parsing a subprogram.
if A_Id = Aspect_Import then
SIS_Aspect_Import_Seen := True;
-- Should do it only for subprograms
end if;
-- Parse the aspect definition depending on the expected
-- argument kind.
if Aspect_Argument (A_Id) = Name
or else Aspect_Argument (A_Id) = Optional_Name
then
Set_Expression (Aspect, P_Name);
else
pragma Assert
(Aspect_Argument (A_Id) = Expression
or else
Aspect_Argument (A_Id) = Optional_Expression);
Set_Expression (Aspect, P_Expression);
end if;
-- Unconditionally reset flag for Inside_Depends
Inside_Depends := False;
end if;
-- Add the aspect to the resulting list only when it was properly
-- parsed.
if OK then
Append (Aspect, Aspects);
end if;
end if;
-- Merge here after good or bad aspect (we should be at a comma
-- or a semicolon, but there might be other possible errors).
-- The aspect specification list contains more than one aspect
if Token = Tok_Comma then
Scan; -- past comma
goto Continue;
-- Check for a missing comma between two aspects. Emit an error
-- and proceed to the next aspect.
elsif Token = Tok_Identifier
and then Is_Aspect_Id (Token_Name)
then
declare
Scan_State : Saved_Scan_State;
begin
Save_Scan_State (Scan_State);
Scan; -- past identifier
-- Attempt to detect ' or => following a potential aspect
-- mark.
if Token in Tok_Apostrophe | Tok_Arrow then
Restore_Scan_State (Scan_State);
Error_Msg_AP -- CODEFIX
("|missing "",""");
goto Continue;
-- The construct following the current aspect is not an
-- aspect.
else
Restore_Scan_State (Scan_State);
end if;
end;
-- Check for a mistyped semicolon in place of a comma between two
-- aspects. Emit an error and proceed to the next aspect.
elsif Token = Tok_Semicolon then
declare
Scan_State : Saved_Scan_State;
begin
Save_Scan_State (Scan_State);
Scan; -- past semicolon
if Token = Tok_Identifier
and then Is_Aspect_Id (Token_Name)
then
Scan; -- past identifier
-- Attempt to detect ' or => following potential aspect mark
if Token in Tok_Apostrophe | Tok_Arrow then
Restore_Scan_State (Scan_State);
Error_Msg_SC -- CODEFIX
("|"";"" should be "",""");
Scan; -- past semicolon
goto Continue;
end if;
end if;
-- Construct following the current aspect is not an aspect
Restore_Scan_State (Scan_State);
end;
end if;
-- Require semicolon if caller expects to scan this out
if Semicolon then
T_Semicolon;
end if;
exit;
<<Continue>>
null;
end loop;
return Aspects;
end Get_Aspect_Specifications;
--------------------------------------------
-- 13.1 Representation Clause (also I.7) --
--------------------------------------------
-- REPRESENTATION_CLAUSE ::=
-- ATTRIBUTE_DEFINITION_CLAUSE
-- | ENUMERATION_REPRESENTATION_CLAUSE
-- | RECORD_REPRESENTATION_CLAUSE
-- | AT_CLAUSE
-- ATTRIBUTE_DEFINITION_CLAUSE ::=
-- for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use EXPRESSION;
-- | for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use NAME;
-- Note: in Ada 83, the expression must be a simple expression
-- AT_CLAUSE ::= for DIRECT_NAME use at EXPRESSION;
-- Note: in Ada 83, the expression must be a simple expression
-- ENUMERATION_REPRESENTATION_CLAUSE ::=
-- for first_subtype_LOCAL_NAME use ENUMERATION_AGGREGATE;
-- ENUMERATION_AGGREGATE ::= ARRAY_AGGREGATE
-- RECORD_REPRESENTATION_CLAUSE ::=
-- for first_subtype_LOCAL_NAME use
-- record [MOD_CLAUSE]
-- {COMPONENT_CLAUSE}
-- end record;
-- Note: for now we allow only a direct name as the local name in the
-- above constructs. This probably needs changing later on ???
-- The caller has checked that the initial token is FOR
-- Error recovery: cannot raise Error_Resync, if an error occurs,
-- the scan is repositioned past the next semicolon.
function P_Representation_Clause return Node_Id is
For_Loc : Source_Ptr;
Name_Node : Node_Id;
Prefix_Node : Node_Id;
Attr_Name : Name_Id;
Identifier_Node : Node_Id;
Rep_Clause_Node : Node_Id;
Expr_Node : Node_Id;
Record_Items : List_Id;
begin
For_Loc := Token_Ptr;
Scan; -- past FOR
-- Note that the name in a representation clause is always a simple
-- name, even in the attribute case, see AI-300 which made this so.
Identifier_Node := P_Identifier (C_Use);
-- Check case of qualified name to give good error message
if Token = Tok_Dot then
Error_Msg_SC
("representation clause requires simple name!");
loop
exit when Token /= Tok_Dot;
Scan; -- past dot
Discard_Junk_Node (P_Identifier);
end loop;
end if;
-- Attribute Definition Clause
if Token = Tok_Apostrophe then
-- Allow local names of the form a'b'.... This enables
-- us to parse class-wide streams attributes correctly.
Name_Node := Identifier_Node;
while Token = Tok_Apostrophe loop
Scan; -- past apostrophe
Identifier_Node := Token_Node;
Attr_Name := No_Name;
if Token = Tok_Identifier then
Attr_Name := Token_Name;
-- Note that the parser must complain in case of an internal
-- attribute name that comes from source since internal names
-- are meant to be used only by the compiler.
if not Is_Attribute_Name (Attr_Name)
and then (not Is_Internal_Attribute_Name (Attr_Name)
or else Comes_From_Source (Token_Node))
then
Signal_Bad_Attribute;
end if;
if Style_Check then
Style.Check_Attribute_Name (False);
end if;
-- Here for case of attribute designator is not an identifier
else
if Token = Tok_Delta then
Attr_Name := Name_Delta;
elsif Token = Tok_Digits then
Attr_Name := Name_Digits;
elsif Token = Tok_Access then
Attr_Name := Name_Access;
else
Error_Msg_AP ("attribute designator expected");
raise Error_Resync;
end if;
if Style_Check then
Style.Check_Attribute_Name (True);
end if;
end if;
-- Here we have an OK attribute scanned, and the corresponding
-- Attribute identifier node is stored in Ident_Node.
Prefix_Node := Name_Node;
Name_Node := New_Node (N_Attribute_Reference, Prev_Token_Ptr);
Set_Prefix (Name_Node, Prefix_Node);
Set_Attribute_Name (Name_Node, Attr_Name);
Scan;
-- Check for Address clause which needs to be marked for use in
-- optimizing performance of Exp_Util.Following_Address_Clause.
if Attr_Name = Name_Address
and then Nkind (Prefix_Node) = N_Identifier
then
Set_Name_Table_Boolean1 (Chars (Prefix_Node), True);
end if;
end loop;
Rep_Clause_Node := New_Node (N_Attribute_Definition_Clause, For_Loc);
Set_Name (Rep_Clause_Node, Prefix_Node);
Set_Chars (Rep_Clause_Node, Attr_Name);
T_Use;
Expr_Node := P_Expression_No_Right_Paren;
Check_Simple_Expression_In_Ada_83 (Expr_Node);
Set_Expression (Rep_Clause_Node, Expr_Node);
else
TF_Use;
Rep_Clause_Node := Empty;
-- AT follows USE (At Clause)
if Token = Tok_At then
Scan; -- past AT
Rep_Clause_Node := New_Node (N_At_Clause, For_Loc);
Set_Identifier (Rep_Clause_Node, Identifier_Node);
Expr_Node := P_Expression_No_Right_Paren;
Check_Simple_Expression_In_Ada_83 (Expr_Node);
Set_Expression (Rep_Clause_Node, Expr_Node);
-- Mark occurrence of address clause (used to optimize performance
-- of Exp_Util.Following_Address_Clause).
Set_Name_Table_Boolean1 (Chars (Identifier_Node), True);
-- RECORD follows USE (Record Representation Clause)
elsif Token = Tok_Record then
Record_Items := P_Pragmas_Opt;
Rep_Clause_Node :=
New_Node (N_Record_Representation_Clause, For_Loc);
Set_Identifier (Rep_Clause_Node, Identifier_Node);
Push_Scope_Stack;
Scopes (Scope.Last).Etyp := E_Record;
Scopes (Scope.Last).Ecol := Start_Column;
Scopes (Scope.Last).Sloc := Token_Ptr;
Scan; -- past RECORD
Record_Items := P_Pragmas_Opt;
-- Possible Mod Clause
if Token = Tok_At then
Set_Mod_Clause (Rep_Clause_Node, P_Mod_Clause);
Set_Pragmas_Before (Mod_Clause (Rep_Clause_Node), Record_Items);
Record_Items := P_Pragmas_Opt;
end if;
if No (Record_Items) then
Record_Items := New_List;
end if;
Set_Component_Clauses (Rep_Clause_Node, Record_Items);
-- Loop through component clauses
loop
if Token not in Token_Class_Name then
exit when Check_End;
end if;
Append (P_Component_Clause, Record_Items);
P_Pragmas_Opt (Record_Items);
end loop;
-- Left paren follows USE (Enumeration Representation Clause)
elsif Token = Tok_Left_Paren then
Rep_Clause_Node :=
New_Node (N_Enumeration_Representation_Clause, For_Loc);
Set_Identifier (Rep_Clause_Node, Identifier_Node);
Set_Array_Aggregate (Rep_Clause_Node, P_Aggregate);
-- Some other token follows FOR (invalid representation clause)
else
Error_Msg_SC ("invalid representation clause");
raise Error_Resync;
end if;
end if;
TF_Semicolon;
return Rep_Clause_Node;
exception
when Error_Resync =>
Resync_Past_Semicolon;
return Error;
end P_Representation_Clause;
----------------------
-- 13.1 Local Name --
----------------------
-- Local name is always parsed by its parent. In the case of its use in
-- pragmas, the check for a local name is handled in Par.Prag and allows
-- all the possible forms of local name. For the uses in chapter 13, we
-- currently only allow a direct name, but this should probably change???
---------------------------
-- 13.1 At Clause (I.7) --
---------------------------
-- Parsed by P_Representation_Clause (13.1)
---------------------------------------
-- 13.3 Attribute Definition Clause --
---------------------------------------
-- Parsed by P_Representation_Clause (13.1)
--------------------------------
-- 13.1 Aspect Specification --
--------------------------------
-- ASPECT_SPECIFICATION ::=
-- with ASPECT_MARK [=> ASPECT_DEFINITION] {,
-- ASPECT_MARK [=> ASPECT_DEFINITION] }
-- ASPECT_MARK ::= aspect_IDENTIFIER['Class]
-- ASPECT_DEFINITION ::= NAME | EXPRESSION
-- Error recovery: cannot raise Error_Resync
procedure P_Aspect_Specifications
(Decl : Node_Id;
Semicolon : Boolean := True)
is
Aspects : List_Id;
Ptr : Source_Ptr;
begin
-- Aspect Specification is present
Ptr := Token_Ptr;
-- Here we have an aspect specification to scan, note that we don't
-- set the flag till later, because it may turn out that we have no
-- valid aspects in the list.
Aspects := Get_Aspect_Specifications (Semicolon);
-- Here if aspects present
if Is_Non_Empty_List (Aspects) then
-- If Decl is Empty, we just ignore the aspects (the caller in this
-- case has always issued an appropriate error message).
if Decl = Empty then
null;
-- If Decl is Error, we ignore the aspects, and issue a message
elsif Decl = Error
or else not Permits_Aspect_Specifications (Decl)
then
Error_Msg ("aspect specifications not allowed here", Ptr);
-- Here aspects are allowed, and we store them
else
Set_Parent (Aspects, Decl);
Set_Aspect_Specifications (Decl, Aspects);
end if;
end if;
end P_Aspect_Specifications;
---------------------------------------------
-- 13.4 Enumeration Representation Clause --
---------------------------------------------
-- Parsed by P_Representation_Clause (13.1)
---------------------------------
-- 13.4 Enumeration Aggregate --
---------------------------------
-- Parsed by P_Representation_Clause (13.1)
------------------------------------------
-- 13.5.1 Record Representation Clause --
------------------------------------------
-- Parsed by P_Representation_Clause (13.1)
------------------------------
-- 13.5.1 Mod Clause (I.8) --
------------------------------
-- MOD_CLAUSE ::= at mod static_EXPRESSION;
-- Note: in Ada 83, the expression must be a simple expression
-- The caller has checked that the initial Token is AT
-- Error recovery: cannot raise Error_Resync
-- Note: the caller is responsible for setting the Pragmas_Before field
function P_Mod_Clause return Node_Id is
Mod_Node : Node_Id;
Expr_Node : Node_Id;
begin
Mod_Node := New_Node (N_Mod_Clause, Token_Ptr);
Scan; -- past AT
T_Mod;
Expr_Node := P_Expression_No_Right_Paren;
Check_Simple_Expression_In_Ada_83 (Expr_Node);
Set_Expression (Mod_Node, Expr_Node);
TF_Semicolon;
return Mod_Node;
end P_Mod_Clause;
------------------------------
-- 13.5.1 Component Clause --
------------------------------
-- COMPONENT_CLAUSE ::=
-- COMPONENT_CLAUSE_COMPONENT_NAME at POSITION
-- range FIRST_BIT .. LAST_BIT;
-- COMPONENT_CLAUSE_COMPONENT_NAME ::=
-- component_DIRECT_NAME
-- | component_DIRECT_NAME'ATTRIBUTE_DESIGNATOR
-- | FIRST_SUBTYPE_DIRECT_NAME'ATTRIBUTE_DESIGNATOR
-- POSITION ::= static_EXPRESSION
-- Note: in Ada 83, the expression must be a simple expression
-- FIRST_BIT ::= static_SIMPLE_EXPRESSION
-- LAST_BIT ::= static_SIMPLE_EXPRESSION
-- Note: the AARM V2.0 grammar has an error at this point, it uses
-- EXPRESSION instead of SIMPLE_EXPRESSION for FIRST_BIT and LAST_BIT
-- Error recovery: cannot raise Error_Resync
function P_Component_Clause return Node_Id is
Component_Node : Node_Id;
Comp_Name : Node_Id;
Expr_Node : Node_Id;
begin
Component_Node := New_Node (N_Component_Clause, Token_Ptr);
Comp_Name := P_Name;
if Nkind (Comp_Name) = N_Identifier
or else Nkind (Comp_Name) = N_Attribute_Reference
then
Set_Component_Name (Component_Node, Comp_Name);
else
Error_Msg_N
("component name must be direct name or attribute", Comp_Name);
Set_Component_Name (Component_Node, Error);
end if;
Set_Sloc (Component_Node, Token_Ptr);
T_At;
Expr_Node := P_Expression_No_Right_Paren;
Check_Simple_Expression_In_Ada_83 (Expr_Node);
Set_Position (Component_Node, Expr_Node);
T_Range;
Expr_Node := P_Expression_No_Right_Paren;
Check_Simple_Expression_In_Ada_83 (Expr_Node);
Set_First_Bit (Component_Node, Expr_Node);
T_Dot_Dot;
Expr_Node := P_Expression_No_Right_Paren;
Check_Simple_Expression_In_Ada_83 (Expr_Node);
Set_Last_Bit (Component_Node, Expr_Node);
TF_Semicolon;
return Component_Node;
end P_Component_Clause;
----------------------
-- 13.5.1 Position --
----------------------
-- Parsed by P_Component_Clause (13.5.1)
-----------------------
-- 13.5.1 First Bit --
-----------------------
-- Parsed by P_Component_Clause (13.5.1)
----------------------
-- 13.5.1 Last Bit --
----------------------
-- Parsed by P_Component_Clause (13.5.1)
--------------------------
-- 13.8 Code Statement --
--------------------------
-- CODE_STATEMENT ::= QUALIFIED_EXPRESSION
-- On entry the caller has scanned the SUBTYPE_MARK (passed in as the
-- single argument, and the scan points to the apostrophe.
-- Error recovery: can raise Error_Resync
function P_Code_Statement (Subtype_Mark : Node_Id) return Node_Id is
Node1 : Node_Id;
begin
Scan; -- past apostrophe
-- If left paren, then we have a possible code statement
if Token = Tok_Left_Paren then
Node1 := New_Node (N_Code_Statement, Sloc (Subtype_Mark));
Set_Expression (Node1, P_Qualified_Expression (Subtype_Mark));
TF_Semicolon;
return Node1;
-- Otherwise we have an illegal range attribute. Note that P_Name
-- ensures that Token = Tok_Range is the only possibility left here.
else
Error_Msg_SC ("RANGE attribute illegal here!");
raise Error_Resync;
end if;
end P_Code_Statement;
end Ch13;