-- are enabled, to remove the ambiguity of "when X in A | B". We consider
-- it very unlikely that this will ever arise in practice.
- procedure P_Declarative_Items
+ procedure P_Declarative_Item
(Decls : List_Id;
Done : out Boolean;
Declare_Expression : Boolean;
- In_Spec : Boolean);
- -- Scans out a single declarative item, or, in the case of a declaration
- -- with a list of identifiers, a list of declarations, one for each of the
- -- identifiers in the list. The declaration or declarations scanned are
- -- appended to the given list. Done indicates whether or not there may be
- -- additional declarative items to scan. If Done is True, then a decision
- -- has been made that there are no more items to scan. If Done is False,
- -- then there may be additional declarations to scan.
- --
- -- Declare_Expression is true if we are parsing a declare_expression, in
- -- which case we want to suppress certain style checking.
- --
- -- In_Spec is true if we are scanning a package declaration, and is used to
- -- generate an appropriate message if a statement is encountered in such a
- -- context.
+ In_Spec : Boolean;
+ In_Statements : Boolean);
+ -- Parses a single declarative item. The parameters have the same meaning
+ -- as for P_Declarative_Items. If the declarative item has multiple
+ -- identifiers, as in "X, Y, Z : ...", then one declaration is appended to
+ -- Decls for each of the identifiers.
procedure P_Identifier_Declarations
- (Decls : List_Id;
- Done : out Boolean;
- In_Spec : Boolean);
- -- Scans out a set of declarations for an identifier or list of
- -- identifiers, and appends them to the given list. The parameters have
- -- the same significance as for P_Declarative_Items.
+ (Decls : List_Id;
+ Done : out Boolean;
+ In_Spec : Boolean;
+ In_Statements : Boolean);
+ -- Parses a sequence of declarations for an identifier or list of
+ -- identifiers, and appends them to the given list. The parameters
+ -- have the same meaning as for P_Declarative_Items.
procedure Statement_When_Declaration_Expected
(Decls : List_Id;
Done : out Boolean;
In_Spec : Boolean);
-- Called when a statement is found at a point where a declaration was
- -- expected. The parameters are as described for P_Declarative_Items.
+ -- expected. The parameters have the same meaning as for
+ -- P_Declarative_Items.
procedure Set_Declaration_Expected;
-- Posts a "declaration expected" error messages at the start of the
-- Error recovery: can raise Error_Resync
procedure P_Identifier_Declarations
- (Decls : List_Id;
- Done : out Boolean;
- In_Spec : Boolean)
+ (Decls : List_Id;
+ Done : out Boolean;
+ In_Spec : Boolean;
+ In_Statements : Boolean)
is
Acc_Node : Node_Id;
Decl_Node : Node_Id;
Num_Idents : Nat := 1;
-- Number of identifiers stored in Idents
+ function Identifier_Starts_Statement return Boolean;
+ -- Called with Token being an identifier that might start a declaration
+ -- or a statement. True if we are parsing declarations in a sequence of
+ -- statements, and this identifier is the start of a statement. If this
+ -- is true, we quit parsing declarations, and return Done = True so the
+ -- caller will switch to parsing statements.
+
procedure No_List;
-- This procedure is called in renames cases to make sure that we do
-- not have more than one identifier. If we do have more than one
-- returns True, otherwise returns False. Includes checking for some
-- common error cases.
+ ---------------------------------
+ -- Identifier_Starts_Statement --
+ ---------------------------------
+
+ function Identifier_Starts_Statement return Boolean is
+ pragma Assert (Token = Tok_Identifier);
+ Scan_State : Saved_Scan_State;
+ Result : Boolean := False;
+ begin
+ if not In_Statements then
+ return False;
+ end if;
+
+ Save_Scan_State (Scan_State);
+ Scan;
+
+ case Token is
+ when Tok_Comma => -- "X, ..." is a declaration
+ null;
+
+ when Tok_Colon =>
+ -- "X : ..." is usually a declaration, but "X : begin..." is
+ -- not. We return true for things like "X : Y : begin...",
+ -- which is a syntax error, because that gives better error
+ -- recovery for some ACATS.
+
+ Scan;
+
+ if Token in Token_Class_Labeled_Stmt then
+ Result := True;
+
+ elsif Token = Tok_Identifier then
+ Scan;
+ if Token = Tok_Colon then
+ Scan;
+ if Token in Token_Class_Labeled_Stmt then
+ Result := True;
+ end if;
+ end if;
+ end if;
+
+ when others =>
+ Result := True;
+ end case;
+
+ Restore_Scan_State (Scan_State);
+ return Result;
+ end Identifier_Starts_Statement;
+
-------------
-- No_List --
-------------
-- Start of processing for P_Identifier_Declarations
begin
+ if Identifier_Starts_Statement then
+ Done := True;
+ return;
+ end if;
+
Ident_Sloc := Token_Ptr;
Save_Scan_State (Scan_State); -- at first identifier
Idents (1) := P_Defining_Identifier (C_Comma_Colon);
-- Otherwise we definitely have an ordinary identifier with a junk
-- token after it.
+ elsif In_Statements then
+ Done := True;
+ return;
+
else
-- If in -gnatd.2 mode, try for statements
-- DECLARATIVE_PART ::= {DECLARATIVE_ITEM}
- -- Error recovery: cannot raise Error_Resync (because P_Declarative_Items
+ -- Error recovery: cannot raise Error_Resync (because P_Declarative_Item
-- handles errors, and returns cleanly after an error has occurred)
function P_Declarative_Part return List_Id is
- Decls : List_Id;
- Done : Boolean;
-
+ Decls : constant List_Id := New_List;
begin
-- Indicate no bad declarations detected yet. This will be reset by
-- P_Declarative_Items if a bad declaration is discovered.
-- discussion in Par for further details
SIS_Entry_Active := False;
- Decls := New_List;
- -- Loop to scan out the declarations
-
- loop
- P_Declarative_Items
- (Decls, Done, Declare_Expression => False, In_Spec => False);
- exit when Done;
- end loop;
+ P_Declarative_Items
+ (Decls, Declare_Expression => False,
+ In_Spec => False, In_Statements => False);
-- Get rid of active SIS entry which is left set only if we scanned a
-- procedure declaration and have not found the body. We could give
-- Error recovery: cannot raise Error_Resync. If an error resync occurs,
-- then the scan is set past the next semicolon and Error is returned.
- procedure P_Declarative_Items
+ procedure P_Declarative_Item
(Decls : List_Id;
Done : out Boolean;
Declare_Expression : Boolean;
- In_Spec : Boolean)
+ In_Spec : Boolean;
+ In_Statements : Boolean)
is
Scan_State : Saved_Scan_State;
Save_Scan_State (Scan_State);
Scan; -- past FOR
- if Token = Tok_Identifier then
- Scan; -- past identifier
-
- if Token = Tok_In then
- Restore_Scan_State (Scan_State);
- Statement_When_Declaration_Expected (Decls, Done, In_Spec);
- return;
+ declare
+ Is_Statement : Boolean := True;
+ begin
+ if Token = Tok_Identifier then
+ Scan; -- past identifier
+ if Token in Tok_Use | Tok_Apostrophe then
+ Is_Statement := False;
+ elsif Token = Tok_Dot then
+ Scan;
+ if Token = Tok_Identifier then
+ Scan;
+ Is_Statement := Token in Tok_In | Tok_Of;
+ end if;
+ end if;
+ else
+ Is_Statement := False;
end if;
- end if;
- -- Not a loop, so must be rep clause
+ Restore_Scan_State (Scan_State);
- Restore_Scan_State (Scan_State);
- Append (P_Representation_Clause, Decls);
+ if Is_Statement then
+ if not In_Statements then
+ Statement_When_Declaration_Expected
+ (Decls, Done, In_Spec);
+ end if;
+
+ Done := True;
+ return;
+ else
+ Append (P_Representation_Clause, Decls);
+ end if;
+ end;
when Tok_Generic =>
Check_Bad_Layout;
-- Normal case, no overriding, or overriding followed by colon
else
- P_Identifier_Declarations (Decls, Done, In_Spec);
+ P_Identifier_Declarations (Decls, Done, In_Spec, In_Statements);
end if;
when Tok_Package =>
Append (P_Package (Pf_Decl_Gins_Pbod_Rnam_Stub_Pexp), Decls);
when Tok_Pragma =>
- Append (P_Pragma, Decls);
+ -- If we see a pragma and In_Statements is true, we want to let
+ -- the statement-parser deal with it.
+
+ if In_Statements then
+ Done := True;
+ else
+ Append (P_Pragma, Decls);
+ end if;
when Tok_Protected =>
Check_Bad_Layout;
| Tok_Select
| Tok_While
=>
- -- But before we decide that it's a statement, let's check for
- -- a reserved word misused as an identifier.
+ -- If we parsing declarations in a sequence of statements, we want
+ -- to let the caller continue parsing statements.
- if Is_Reserved_Identifier then
+ if In_Statements then
+ Done := True;
+
+ -- Otherwise, give an error. But before we decide that it's a
+ -- statement, check for a reserved word misused as an identifier.
+
+ elsif Is_Reserved_Identifier then
Save_Scan_State (Scan_State);
Scan; -- past the token
else
Restore_Scan_State (Scan_State);
Scan_Reserved_Identifier (Force_Msg => True);
- P_Identifier_Declarations (Decls, Done, In_Spec);
+ P_Identifier_Declarations
+ (Decls, Done, In_Spec, In_Statements);
end if;
- -- If not reserved identifier, then it's definitely a statement
+ -- If not reserved identifier, then it's an incorrectly placed a
+ -- statement.
else
Statement_When_Declaration_Expected (Decls, Done, In_Spec);
end if;
-- The token RETURN may well also signal a missing BEGIN situation,
- -- however, we never let it end the declarative part, because it may
- -- also be part of a half-baked function declaration.
+ -- however, we never let it end the declarative part, because it
+ -- might also be part of a half-baked function declaration. If we are
+ -- In_Statements, then let the caller parse it; otherwise, it's an
+ -- error.
when Tok_Return =>
- Error_Msg_SC ("misplaced RETURN statement");
- raise Error_Resync;
+ if In_Statements then
+ Done := True;
+ else
+ Error_Msg_SC ("misplaced RETURN statement");
+ raise Error_Resync;
+ end if;
-- PRIVATE definitely terminates the declarations in a spec,
-- and is an error in a body.
-- But first check for misuse of a reserved identifier.
when others =>
+ if In_Statements then
+ Done := True;
+ return;
+ end if;
-- Here we check for a reserved identifier
Restore_Scan_State (Scan_State);
Scan_Reserved_Identifier (Force_Msg => True);
Check_Bad_Layout;
- P_Identifier_Declarations (Decls, Done, In_Spec);
+ P_Identifier_Declarations
+ (Decls, Done, In_Spec, In_Statements);
end if;
else
exception
when Error_Resync =>
Resync_Past_Semicolon;
+ end P_Declarative_Item;
+
+ procedure P_Declarative_Items
+ (Decls : List_Id;
+ Declare_Expression : Boolean;
+ In_Spec : Boolean;
+ In_Statements : Boolean)
+ is
+ Done : Boolean;
+ begin
+ loop
+ P_Declarative_Item
+ (Decls, Done, Declare_Expression, In_Spec, In_Statements);
+ exit when Done;
+ end loop;
end P_Declarative_Items;
----------------------------------
(Declare_Expression : Boolean) return List_Id
is
Decl : Node_Id;
- Decls : List_Id;
+ Decls : constant List_Id := New_List;
Kind : Node_Kind;
- Done : Boolean;
begin
-- Indicate no bad declarations detected yet in the current context:
SIS_Entry_Active := False;
- -- Loop to scan out declarations
-
- Decls := New_List;
-
- loop
- P_Declarative_Items
- (Decls, Done, Declare_Expression, In_Spec => True);
- exit when Done;
- end loop;
+ P_Declarative_Items
+ (Decls, Declare_Expression, In_Spec => True, In_Statements => False);
-- Get rid of active SIS entry. This is set only if we have scanned a
-- procedure declaration and have not found the body. We could give
----------------------
procedure Skip_Declaration (S : List_Id) is
- Dummy_Done : Boolean;
- pragma Warnings (Off, Dummy_Done);
+ Ignored_Done : Boolean;
begin
- P_Declarative_Items
- (S, Dummy_Done, Declare_Expression => False, In_Spec => False);
+ P_Declarative_Item
+ (S, Ignored_Done, Declare_Expression => False, In_Spec => False,
+ In_Statements => False);
end Skip_Declaration;
-----------------------------------------
-- parsing a statement, then the scan pointer is advanced past the next
-- semicolon and the parse continues.
- function P_Sequence_Of_Statements (SS_Flags : SS_Rec) return List_Id is
-
+ function P_Sequence_Of_Statements
+ (SS_Flags : SS_Rec; Handled : Boolean := False) return List_Id
+ is
Statement_Required : Boolean;
-- This flag indicates if a subsequent statement (other than a pragma)
-- is required. It is initialized from the Sreq flag, and modified as
-- sequence cannot contain only labels. This flag is set whenever a
-- label is encountered, to enforce this rule at the end of a sequence.
- Declaration_Found : Boolean := False;
- -- This flag is set True if a declaration is encountered, so that the
- -- error message about declarations in the statement part is only
- -- given once for a given sequence of statements.
-
Scan_State_Label : Saved_Scan_State;
Scan_State : Saved_Scan_State;
Id_Node : Node_Id;
Name_Node : Node_Id;
- procedure Junk_Declaration;
- -- Procedure called to handle error of declaration encountered in
- -- statement sequence.
+ Decl_Loc, Label_Loc : Source_Ptr := No_Location;
+ -- Sloc of the first declaration/label encountered, if any.
procedure Test_Statement_Required;
-- Flag error if Statement_Required flag set
- ----------------------
- -- Junk_Declaration --
- ----------------------
-
- procedure Junk_Declaration is
- begin
- if (not Declaration_Found) or All_Errors_Mode then
- Error_Msg_SC -- CODEFIX
- ("declarations must come before BEGIN");
- Declaration_Found := True;
- end if;
-
- Skip_Declaration (Statement_List);
- end Junk_Declaration;
-
-----------------------------
-- Test_Statement_Required --
-----------------------------
Append_To (Statement_List, Null_Stm);
end;
- -- If not Ada 2012, or not special case above, give error message
+ -- If not Ada 2012, or not special case above, and no declaration
+ -- seen (as allowed in Ada 2020), give error message.
- else
+ elsif No (Decl_Loc) then
Error_Msg_BC -- CODEFIX
("statement expected");
end if;
Statement_Required := SS_Flags.Sreq;
Statement_Seen := False;
+ -- In Ada 2022, we allow declarative items to be mixed with
+ -- statements. The loop below alternates between calling
+ -- P_Declarative_Items to parse zero or more declarative items, and
+ -- parsing a statement.
+
loop
Ignore (Tok_Semicolon);
+ declare
+ Num_Statements : constant Nat := List_Length (Statement_List);
+ begin
+ P_Declarative_Items
+ (Statement_List, Declare_Expression => False,
+ In_Spec => False, In_Statements => True);
+
+ -- Use the length of the list to determine whether we parsed any
+ -- declarative items. If so, it's an error pre-2022. ???We should
+ -- be calling Error_Msg_Ada_2022_Feature below, to advertise the
+ -- new feature, but that causes a lot of test diffs, so for now,
+ -- we mimic the old "...before begin" message.
+
+ if List_Length (Statement_List) > Num_Statements then
+ if All_Errors_Mode or else No (Decl_Loc) then
+ Decl_Loc := Sloc (Pick (Statement_List, Num_Statements + 1));
+
+ if False then
+ Error_Msg_Ada_2022_Feature
+ ("declarations mixed with statements",
+ Sloc (Pick (Statement_List, Num_Statements + 1)));
+ else
+ if Ada_Version < Ada_2022 then
+ Error_Msg
+ ("declarations must come before BEGIN", Decl_Loc);
+ end if;
+ end if;
+ end if;
+ end if;
+ end;
+
begin
if Style_Check then
Style.Check_Indentation;
Append_To (Statement_List,
P_For_Statement (Id_Node));
- -- Improper statement follows label. If we have an
- -- expression token, then assume the colon was part
- -- of a misplaced declaration.
-
- elsif Token not in Token_Class_Eterm then
- Restore_Scan_State (Scan_State_Label);
- Junk_Declaration;
-
-- Otherwise complain we have inappropriate statement
else
Append_To (Statement_List, P_Label);
Statement_Required := True;
+ if No (Label_Loc) then
+ Label_Loc := Sloc (Last (Statement_List));
+ end if;
+
-- Pragma appearing as a statement in a statement sequence
when Tok_Pragma =>
-- handling of a bad statement.
when others =>
- if Token in Token_Class_Declk then
- Junk_Declaration;
-
- else
- Error_Msg_BC -- CODEFIX
- ("statement expected");
- raise Error_Resync;
- end if;
+ Error_Msg_BC -- CODEFIX
+ ("statement expected");
+ raise Error_Resync;
end case;
-- On error resynchronization, skip past next semicolon, and, since
exit when SS_Flags.Unco;
end loop;
- return Statement_List;
+ -- If there are no declarative items in the list, or if the list is part
+ -- of a handled sequence of statements, we just return the list.
+ -- Otherwise, we wrap the list in a block statement, so the declarations
+ -- will have a proper scope. In the Handled case, it would be wrong to
+ -- wrap, because we want the code before and after "begin" to be in the
+ -- same scope. Example:
+ --
+ -- if ... then
+ -- use Some_Package;
+ -- Do_Something (...);
+ -- end if;
+ --
+ -- is tranformed into:
+ --
+ -- if ... then
+ -- begin
+ -- use Some_Package;
+ -- Do_Something (...);
+ -- end;
+ -- end if;
+ --
+ -- But we don't wrap this:
+ --
+ -- declare
+ -- X : Integer;
+ -- begin
+ -- X : Integer;
+ --
+ -- Otherwise, we would fail to detect the error (conflicting X's).
+ -- Similarly, if a representation clause appears in the statement
+ -- part, we don't want it to appear more nested than the declarative
+ -- part -- that would cause an unwanted error.
+
+ if Present (Decl_Loc) then
+ -- Forbid labels and declarative items from coexisting. Otherwise,
+ -- one could jump past a declaration, leading to chaos. Jumping
+ -- backward past a declaration is also questionable -- does the
+ -- declaration get elaborated again? Is secondary stack storage
+ -- reclaimed? (A more liberal rule was proposed, but this is what
+ -- we're doing for now.)
+
+ if Present (Label_Loc) then
+ Error_Msg ("declarative item in same list as label", Decl_Loc);
+ Error_Msg ("label in same list as declarative item", Label_Loc);
+ end if;
+
+ -- Forbid exception handlers and declarative items from
+ -- coexisting. Example:
+ --
+ -- X : Integer := 123;
+ -- procedure P is
+ -- begin
+ -- X : Integer := 456;
+ -- exception
+ -- when Cain =>
+ -- Put(X);
+ -- end P;
+ --
+ -- It was proposed that in the handler, X should refer to the outer
+ -- X, but that's just confusing.
+
+ if Token = Tok_Exception then
+ Error_Msg
+ ("declarative item in statements conflicts with " &
+ "exception handler below",
+ Decl_Loc);
+ Error_Msg
+ ("exception handler conflicts with " &
+ "declarative item in statements above",
+ Token_Ptr);
+ end if;
+
+ if Handled then
+ return Statement_List;
+ else
+ declare
+ Loc : constant Source_Ptr := Sloc (First (Statement_List));
+ Block : constant Node_Id :=
+ Make_Block_Statement
+ (Loc,
+ Handled_Statement_Sequence =>
+ Make_Handled_Sequence_Of_Statements
+ (Loc, Statements => Statement_List));
+ begin
+ return New_List (Block);
+ end;
+ end if;
+ else
+ return Statement_List;
+ end if;
end P_Sequence_Of_Statements;
--------------------