From f1f1ddde1c9acfa81aa626d604086a7882986428 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Laurent=20Th=C3=A9venoux?= Date: Wed, 14 Sep 2022 13:52:00 +0200 Subject: [PATCH] Fix `P_Aggregate_Params` for extended aggregates Fixup commit c693762310c153fb00a5f470d2c681cac7a18269. TN: V914-012 --- ada/ast.py | 41 +++++++++++-------- .../properties/aggregate_params/test.adb | 11 +++++ .../properties/aggregate_params/test.out | 26 ++++++++---- 3 files changed, 52 insertions(+), 26 deletions(-) diff --git a/ada/ast.py b/ada/ast.py index fcc448254..453fadbe1 100644 --- a/ada/ast.py +++ b/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 ), )), diff --git a/testsuite/tests/properties/aggregate_params/test.adb b/testsuite/tests/properties/aggregate_params/test.adb index 0f5b2e127..59423bcce 100644 --- a/testsuite/tests/properties/aggregate_params/test.adb +++ b/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; diff --git a/testsuite/tests/properties/aggregate_params/test.out b/testsuite/tests/properties/aggregate_params/test.out index 22475b185..b64b4ee67 100644 --- a/testsuite/tests/properties/aggregate_params/test.out +++ b/testsuite/tests/properties/aggregate_params/test.out @@ -133,27 +133,35 @@ Eval 'node.f_expr.p_aggregate_params' Result: [ actual=>, actual=>] -Working on node +Working on node ====================================================== Eval 'node.f_default_expr.p_aggregate_params' -Result: [ actual=>] +Result: [ actual=>] -Working on node +Working on node ====================================================== Eval 'node.f_default_expr.p_aggregate_params' -Result: [ actual=>] +Result: [ actual=>] -Working on node +Working on node ====================================================== Eval 'node.f_default_expr.p_aggregate_params' -Result: [ actual=>] +Result: [ actual=>] -Working on node +Working on node ====================================================== Eval 'node.f_default_expr.p_aggregate_params' -Result: [ actual=>, - actual=>] +Result: [ actual=>, + actual=>] + +Working on node +====================================================== + +Eval 'node.f_default_expr.p_aggregate_params' +Result: [ actual=>, + actual=>, + actual=>]