Fix P_Aggregate_Params for extended aggregates

Fixup commit c693762.

TN: V914-012

ada/ast.py

@@ -4817,8 +4817,10 @@ class ComponentList(BaseFormalParamHolder):
 
     @langkit_property(return_type=BaseFormalParamDecl.entity.array,
                       dynamic_vars=[env, default_origin()])
-    def abstract_formal_params_for_assocs(assocs=T.AssocList.entity,
-                                          recurse=(Bool, True)):
+    def abstract_formal_params_for_assocs(
+            assocs=T.AssocList.entity,
+            stop_recurse_at=(T.BaseTypeDecl.entity, No(T.BaseTypeDecl.entity))
+    ):
 
         td = Var(Entity.type_decl)
         discriminants = Var(td.discriminants_list)
@@ -4840,7 +4842,7 @@ def abstract_formal_params_for_assocs(assocs=T.AssocList.entity,
         # depending on the static value of discriminants.
         return td.record_def.comps.abstract_formal_params_impl(
             discriminants=discriminants_matches,
-            recurse=recurse
+            stop_recurse_at=stop_recurse_at
         )
 
     @langkit_property(return_type=BaseFormalParamDecl.entity.array)
@@ -4864,7 +4866,8 @@ def abstract_formal_params_for_delta_assocs():
     def abstract_formal_params_impl(
         discriminants=T.ParamMatch.array,
         include_discriminants=(Bool, True),
-        recurse=(Bool, True)
+        recurse=(Bool, True),
+        stop_recurse_at=(T.BaseTypeDecl.entity, No(T.BaseTypeDecl.entity))
     ):
 
         # Get self's components. We pass along discriminants, to get variant
@@ -4880,16 +4883,20 @@ def abstract_formal_params_impl(
         ret = Var(If(
             recurse,
             Entity.parent_component_list.then(
-                lambda pcl: pcl.abstract_formal_params_impl(
-                    pcl.match_formals(
-                        pcl.type_decl.discriminants_list,
-                        Entity.type_def.cast(DerivedTypeDef)
-                        .subtype_indication.constraint
-                        .cast(CompositeConstraint)._.constraints,
-                        is_dottable_subp=False
-                    ),
-                    include_discriminants=False
-                ).concat(self_comps),
+                lambda pcl: If(
+                    pcl.type_decl.matching_type(stop_recurse_at),
+                    self_comps,
+                    pcl.abstract_formal_params_impl(
+                        pcl.match_formals(
+                            pcl.type_decl.discriminants_list,
+                            Entity.type_def.cast(DerivedTypeDef)
+                            .subtype_indication.constraint
+                            .cast(CompositeConstraint)._.constraints,
+                            is_dottable_subp=False
+                        ),
+                        include_discriminants=False
+                    ).concat(self_comps)
+                ),
                 default_val=self_comps
             ),
             self_comps
@@ -15166,9 +15173,9 @@ def zip_with_params():
                 a.expression_type.record_def
                 ._.components.abstract_formal_params_for_assocs(
                     Entity,
-                    # Do not get parent components if `a` is an extended
-                    # aggregate.
-                    recurse=a.ancestor_expr.is_null
+                    # Do not get ancestor_expr's components if `a` is an
+                    # extended aggregate.
+                    stop_recurse_at=a.ancestor_expr._.expression_type
                 ),
             )),
 

testsuite/tests/properties/aggregate_params/test.adb

@@ -7,6 +7,14 @@ procedure Test is
       Y : Integer := 2;
    end record;
 
+   type Child_B is new Child with record
+      Z : Integer := 3;
+   end record;
+
+   type Child_C is new Child_B with record
+      T : Integer := 4;
+   end record;
+
    C : Child := (Root with others => <>);
    --% node.f_default_expr.p_aggregate_params
    D : Child := (Root'(X => 9) with others => <>);
@@ -15,6 +23,9 @@ procedure Test is
    --% node.f_default_expr.p_aggregate_params
    F : Child := (others => <>);
    --% node.f_default_expr.p_aggregate_params
+
+   G : Child_C := (Root with Y => <>, Z => <>, T => <>);
+   --% node.f_default_expr.p_aggregate_params
 begin
    null;
 end Test;

testsuite/tests/properties/aggregate_params/test.out

@@ -133,27 +133,35 @@ Eval 'node.f_expr.p_aggregate_params'
 Result: [<ParamActual param=<DefiningName recagg.adb:41:10-41:11> actual=<Int recagg.adb:90:10-90:11>>,
          <ParamActual param=<DefiningName recagg.adb:46:10-46:11> actual=<Int recagg.adb:90:13-90:14>>]
 
-Working on node <ObjectDecl ["C"] test.adb:10:4-10:42>
+Working on node <ObjectDecl ["C"] test.adb:18:4-18:42>
 ======================================================
 
 Eval 'node.f_default_expr.p_aggregate_params'
-Result: [<ParamActual param=<DefiningName test.adb:7:7-7:8> actual=<BoxExpr test.adb:10:38-10:40>>]
+Result: [<ParamActual param=<DefiningName test.adb:7:7-7:8> actual=<BoxExpr test.adb:18:38-18:40>>]
 
-Working on node <ObjectDecl ["D"] test.adb:12:4-12:51>
+Working on node <ObjectDecl ["D"] test.adb:20:4-20:51>
 ======================================================
 
 Eval 'node.f_default_expr.p_aggregate_params'
-Result: [<ParamActual param=<DefiningName test.adb:7:7-7:8> actual=<BoxExpr test.adb:12:47-12:49>>]
+Result: [<ParamActual param=<DefiningName test.adb:7:7-7:8> actual=<BoxExpr test.adb:20:47-20:49>>]
 
-Working on node <ObjectDecl ["E"] test.adb:14:4-14:45>
+Working on node <ObjectDecl ["E"] test.adb:22:4-22:45>
 ======================================================
 
 Eval 'node.f_default_expr.p_aggregate_params'
-Result: [<ParamActual param=<DefiningName test.adb:7:7-7:8> actual=<Int test.adb:14:42-14:43>>]
+Result: [<ParamActual param=<DefiningName test.adb:7:7-7:8> actual=<Int test.adb:22:42-22:43>>]
 
-Working on node <ObjectDecl ["F"] test.adb:16:4-16:32>
+Working on node <ObjectDecl ["F"] test.adb:24:4-24:32>
 ======================================================
 
 Eval 'node.f_default_expr.p_aggregate_params'
-Result: [<ParamActual param=<DefiningName test.adb:3:7-3:8> actual=<BoxExpr test.adb:16:28-16:30>>,
-         <ParamActual param=<DefiningName test.adb:7:7-7:8> actual=<BoxExpr test.adb:16:28-16:30>>]
+Result: [<ParamActual param=<DefiningName test.adb:3:7-3:8> actual=<BoxExpr test.adb:24:28-24:30>>,
+         <ParamActual param=<DefiningName test.adb:7:7-7:8> actual=<BoxExpr test.adb:24:28-24:30>>]
+
+Working on node <ObjectDecl ["G"] test.adb:27:4-27:57>
+======================================================
+
+Eval 'node.f_default_expr.p_aggregate_params'
+Result: [<ParamActual param=<DefiningName test.adb:7:7-7:8> actual=<BoxExpr test.adb:27:35-27:37>>,
+         <ParamActual param=<DefiningName test.adb:11:7-11:8> actual=<BoxExpr test.adb:27:44-27:46>>,
+         <ParamActual param=<DefiningName test.adb:15:7-15:8> actual=<BoxExpr test.adb:27:53-27:55>>]