https://gcc.gnu.org/g:54594175e990e9a7e49b23a8c7453b1399f3ef4e

commit r16-8999-g54594175e990e9a7e49b23a8c7453b1399f3ef4e
Author: Javier Miranda <[email protected]>
Date:   Wed Jan 28 11:19:45 2026 +0000

    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:
---
 gcc/ada/gen_il-fields.ads        |  1 +
 gcc/ada/gen_il-gen-gen_nodes.adb |  3 ++-
 gcc/ada/sem_ch4.adb              |  8 +++++++-
 gcc/ada/sem_ch5.adb              | 11 -----------
 gcc/ada/sem_ch5.ads              | 11 +++++++++++
 gcc/ada/sem_res.adb              | 19 +++++++++++++++++++
 gcc/ada/sinfo.ads                |  6 ++++++
 7 files changed, 46 insertions(+), 13 deletions(-)

diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads
index 56e6b90f8aef..56b931a9da78 100644
--- a/gcc/ada/gen_il-fields.ads
+++ b/gcc/ada/gen_il-fields.ads
@@ -384,6 +384,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 efa510a9360b..09072795af6e 100644
--- 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 f17572afb361..2018035baeef 100644
--- 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 30cdaeb4a7e0..018a25616ccd 100644
--- 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 879b52fc6a44..c01f2dcb0292 100644
--- 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 270affe5ccb0..b5fb79a4b0f2 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -7793,6 +7793,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
@@ -7857,6 +7873,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 3d15d3e3118d..ff61c02b20bd 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -2265,6 +2265,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.
@@ -8103,6 +8108,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,

Reply via email to