[Ada] Declare expressions

2020-06-16  Bob Duff  <duff@adacore.com>

gcc/ada/

	* par-ch4.adb (P_Case_Expression): Move to be local.
	(P_Declare_Expression): New parsing routine.
	(P_Unparen_Cond_Expr_Etc): New name for
	P_Unparen_Cond_Case_Quant_Expression which was missing one case
	in its name (iterated component association), and we're adding a
	new case (declare expression), so lets use "Etc" instead of
	trying to pack all those things into the name.  Add call to
	P_Declare_Expression, and check for missing parens.
	(P_Expression_If_OK, P_Expression_Or_Range_Attribute_If_OK): Add
	Tok_Declare.
	* par.adb (P_Basic_Declarative_Items): Add parameter
	Declare_Expression so we can tailor the error message about
	incorrect bodies.
	(P_Case_Expression): Move to body.
	* par-ch3.adb (P_Basic_Declarative_Items): Tailor the error
	message about incorrect bodies.
	* par-ch7.adb (P_Package): Pass Declare_Expression => False to
	P_Basic_Declarative_Items.
	* sem.ads (In_Declare_Expr): Counter used to determine whether
	we are analyzing a declare_expression. Needed to give errors
	about things that are not allowed in declare_expression, such as
	the 'Access attribute.
	* sem.adb (Do_Analyze): Save/restore In_Declare_Expr.
	* sem_ch4.adb (Analyze_Expression_With_Actions): Give this node
	its own scope.  That seems better in general, but it is
	necessary for declare_expressions.  For example, an identifier
	declared in a declare_expression should not clash with the same
	identifier in an outer scope.  If this is a declare_expression,
	indicated by Comes_From_Source, then check legality rules, and
	incr/decr In_Declare_Expr.
	* sem_aggr.adb (Resolve_Aggregate): Allow an applicable index
	constraint for a declare_expression, so if its expression is an
	array aggregate, it can have "others => ...".
	* sem_attr.adb (Analyze_Access_Attribute): Disallow these
	attributes in declare_expressions. Add comment to make it clear
	that Unrestricted_Access is included.
	* sinfo.ads, sinfo.adb, atree.ads, atree.adb: Remove the
	now-incorrect comment in sinfo.ads that says
	N_Expression_With_Actions has no proper scope.  Add 17-parameter
	versions of Nkind_In.  Remove the 16-parameter versions of
	Nkind_In.

13 files changed, 253 insertions, 60 deletions

diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb
index 5c60a472b19..b342add9c99 100644
--- a/gcc/ada/atree.adb
+++ b/gcc/ada/atree.adb
@@ -1940,11 +1940,12 @@ package body Atree is
       V13 : Node_Kind;
       V14 : Node_Kind;
       V15 : Node_Kind;
-      V16 : Node_Kind) return Boolean
+      V16 : Node_Kind;
+      V17 : Node_Kind) return Boolean
    is
    begin
       return Nkind_In (Nkind (N), V1, V2, V3, V4, V5, V6, V7, V8, V9, V10,
-                                  V11, V12, V13, V14, V15, V16);
+                                  V11, V12, V13, V14, V15, V16, V17);
    end Nkind_In;
 
    --------
diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads
index f9ebc38e554..68415d49ecb 100644
--- a/gcc/ada/atree.ads
+++ b/gcc/ada/atree.ads
@@ -772,7 +772,7 @@ package Atree is
       V10 : Node_Kind;
       V11 : Node_Kind) return Boolean;
 
-   --  12..15-parameter versions are not yet needed
+   --  12..16-parameter versions are not yet needed
 
    function Nkind_In
      (N   : Node_Id;
@@ -791,7 +791,8 @@ package Atree is
       V13 : Node_Kind;
       V14 : Node_Kind;
       V15 : Node_Kind;
-      V16 : Node_Kind) return Boolean;
+      V16 : Node_Kind;
+      V17 : Node_Kind) return Boolean;
 
    pragma Inline (Nkind_In);
    --  Inline all above functions
diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb
index 34d93632bdb..1fadf368c18 100644
--- a/gcc/ada/par-ch3.adb
+++ b/gcc/ada/par-ch3.adb
@@ -4702,7 +4702,9 @@ package body Ch3 is
    --  the scan pointer is repositioned past the next semicolon, and the scan
    --  for declarative items continues.
 
