ada: Crash when using address clause on declare-expression constant

gcc/ada/ChangeLog:

	* gen_il-fields.ads (Scope_Link): New field.
	* gen_il-gen-gen_nodes.adb (N_Expression_With_Actions): Added Scope_Link.
	* sinfo.ads (N_Expression_With_Actions): Add field Scope_Link.
	* sem_ch4.adb (Analyze_Expression_With_Actions): Set field Scope_Link
	* sem_ch5.ads (Has_Sec_Stack_Call): Declaration moved to the package spec.
	* sem_ch5.adb (Has_Sec_Stack_Call): ditto.
	* sem_res.adb (Resolve_Declare_Expression): Push/Pop internally created
	scope to provide proper visibility of the declare_items.

diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads
index ea0d91dcca64cceac320364edb2e3a2941be0a77..956dc72374f06367c370c8b7fbfea6dfa5201475 100644 (file)
--- a/gcc/ada/gen_il-fields.ads
+++ b/gcc/ada/gen_il-fields.ads
@@ -383,6 +383,7 @@ package Gen_IL.Fields is
       SCIL_Tag_Value,
       SCIL_Target_Prim,
       Scope,
+      Scope_Link,
       Select_Alternatives,
       Selector_Name,
       Selector_Names,

diff --git a/gcc/ada/gen_il-gen-gen_nodes.adb b/gcc/ada/gen_il-gen-gen_nodes.adb
index 3f145151ea4f8614bde7a375fed132eaef46c8ef..eeaa55d9b8f5ed989322ea7369dcb15857ac4217 100644 (file)
--- a/gcc/ada/gen_il-gen-gen_nodes.adb
+++ b/gcc/ada/gen_il-gen-gen_nodes.adb
@@ -364,7 +364,8 @@ begin -- Gen_IL.Gen.Gen_Nodes
 
    Cc (N_Expression_With_Actions, N_Subexpr,
        (Sy (Actions, List_Id, Default_No_List),
-        Sy (Expression, Node_Id, Default_Empty)));
+        Sy (Expression, Node_Id, Default_Empty),
+        Sm (Scope_Link, Node_Id)));
 
    Cc (N_External_Initializer, N_Subexpr,
        (Sy (File_Index, Source_File_Index)));

diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index d6b56b4c6d56c177c55169448fc753a8443cf191..3d84a57490b47cd285e3b5c7906299ce6989af65 100644 (file)
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -2482,6 +2482,8 @@ package body Sem_Ch4 is
          Error_Msg_N ("object renaming or constant declaration expected", A);
       end Check_Action_OK;
 
+      --  Local variables
+
       A        : Node_Id;
       EWA_Scop : Entity_Id;
 
@@ -2497,6 +2499,8 @@ package body Sem_Ch4 is
       Set_Parent (EWA_Scop, N);
       Push_Scope (EWA_Scop);
 
+      Set_Scope_Link (N, 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.
@@ -2514,11 +2518,13 @@ package body Sem_Ch4 is
 
       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;
+
+      pragma Assert (Current_Scope = Scope_Link (N));
+      End_Scope;
    end Analyze_Expression_With_Actions;
 
    ---------------------------

diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index dc7bc74a5a90e01102236d61640fc956ce319785..a9a288bd45f3e17b4f779b6bb06e17ac9abe61d8 100644 (file)
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -94,17 +94,6 @@ package body Sem_Ch5 is
    --  statements. On success, the return value is the entity of the loop
    --  referenced by the statement.
 
-   function Has_Sec_Stack_Call (N : Node_Id) return Boolean;
-   --  N is the node for an arbitrary construct. This function searches the
-   --  construct N to see if it contains a function call that returns on the
-   --  secondary stack, returning True if any such call is found, and False
-   --  otherwise.
-
-   --  ??? The implementation invokes Sem_Util.Requires_Transient_Scope so it
-   --  will return True if N contains a function call that needs finalization,
-   --  in addition to the above specification. See Analyze_Loop_Statement for
-   --  a similar comment about this entanglement.
-
    procedure Preanalyze_Range (R_Copy : Node_Id);
    --  Determine expected type of range or domain of iteration of Ada 2012
    --  loop by analyzing separate copy. Do the analysis and resolution of the

diff --git a/gcc/ada/sem_ch5.ads b/gcc/ada/sem_ch5.ads
index 879b52fc6a44032045a94e2b6d0c2a5c36d528d3..c01f2dcb029291eae89d182bc5c6dd3824cf8423 100644 (file)
--- a/gcc/ada/sem_ch5.ads
+++ b/gcc/ada/sem_ch5.ads
@@ -52,4 +52,15 @@ package Sem_Ch5 is
    --  checks to see if the statement is followed by some other statement, and
    --  if so generates an appropriate warning for unreachable code.
 
+   function Has_Sec_Stack_Call (N : Node_Id) return Boolean;
+   --  N is the node for an arbitrary construct. This function searches the
+   --  construct N to see if it contains a function call that returns on the
+   --  secondary stack, returning True if any such call is found, and False
+   --  otherwise.
+
+   --  ??? The implementation invokes Sem_Util.Requires_Transient_Scope so it
+   --  will return True if N contains a function call that needs finalization,
+   --  in addition to the above specification. See Analyze_Loop_Statement for
+   --  a similar comment about this entanglement.
+
 end Sem_Ch5;

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 8c0d970da96201f2ed44eb7aa57efbb2646f73d0..3af928ee1e2b9dc0653f1c8b4f8594ce3be15c4d 100644 (file)
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -7767,6 +7767,22 @@ package body Sem_Res is
    --  Start of processing for Resolve_Declare_Expression
 
    begin
+      --  Create a transient scope if the type of this declare-expression
+      --  or its expression requires it; this must be done before we push
+      --  in the scope stack the scope of this declare expression (in order
+      --  to properly remove it from the stack on exit from this routine).
+      --  Given that we don't know yet if secondary stack management will
+      --  be needed, we assume the worst case.
+
+      if not Preanalysis_Active
+        and then (Requires_Transient_Scope (Typ)
+                    or else Has_Sec_Stack_Call (Expr))
+      then
+         Establish_Transient_Scope (N, Manage_Sec_Stack => True);
+      end if;
+
+      Push_Scope (Scope_Link (N));
+
       Decl := First (Actions (N));
 
       while Present (Decl) loop
@@ -7831,6 +7847,9 @@ package body Sem_Res is
             Next_Elmt (Cursor);
          end loop;
       end;
+
+      pragma Assert (Current_Scope = Scope_Link (N));
+      End_Scope;
    end Resolve_Declare_Expression;
 
    -----------------------------------

diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 27f88cd914e63a6498655cf8791115a83c0f637f..477f4bc312d34a8bcb9bf8fa5129666dc749c8ca 100644 (file)
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -2261,6 +2261,11 @@ package Sinfo is
    --    scope all use this field to reference the corresponding scope entity.
    --    See Einfo for further details.
 
+   --  Scope_Link
+   --    Present in N_Expression_With_Actions nodes. References the internally
+   --    built scope created to provide proper visibility of the declare_items
+   --    to the expander.
+
    --  Selector_Name
    --    Present in N_Expanded_Name N_Selected_Component,
    --    N_Generic_Association, and N_Parameter_Association nodes.
@@ -8099,6 +8104,7 @@ package Sinfo is
       --  N_Expression_With_Actions
       --  Actions
       --  Expression
+      --  Scope_Link
       --  plus fields for expression
 
       --  Note: In the final generated tree presented to the code generator,