mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-24 20:01:19 +08:00
Code Issues Packages Projects Releases Wiki Activity

[Ada] Ada 2020: Allow declarative items mixed with statements

Browse Source 
This patch implements a syntactic language extension that allows
declarative items to appear in a sequence of statements.  For example:

    for X in S'Range loop
        Item : Character renames S (X);
        Item := Transform (Item);
    end loop;

Previously, declare/begin/end was required, which is just noise.

gcc/ada/

	* par.adb (P_Declarative_Items): New function to parse a
	sequence of declarative items.
	(P_Sequence_Of_Statements): Add Handled flag, to indicate
	whether to wrap the result in a block statement.
	* par-ch3.adb (P_Declarative_Item): Rename P_Declarative_Items
	to be P_Declarative_Item, because it really only parses a single
	declarative item, and to avoid conflict with the new
	P_Declarative_Items. Add In_Statements.  We keep the old
	error-recovery mechanisms in place when In_Statements is False.
	When True, we don't want to complain about statements, because
	we are parsing a sequence of statements.
	(P_Identifier_Declarations): If In_Statements, and we see what
	looks like a statement, we no longer give an error. We return to
	P_Sequence_Of_Statements with Done = True, so it can parse the
	statement.
	* par-ch5.adb (P_Sequence_Of_Statements): Call
	P_Declarative_Items to parse declarative items that appear in
	the statement list.  Remove error handling code that complained
	about such items.  Check some errors conservatively.  Wrap the
	result in a block statement when necessary.
	* par-ch11.adb (P_Handled_Sequence_Of_Statements): Pass
	Handled => True to P_Sequence_Of_Statements.
	* types.ads (No, Present): New functions for querying
	Source_Ptrs (equal, not equal No_Location).
This commit is contained in:
Bob Duff 2022-06-29 17:06:47 -04:00 committed by Pierre-Marie de Rodat
parent 2b98bb583f
commit 0ff936fe86
5 changed files with 354 additions and 124 deletions

3
gcc/ada/par-ch11.adb

@ -61,7 +61,8 @@ package body Ch11 is
Handled_Stmt_Seq_Node :=
New_Node (N_Handled_Sequence_Of_Statements, Token_Ptr);
Set_Statements
(Handled_Stmt_Seq_Node, P_Sequence_Of_Statements (SS_Extm_Sreq));
(Handled_Stmt_Seq_Node,
P_Sequence_Of_Statements (SS_Extm_Sreq, Handled => True));
if Token = Tok_Exception then
Scan; -- past EXCEPTION

260
gcc/ada/par-ch3.adb

@ -77,40 +77,33 @@ package body Ch3 is
-- 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
@ -1307,9 +1300,10 @@ package body Ch3 is
-- 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;
@ -1331,6 +1325,13 @@ package body Ch3 is
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
@ -1342,6 +1343,55 @@ package body Ch3 is
-- 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 --
-------------
@ -1395,6 +1445,11 @@ package body Ch3 is
-- 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);
@ -1514,6 +1569,10 @@ package body Ch3 is
-- 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
@ -4464,13 +4523,11 @@ package body Ch3 is
-- 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.
@ -4482,15 +4539,10 @@ package body Ch3 is
-- 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
@ -4514,11 +4566,12 @@ package body Ch3 is
-- 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;
@ -4549,20 +4602,38 @@ package body Ch3 is
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;
@ -4585,7 +4656,7 @@ package body Ch3 is
-- 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 =>
@ -4593,7 +4664,14 @@ package body Ch3 is
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;
@ -4779,10 +4857,16 @@ package body Ch3 is
| 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
@ -4799,10 +4883,12 @@ package body Ch3 is
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);
@ -4810,12 +4896,18 @@ package body Ch3 is
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.
@ -4838,6 +4930,10 @@ package body Ch3 is
-- 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
@ -4853,7 +4949,8 @@ package body Ch3 is
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
@ -4869,6 +4966,21 @@ package body Ch3 is
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;
----------------------------------
@ -4888,9 +5000,8 @@ package body Ch3 is
(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:
@ -4904,15 +5015,8 @@ package body Ch3 is
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
@ -5007,11 +5111,11 @@ package body Ch3 is
----------------------
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;
-----------------------------------------

185
gcc/ada/par-ch5.adb

@ -144,8 +144,9 @@ package body Ch5 is
-- 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
@ -158,11 +159,6 @@ package body Ch5 is
-- 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;
@ -171,28 +167,12 @@ package body Ch5 is
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 --
-----------------------------
@ -243,9 +223,10 @@ package body Ch5 is
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;
@ -259,9 +240,45 @@ package body Ch5 is
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;
@ -613,14 +630,6 @@ package body Ch5 is
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
@ -811,6 +820,10 @@ package body Ch5 is
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 =>
@ -941,14 +954,9 @@ package body Ch5 is
-- 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
@ -966,7 +974,96 @@ package body Ch5 is
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;
--------------------

26
gcc/ada/par.adb

@ -701,6 +701,28 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
function P_Subtype_Mark_Resync return Node_Id;
function P_Unknown_Discriminant_Part_Opt return Boolean;
procedure P_Declarative_Items
(Decls : List_Id;
Declare_Expression : Boolean;
In_Spec : Boolean;
In_Statements : Boolean);
-- Parses a sequence of zero or more declarative items, and appends them
-- to Decls. Done indicates whether or not there might be additional
-- declarative items to parse. If Done is True, then there are no more
-- to parse; otherwise there might be more.
--
-- 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_Statements is true if we are called to parse declarative items in
-- a sequence of statements. In this case, we do not give an error upon
-- encountering a statement, but return to the caller with Done = True,
-- so the caller can resume parsing statements.
function P_Basic_Declarative_Items
(Declare_Expression : Boolean) return List_Id;
-- Used to parse the declarative items in a package visible or
@ -858,9 +880,11 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
function P_Loop_Parameter_Specification return Node_Id;
-- Used in loop constructs and quantified expressions.
function P_Sequence_Of_Statements (SS_Flags : SS_Rec) return List_Id;
function P_Sequence_Of_Statements
(SS_Flags : SS_Rec; Handled : Boolean := False) return List_Id;
-- The argument indicates the acceptable termination tokens.
-- See body in Par.Ch5 for details of the use of this parameter.
-- Handled is true if we are parsing a handled sequence of statements.
procedure Parse_Decls_Begin_End (Parent : Node_Id);
-- Parses declarations and handled statement sequence, setting

4
gcc/ada/types.ads

@ -247,6 +247,10 @@ package Types is
-- (very often we conditionalize so that we set No_Location in normal mode
-- and the corresponding source line in -gnatD mode).
function No (Loc : Source_Ptr) return Boolean is (Loc = No_Location);
function Present (Loc : Source_Ptr) return Boolean is (not No (Loc));
-- Tests for No_Location / not No_Location
Standard_Location : constant Source_Ptr := -2;
-- Used for all nodes in the representation of package Standard other than
-- nodes representing the contents of Standard.ASCII. Note that testing for