-   function P_Basic_Declarative_Items return List_Id is
+   function P_Basic_Declarative_Items
+     (Declare_Expression : Boolean) return List_Id
+   is
       Decl  : Node_Id;
       Decls : List_Id;
       Kind  : Node_Kind;
@@ -4750,7 +4752,15 @@ package body Ch3 is
             Kind = N_Task_Body       or else
             Kind = N_Protected_Body
          then
-            Error_Msg ("proper body not allowed in package spec", Sloc (Decl));
+            if Declare_Expression then
+               Error_Msg
+                 ("proper body not allowed in declare_expression",
+                  Sloc (Decl));
+            else
+               Error_Msg
+                 ("proper body not allowed in package spec",
+                  Sloc (Decl));
+            end if;
 
             --  Complete declaration of mangled subprogram body, for better
             --  recovery if analysis is attempted.
diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb
index fe7b577572c..e3f3f06f8a8 100644
--- a/gcc/ada/par-ch4.adb
+++ b/gcc/ada/par-ch4.adb
@@ -72,23 +72,24 @@ package body Ch4 is
    -- Local Subprograms --
    -----------------------
 
-   function P_Aggregate_Or_Paren_Expr                 return Node_Id;
-   function P_Allocator                               return Node_Id;
-   function P_Case_Expression_Alternative             return Node_Id;
-   function P_Iterated_Component_Association          return Node_Id;
-   function P_Record_Or_Array_Component_Association   return Node_Id;
-   function P_Factor                                  return Node_Id;
-   function P_Primary                                 return Node_Id;
-   function P_Relation                                return Node_Id;
-   function P_Term                                    return Node_Id;
+   function P_Aggregate_Or_Paren_Expr               return Node_Id;
+   function P_Allocator                             return Node_Id;
+   function P_Case_Expression_Alternative           return Node_Id;
+   function P_Iterated_Component_Association        return Node_Id;
+   function P_Record_Or_Array_Component_Association return Node_Id;
+   function P_Factor                                return Node_Id;
+   function P_Primary                               return Node_Id;
+   function P_Relation                              return Node_Id;
+   function P_Term                                  return Node_Id;
+   function P_Declare_Expression                    return Node_Id;
    function P_Reduction_Attribute_Reference (S : Node_Id)
       return Node_Id;
 
-   function P_Binary_Adding_Operator                  return Node_Kind;
-   function P_Logical_Operator                        return Node_Kind;
-   function P_Multiplying_Operator                    return Node_Kind;
-   function P_Relational_Operator                     return Node_Kind;
-   function P_Unary_Adding_Operator                   return Node_Kind;
+   function P_Binary_Adding_Operator                return Node_Kind;
+   function P_Logical_Operator                      return Node_Kind;
+   function P_Multiplying_Operator                  return Node_Kind;
+   function P_Relational_Operator                   return Node_Kind;
+   function P_Unary_Adding_Operator                 return Node_Kind;
 
    procedure Bad_Range_Attribute (Loc : Source_Ptr);
    --  Called to place complaint about bad range attribute at the given
@@ -107,11 +108,18 @@ package body Ch4 is
    --  prefix. The current token is known to be an apostrophe and the
    --  following token is known to be RANGE.
 
-   function P_Unparen_Cond_Case_Quant_Expression return Node_Id;
-   --  This function is called with Token pointing to IF, CASE, or FOR, in a
-   --  context that allows a case, conditional, or quantified expression if
-   --  it is surrounded by parentheses. If not surrounded by parentheses, the
-   --  expression is still returned, but an error message is issued.
+   function P_Case_Expression return Node_Id;
+   --  Scans out a case expression. Called with Token pointing to the CASE
+   --  keyword, and returns pointing to the terminating right parent,
+   --  semicolon, or comma, but does not consume this terminating token.
+
+   function P_Unparen_Cond_Expr_Etc return Node_Id;
+   --  This function is called with Token pointing to IF, CASE, FOR, or
+   --  DECLARE, in a context that allows a conditional (if or case) expression,
+   --  a quantified expression, an iterated component association, or a declare
+   --  expression, if it is surrounded by parentheses. If not surrounded by
+   --  parentheses, the expression is still returned, but an error message is
+   --  issued.
 
    -------------------------
    -- Bad_Range_Attribute --
@@ -1944,8 +1952,12 @@ package body Ch4 is
    begin
       --  Case of conditional, case or quantified expression
 
