[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.

1 files changed, 76 insertions, 0 deletions

diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index fe8aed5..5453156 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;
 
    ---------------------------