public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r13-1640] [Ada] Ada 2020: Allow declarative items mixed with statements
@ 2022-07-12 12:26 Pierre-Marie de Rodat
  0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2022-07-12 12:26 UTC (permalink / raw)
  To: gcc-cvs

https://gcc.gnu.org/g:0ff936fe86ddff4d4a95a4ca9eda85ad0287ffa5

commit r13-1640-g0ff936fe86ddff4d4a95a4ca9eda85ad0287ffa5
Author: Bob Duff <duff@adacore.com>
Date:   Wed Jun 29 17:06:47 2022 -0400

    [Ada] Ada 2020: Allow declarative items mixed with statements
    
    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).

Diff:
---
 gcc/ada/par-ch11.adb |   3 +-
 gcc/ada/par-ch3.adb  | 260 +++++++++++++++++++++++++++++++++++----------------
 gcc/ada/par-ch5.adb  | 185 +++++++++++++++++++++++++++---------
 gcc/ada/par.adb      |  26 +++++-
 gcc/ada/types.ads    |   4 +
 5 files changed, 354 insertions(+), 124 deletions(-)

diff --git a/gcc/ada/par-ch11.adb b/gcc/ada/par-ch11.adb
index 158050abc2c..33c668d3c25 100644
--- a/gcc/ada/par-ch11.adb
+++ b/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
diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb
index 557a9cb7763..82df4cf9ce2 100644
--- a/gcc/ada/par-ch3.adb
+++ b/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;
 
    -----------------------------------------
diff --git a/gcc/ada/par-ch5.adb b/gcc/ada/par-ch5.adb
index 0421bd5d2ef..3835588fa8d 100644
--- a/gcc/ada/par-ch5.adb
+++ b/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;
 
    --------------------
diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb
index 20b2df97d9e..b6ffdae9082 100644
--- a/gcc/ada/par.adb
+++ b/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
diff --git a/gcc/ada/types.ads b/gcc/ada/types.ads
index 9ae17974a4d..aae51a2def6 100644
--- a/gcc/ada/types.ads
+++ b/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


^ permalink raw reply	[flat|nested] only message in thread

only message in thread, other threads:[~2022-07-12 12:26 UTC | newest]

Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-07-12 12:26 [gcc r13-1640] [Ada] Ada 2020: Allow declarative items mixed with statements Pierre-Marie de Rodat

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).