-      if Token = Tok_Case or else Token = Tok_If or else Token = Tok_For then
-         return P_Unparen_Cond_Case_Quant_Expression;
+      if Token = Tok_Case
+        or else Token = Tok_If
+        or else Token = Tok_For
+        or else Token = Tok_Declare
+      then
+         return P_Unparen_Cond_Expr_Etc;
 
       --  Normal case, not case/conditional/quantified expression
 
@@ -2053,8 +2065,12 @@ package body Ch4 is
    begin
       --  Case of conditional, case or quantified expression
 
-      if Token = Tok_Case or else Token = Tok_If or else Token = Tok_For then
-         return P_Unparen_Cond_Case_Quant_Expression;
+      if Token = Tok_Case
+        or else Token = Tok_If
+        or else Token = Tok_For
+        or else Token = Tok_Declare
+      then
+         return P_Unparen_Cond_Expr_Etc;
 
       --  Normal case, not one of the above expression types
 
@@ -3442,7 +3458,7 @@ package body Ch4 is
         (Loc  : Source_Ptr;
          Cond : Node_Id) return Node_Id
       is
-         Exprs : constant List_Id    := New_List;
+         Exprs : constant List_Id := New_List;
          Expr  : Node_Id;
          State : Saved_Scan_State;
          Eptr  : Source_Ptr;
@@ -3557,6 +3573,49 @@ package body Ch4 is
       return If_Expr;
    end P_If_Expression;
 
+   --------------------------
+   -- P_Declare_Expression --
+   --------------------------
+
+   --  DECLARE_EXPRESSION ::=
+   --      DECLARE {DECLARE_ITEM}
+   --      begin BODY_EXPRESSION
+
+   --  DECLARE_ITEM ::= OBJECT_DECLARATION
+   --  | OBJECT_RENAMING_DECLARATION
+
+   function P_Declare_Expression return Node_Id is
+      Loc : constant Source_Ptr := Token_Ptr;
+   begin
+      Scan; -- past IF
+
+      declare
+         Actions : constant List_Id := P_Basic_Declarative_Items
+           (Declare_Expression => True);
+         --  Most declarative items allowed by P_Basic_Declarative_Items are
+         --  illegal; semantic analysis will deal with that.
+      begin
+         if Token = Tok_Begin then
+            Scan;
+         else
+            Error_Msg_SC -- CODEFIX
+              ("BEGIN expected!");
+         end if;
+
+         declare
+            Expression : constant Node_Id := P_Expression;
+            Result : constant Node_Id :=
+              Make_Expression_With_Actions (Loc, Actions, Expression);
+         begin
+            if Ada_Version < Ada_2020 then
+               Error_Msg ("declare_expression is an Ada 2020 feature", Loc);
+            end if;
+
+            return Result;
+         end;
+      end;
+   end P_Declare_Expression;
+
    -----------------------
    -- P_Membership_Test --
    -----------------------
@@ -3594,11 +3653,11 @@ package body Ch4 is
       end if;
    end P_Membership_Test;
 
-   ------------------------------------------
-   -- P_Unparen_Cond_Case_Quant_Expression --
-   ------------------------------------------
+   -----------------------------
+   -- P_Unparen_Cond_Expr_Etc --
+   -----------------------------
 
-   function P_Unparen_Cond_Case_Quant_Expression return Node_Id is
+   function P_Unparen_Cond_Expr_Etc return Node_Id is
       Lparen : constant Boolean := Prev_Token = Tok_Left_Paren;
 
       Result     : Node_Id;
@@ -3647,6 +3706,15 @@ package body Ch4 is
             Result := P_Iterated_Component_Association;
          end if;
 
+      --  Declare expression
+
+      elsif Token = Tok_Declare then
+         Result := P_Declare_Expression;
+
+         if not (Lparen and then Token = Tok_Right_Paren) then
+            Error_Msg_N ("declare expression must be parenthesized!", Result);
+         end if;
+
       --  No other possibility should exist (caller was supposed to check)
 
       else
@@ -3656,6 +3724,6 @@ package body Ch4 is
       --  Return expression (possibly after having given message)
 
       return Result;
-   end P_Unparen_Cond_Case_Quant_Expression;
+   end P_Unparen_Cond_Expr_Etc;
 
 end Ch4;
diff --git a/gcc/ada/par-ch7.adb b/gcc/ada/par-ch7.adb
index e057daa52c5..9645250cd5b 100644
--- a/gcc/ada/par-ch7.adb
+++ b/gcc/ada/par-ch7.adb
@@ -265,7 +265,8 @@ package body Ch7 is
 
                Set_Defining_Unit_Name (Specification_Node, Name_Node);
                Set_Visible_Declarations
-                 (Specification_Node, P_Basic_Declarative_Items);
+                 (Specification_Node,
+                  P_Basic_Declarative_Items (Declare_Expression => False));
 
                if Token = Tok_Private then
                   Error_Msg_Col := Scopes (Scope.Last).Ecol;
@@ -282,7 +283,8 @@ package body Ch7 is
                   Scan; -- past PRIVATE
 
                   Set_Private_Declarations
-                    (Specification_Node, P_Basic_Declarative_Items);
+                    (Specification_Node,
+                     P_Basic_Declarative_Items (Declare_Expression => False));
 
                   --  Deal gracefully with multiple PRIVATE parts
 
@@ -290,8 +292,10 @@ package body Ch7 is
                      Error_Msg_SC
                        ("only one private part allowed per package");
                      Scan; -- past PRIVATE
-                     Append_List (P_Basic_Declarative_Items,
-                       Private_Declarations (Specification_Node));
+                     Append_List
+                       (P_Basic_Declarative_Items
+                          (Declare_Expression => False),
+                        Private_Declarations (Specification_Node));
                   end loop;
                end if;
 
diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb
index 380386a8534..78790808abd 100644
--- a/gcc/ada/par.adb
+++ b/gcc/ada/par.adb
@@ -679,7 +679,6 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
       --  begin message if indeed the BEGIN is missing.
 
       function P_Array_Type_Definition                return Node_Id;
-      function P_Basic_Declarative_Items              return List_Id;
       function P_Constraint_Opt                       return Node_Id;
       function P_Declarative_Part                     return List_Id;
       function P_Discrete_Choice_List                 return List_Id;
@@ -694,6 +693,14 @@ 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;
 
+      function P_Basic_Declarative_Items
+        (Declare_Expression : Boolean) return List_Id;
+      --  Used to parse the declarative items in a package visible or
+      --  private part (in which case Declare_Expression is False), and
+      --  the declare_items of a declare_expression (in which case
+      --  Declare_Expression is True). Declare_Expression is used to
+      --  affect the wording of error messages.
+
       function P_Access_Definition
         (Null_Exclusion_Present : Boolean) return Node_Id;
       --  Ada 2005 (AI-231/AI-254): The caller parses the null-exclusion part
@@ -787,11 +794,6 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
       function P_Simple_Expression                    return Node_Id;
       function P_Simple_Expression_Or_Range_Attribute return Node_Id;
 
-      function P_Case_Expression return Node_Id;
-      --  Scans out a case expression. Called with Token pointing to the CASE
-      --  keyword, and returns pointing to the terminating right parent,
-      --  semicolon, or comma, but does not consume this terminating token.
-
       function P_Expression_If_OK return Node_Id;
       --  Scans out an expression allowing an unparenthesized case expression,
       --  if expression, or quantified expression to appear without enclosing
diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb
index 44aac6346dc..b84df652aa5 100644
--- a/gcc/ada/sem.adb
+++ b/gcc/ada/sem.adb
@@ -1412,6 +1412,7 @@ package body Sem is
       S_GNAT_Mode         : constant Boolean          := GNAT_Mode;
       S_Global_Dis_Names  : constant Boolean          := Global_Discard_Names;
       S_In_Assertion_Expr : constant Nat              := In_Assertion_Expr;
+      S_In_Declare_Expr   : constant Nat              := In_Declare_Expr;
       S_In_Default_Expr   : constant Boolean          := In_Default_Expr;
       S_In_Spec_Expr      : constant Boolean          := In_Spec_Expression;
       S_Inside_A_Generic  : constant Boolean          := Inside_A_Generic;
@@ -1523,6 +1524,7 @@ package body Sem is
       Full_Analysis      := True;
       Inside_A_Generic   := False;
       In_Assertion_Expr  := 0;
+      In_Declare_Expr    := 0;
       In_Default_Expr    := False;
       In_Spec_Expression := False;
       Set_Comes_From_Source_Default (False);
@@ -1607,6 +1609,7 @@ package body Sem is
       Global_Discard_Names := S_Global_Dis_Names;
       GNAT_Mode            := S_GNAT_Mode;
       In_Assertion_Expr    := S_In_Assertion_Expr;
+      In_Declare_Expr      := S_In_Declare_Expr;
       In_Default_Expr      := S_In_Default_Expr;
       In_Spec_Expression   := S_In_Spec_Expr;
       Inside_A_Generic     := S_Inside_A_Generic;
diff --git a/gcc/ada/sem.ads b/gcc/ada/sem.ads
index e8917741bee..d7f8cdb9cb7 100644
--- a/gcc/ada/sem.ads
+++ b/gcc/ada/sem.ads
@@ -245,13 +245,20 @@ package Sem is
 
    In_Assertion_Expr : Nat := 0;
    --  This is set non-zero if we are within the expression of an assertion
-   --  pragma or aspect. It is a counter which is incremented at the start of
-   --  expanding such an expression, and decremented on completion of expanding
-   --  that expression. Probably a boolean would be good enough, since we think
-   --  that such expressions cannot nest, but that might not be true in the
-   --  future (e.g. if let expressions are added to Ada) so we prepare for that
-   --  future possibility by making it a counter. As with In_Spec_Expression,
-   --  it must be recursively saved and restored for a Semantics call.
+   --  pragma or aspect. It is incremented at the start of expanding such an
+   --  expression, and decremented on completion of expanding that
+   --  expression. This needs to be a counter, rather than a Boolean, because
+   --  assertions can contain declare_expressions, which can contain
+   --  assertions. As with In_Spec_Expression, it must be recursively saved and
+   --  restored for a Semantics call.
+
+   In_Declare_Expr : Nat := 0;
+   --  This is set non-zero if we are within a declare_expression. It is
+   --  incremented at the start of expanding such an expression, and
+   --  decremented on completion of expanding that expression. This needs to be
+   --  a counter, rather than a Boolean, because declare_expressions can
+   --  nest. As with In_Spec_Expression, it must be recursively saved and
+   --  restored for a Semantics call.
 
    In_Compile_Time_Warning_Or_Error : Boolean := False;
    --  Switch to indicate that we are validating a pragma Compile_Time_Warning
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 3152305194c..8608d98ca49 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -976,7 +976,8 @@ package body Sem_Aggr is
                                            N_Extension_Aggregate,
                                            N_Component_Association,
                                            N_Case_Expression_Alternative,
-                                           N_If_Expression))
+                                           N_If_Expression,
+                                           N_Expression_With_Actions))
             then
                Aggr_Resolved :=
                  Resolve_Array_Aggregate
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 6f9a7451e91..23fc0214007 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -801,6 +801,14 @@ package body Sem_Attr is
       --  Start of processing for Analyze_Access_Attribute
 
       begin
+         --  Access and Unchecked_Access are illegal in declare_expressions,
+         --  according to the RM. We also make the GNAT-specific
+         --  Unrestricted_Access attribute illegal.
+
+         if In_Declare_Expr > 0 then
+            Error_Attr ("% attribute cannot occur in a declare_expression", N);
+         end if;
+
          Check_E0;
 
          if Nkind (P) = N_Character_Literal then
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index fe8aed59768..54531560501 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -2216,18 +2216,94 @@ package body Sem_Ch4 is
    -- Analyze_Expression_With_Actions --
    -------------------------------------
 
+   --  Start of processing for Analyze_Quantified_Expression
+
    procedure Analyze_Expression_With_Actions (N : Node_Id) is
+
+      procedure Check_Action_OK (A : Node_Id);
+      --  Check that the action is something that is allows as a declare_item
+      --  of a declare_expression, except the checks are suppressed for
+      --  generated code.
+
+      procedure Check_Action_OK (A : Node_Id) is
+      begin
+         if not Comes_From_Source (N) or else not Comes_From_Source (A) then
+            return; -- Allow anything in generated code
+         end if;
+
+         case Nkind (A) is
+            when N_Object_Declaration =>
+               if Nkind (Object_Definition (A)) = N_Access_Definition then
+                  Error_Msg_N
+                    ("anonymous access type not allowed in declare_expression",
+                     Object_Definition (A));
+               end if;
+
+               if Aliased_Present (A) then
+                  Error_Msg_N ("aliased not allowed in declare_expression", A);
+               end if;
+
+               if Constant_Present (A)
+                 and then not Is_Limited_Type (Etype (Defining_Identifier (A)))
+               then
+                  return; -- nonlimited constants are OK
+               end if;
+
+            when N_Object_Renaming_Declaration =>
+               if Present (Access_Definition (A)) then
+                  Error_Msg_N
+                    ("anonymous access type not allowed in declare_expression",
+                     Access_Definition (A));
+               end if;
+
+               if not Is_Limited_Type (Etype (Defining_Identifier (A))) then
+                  return; -- ???For now; the RM rule is a bit more complicated
+               end if;
+
+            when others =>
+               null; -- Nothing else allowed, not even pragmas
+         end case;
+
+         Error_Msg_N ("object renaming or constant declaration expected", A);
+      end Check_Action_OK;
+
       A : Node_Id;
+      EWA_Scop : Entity_Id;
+
+   --  Start of processing for Analyze_Expression_With_Actions
 
    begin
+      --  Create a scope, which is needed to provide proper visibility of the
+      --  declare_items.
+
+      EWA_Scop := New_Internal_Entity (E_Block, Current_Scope, Sloc (N), 'B');
+      Set_Etype  (EWA_Scop, Standard_Void_Type);
+      Set_Scope  (EWA_Scop, Current_Scope);
+      Set_Parent (EWA_Scop, N);
+      Push_Scope (EWA_Scop);
+
+      --  If this Expression_With_Actions node comes from source, then it
+      --  represents a declare_expression; increment the counter to take note
+      --  of that.
+
+      if Comes_From_Source (N) then
+         In_Declare_Expr := In_Declare_Expr + 1;
+      end if;
+
       A := First (Actions (N));
       while Present (A) loop
          Analyze (A);
+         Check_Action_OK (A);
          Next (A);
       end loop;
 
       Analyze_Expression (Expression (N));
       Set_Etype (N, Etype (Expression (N)));
+      End_Scope;
+
+      if Comes_From_Source (N) then
+         In_Declare_Expr := In_Declare_Expr - 1;
+      end if;
    end Analyze_Expression_With_Actions;
 
    ---------------------------
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index 642e859a5e8..7368db64ddd 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -7288,7 +7288,8 @@ package body Sinfo is
       V13 : Node_Kind;
       V14 : Node_Kind;
       V15 : Node_Kind;
-      V16 : Node_Kind) return Boolean
+      V16 : Node_Kind;
+      V17 : Node_Kind) return Boolean
    is
    begin
       return T = V1  or else
@@ -7306,7 +7307,8 @@ package body Sinfo is
              T = V13 or else
              T = V14 or else
              T = V15 or else
-             T = V16;
+             T = V16 or else
+             T = V17;
    end Nkind_In;
 
    --------------------------
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 7bec540ccee..41847d8eb24 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -7994,9 +7994,18 @@ package Sinfo is
       --  executing all the actions.
 
       --  If the actions contain declarations, then these declarations may
-      --  be referenced within the expression. However note that there is
-      --  no proper scope associated with the expression-with-action, so the
-      --  back-end will elaborate them in the context of the enclosing scope.
+      --  be referenced within the expression.
+
+      --  (AI12-0236-1): In Ada 2020, for a declare_expression, the parser
+      --  generates an N_Expression_With_Actions. Declare_expressions have
+      --  various restrictions, which we do not enforce on
+      --  N_Expression_With_Actions nodes that are generated by the
+      --  expander. The two cases can be distinguished by looking at
+      --  Comes_From_Source.
+
+      --  ???Perhaps we should change the name of this node to
+      --  N_Declare_Expression, and perhaps we should change the Sprint syntax
+      --  to match the RM syntax for declare_expression.
 
       --  Sprint syntax:  do
       --                    action;
@@ -11466,7 +11475,7 @@ package Sinfo is
       V10 : Node_Kind;
       V11 : Node_Kind) return Boolean;
 
-   --  12..15-parameter versions are not yet needed
+   --  12..16-parameter versions are not yet needed
 
    function Nkind_In
      (T   : Node_Kind;
@@ -11485,7 +11494,8 @@ package Sinfo is
       V13 : Node_Kind;
       V14 : Node_Kind;
       V15 : Node_Kind;
-      V16 : Node_Kind) return Boolean;
+      V16 : Node_Kind;
+      V17 : Node_Kind) return Boolean;
 
    pragma Inline (Nkind_In);
    --  Inline all above functions