parent_basic_decl on a generic's body should return the instantiation.

ada/nodes.lkt

@@ -347,7 +347,8 @@ class AdaNode implements Node[AdaNode] {
     |"
     |" .. note:: If the parent BasicDecl of the given node is a generic
     |"     declaration, this call will return the instantiation from which
-    |"     the node was retrieved instead, if any.
+    |"     the node was retrieved instead, if any. This also applies to bodies
+    |"     of generic declarations.
     |"
     |" .. note:: When called on a subunit's body, this property will return
     |"     its corresponding body stub.
@@ -360,13 +361,24 @@ class AdaNode implements Node[AdaNode] {
         # call parent_basic_decl on the parent type, to avoid getting the
         # type itself as a parent_basic_decl (since some types introduce a
         # scope).
-        if self is ClasswideTypeDecl | DiscreteBaseSubtypeDecl | SynthAnonymousTypeDecl then self.semantic_parent().parent_basic_decl() else self.as[GenericDecl].do((gd) => gd.decl().get_instantiation()) or? self.semantic_parent().do(
-            (sp) => if sp is GenericDecl then sp.as[GenericDecl].do(
-                (gd) => gd.decl().get_instantiation() or? gd
+        if self is ClasswideTypeDecl
+                   | DiscreteBaseSubtypeDecl
+                   | SynthAnonymousTypeDecl then
+            self.semantic_parent().parent_basic_decl()
+        else {
+            val gen_decl = self.as[GenericDecl];
+            val gen_body = self.as[Body]?.decl_part.do(
+                (dp) => dp.as[GenericDecl] or? dp.parent.as[GenericDecl]
+            );
+            (gen_decl or? gen_body).do(
+                (gd) => gd.decl().get_instantiation()
+            ) or? self.semantic_parent().do((sp) =>
+                if sp is GenericSubpInternal | GenericPackageInternal then
+                    sp.parent_basic_decl()
+                else
+                    sp.as[BasicDecl] or? sp.parent_basic_decl()
             )
-            elif sp is GenericSubpInternal | GenericPackageInternal then sp.parent_basic_decl()
-            else sp.as[BasicDecl] or? sp.parent_basic_decl()
-        )
+        }
 
     |" Helper for the properties ``has_spark_mode_on`` and
     |" ``is_subject_to_proof``.
@@ -13426,22 +13438,25 @@ class DefiningName: Name {
             case n => n.as_single_tok_node_array().map((t) => t.text())
         };
         val bd = self.basic_decl();
-        val self_name = def_name_array.map(
-            (t, i) => t & (
-                if include_profile then bd.custom_id_text() else ""
-            ) & (
-                if i == def_name_array.length() - 1 then suffix else ""
-            )
+        val self_name = def_name_array.map((t, i) =>
+            t
+            & (if include_profile then bd.custom_id_text() else "")
+            & (if i == def_name_array.length() - 1 then suffix else "")
         );
         val parent_decl = bd.parent_basic_decl();
-        val is_generic = bd is GenericDecl;
-        val is_instantiated = is_generic and parent_decl is GenericInstantiation;
-        val fqn = if not is_instantiated and bd.is_compilation_unit_root() then self_name else parent_decl?.fully_qualified_name_string_array(include_profile=include_profile).do(
-            (fqn) => # If we were on an instantiated generic declaration, we don't
-            # want to include the name of the generic but the name of the
-            # instance (which is `fqn`).
-            if is_instantiated then fqn else fqn & self_name
-        );
+        val is_instantiated = (bd is GenericDecl | Body)
+            and parent_decl is GenericInstantiation;
+        val fqn = if not is_instantiated and bd.is_compilation_unit_root() then
+            self_name
+        else
+            parent_decl?.fully_qualified_name_string_array(
+                include_profile=include_profile
+            ).do((fqn) =>
+                # If we were on an instantiated generic declaration, we don't
+                # want to include the name of the generic but the name of the
+                # instance (which is `fqn`).
+                if is_instantiated then fqn else fqn & self_name
+            );
 
         bd.parent.as[Subunit].do(
             (su) => su.name.as_single_tok_node_array()

testsuite/tests/properties/fully_qualified_name_8/test.adb

@@ -0,0 +1,30 @@
+procedure Test is
+   generic
+   package Gen is
+      procedure Visible;
+   end Gen;
+
+   package body Gen is
+      procedure Inner is
+      begin
+         null;
+      end Inner;
+
+      procedure Visible is
+      begin
+         Inner;
+      end Visible;
+
+   end Gen;
+
+   package Inst is new Gen;
+   --% gen_body = node.p_designated_generic_decl.p_body_part
+   --% gen_body.p_fully_qualified_name
+   --% inner = gen_body.findall(lal.SubpBody)[0]
+   --% visible = gen_body.findall(lal.SubpBody)[1]
+   --% inner.p_fully_qualified_name
+   --% visible.p_fully_qualified_name
+begin
+   Inst.Visible;
+end Test;
+

testsuite/tests/properties/fully_qualified_name_8/test.out

@@ -0,0 +1,20 @@
+Working on node <GenericPackageInstantiation ["Inst"] test.adb:20:4-20:28>
+==========================================================================
+
+Set 'gen_body' to 'node.p_designated_generic_decl.p_body_part'
+Result: <| PackageBody ["Gen"] test.adb:7:4-18:12 [test.adb:20:4] |>
+
+Eval 'gen_body.p_fully_qualified_name'
+Result: 'Test.Inst'
+
+Set 'inner' to 'gen_body.findall(lal.SubpBody)[0]'
+Result: <| SubpBody ["Inner"] test.adb:8:7-11:17 [test.adb:20:4] |>
+
+Set 'visible' to 'gen_body.findall(lal.SubpBody)[1]'
+Result: <| SubpBody ["Visible"] test.adb:13:7-16:19 [test.adb:20:4] |>
+
+Eval 'inner.p_fully_qualified_name'
+Result: 'Test.Inst.Inner'
+
+Eval 'visible.p_fully_qualified_name'
+Result: 'Test.Inst.Visible'

testsuite/tests/properties/fully_qualified_name_8/test.yaml

@@ -0,0 +1,2 @@
+driver: inline-playground
+input_sources: [test.adb]

testsuite/tests/properties/parent_basic_decl/gen.adb

@@ -18,18 +18,18 @@ procedure Gen is
    --% decl = node.p_designated_generic_decl
    --% decl.p_parent_basic_decl
    --% internal = decl.f_package_decl
-   --% internal.p_parent_basic_decl
+   --% internal.p_parent_basic_decl.p_parent_basic_decl
    --% obj = internal.find(lal.ObjectDecl)
-   --% obj.p_parent_basic_decl
+   --% obj.p_parent_basic_decl.p_parent_basic_decl
 
    procedure My_Subp is new Subp_G;
    --% node.p_parent_basic_decl
    --% decl = node.p_designated_generic_decl
    --% decl.p_parent_basic_decl
    --% internal = decl.f_subp_decl
-   --% internal.p_parent_basic_decl
+   --% internal.p_parent_basic_decl.p_parent_basic_decl
    --% param = decl.find(lal.ParamSpec)
-   --% param.p_parent_basic_decl
+   --% param.p_parent_basic_decl.p_parent_basic_decl
 begin
    null;
 end Gen;

testsuite/tests/properties/parent_basic_decl/test.out

@@ -37,13 +37,13 @@ Result: <GenericPackageInstantiation ["My_Pkg"] gen.adb:16:4-16:32>
 Set 'internal' to 'decl.f_package_decl'
 Result: <| GenericPackageInternal ["Pkg_G"] gen.adb:3:4-5:14 [gen.adb:16:4] |>
 
-Eval 'internal.p_parent_basic_decl'
+Eval 'internal.p_parent_basic_decl.p_parent_basic_decl'
 Result: <GenericPackageInstantiation ["My_Pkg"] gen.adb:16:4-16:32>
 
 Set 'obj' to 'internal.find(lal.ObjectDecl)'
 Result: <| ObjectDecl ["X"] gen.adb:4:7-4:19 [gen.adb:16:4] |>
 
-Eval 'obj.p_parent_basic_decl'
+Eval 'obj.p_parent_basic_decl.p_parent_basic_decl'
 Result: <GenericPackageInstantiation ["My_Pkg"] gen.adb:16:4-16:32>
 
 Working on node <GenericSubpInstantiation ["My_Subp"] gen.adb:25:4-25:36>
@@ -61,13 +61,13 @@ Result: <GenericSubpInstantiation ["My_Subp"] gen.adb:25:4-25:36>
 Set 'internal' to 'decl.f_subp_decl'
 Result: <| GenericSubpInternal ["Subp_G"] gen.adb:11:4-11:34 [gen.adb:25:4] |>
 
-Eval 'internal.p_parent_basic_decl'
+Eval 'internal.p_parent_basic_decl.p_parent_basic_decl'
 Result: <GenericSubpInstantiation ["My_Subp"] gen.adb:25:4-25:36>
 
 Set 'param' to 'decl.find(lal.ParamSpec)'
 Result: <| ParamSpec ["X"] gen.adb:11:22-11:33 [gen.adb:25:4] |>
 
-Eval 'param.p_parent_basic_decl'
+Eval 'param.p_parent_basic_decl.p_parent_basic_decl'
 Result: <GenericSubpInstantiation ["My_Subp"] gen.adb:25:4-25:36>
 
 Working on node <SubpDecl ["Foo"] test.adb:8:4-10:19>

testsuite/tests/properties/parent_basic_decl_2/main_package.ads

@@ -9,7 +9,7 @@ package Main_Package is
    procedure Operation_Not is new Operations.Operation (Boolean_And);
    --% decl=node.p_designated_generic_decl
    --% param=decl.p_subp_spec_or_null(True).p_params[0].p_defining_name
-   --% parent_decl=param.p_parent_basic_decl
+   --% parent_decl=param.p_parent_basic_decl.p_parent_basic_decl
    --% parent_decl.p_generic_instantiations
 
 end Main_Package;

testsuite/tests/properties/parent_basic_decl_2/test.out

@@ -7,7 +7,7 @@ Result: <| GenericSubpDecl ["Operation"] main_generic_package.ads:7:4-9:38 [main
 Set 'param' to 'decl.p_subp_spec_or_null(True).p_params[0].p_defining_name'
 Result: <| DefiningName "X" main_generic_package.ads:9:25-9:26 [main_package.ads:7:4, main_package.ads:9:4] |>
 
-Set 'parent_decl' to 'param.p_parent_basic_decl'
+Set 'parent_decl' to 'param.p_parent_basic_decl.p_parent_basic_decl'
 Result: <GenericSubpInstantiation ["Operation_Not"] main_package.ads:9:4-9:70>
 
 Eval 'parent_decl.p_generic_instantiations'

testsuite/tests/properties/parent_basic_decl_generic_body/test.adb

@@ -0,0 +1,37 @@
+procedure Test is
+   generic
+   package Pkg is
+      procedure Foo;
+      --% node.p_parent_basic_decl
+      --% node.p_parent_basic_decl.p_parent_basic_decl
+   end Pkg;
+
+   package body Pkg is
+      procedure Foo is null;
+      --% node.p_parent_basic_decl
+      --% node.p_parent_basic_decl.p_parent_basic_decl
+   end Pkg;
+
+   package My_Pkg is new Pkg;
+   --% pkg_spec = node.p_designated_generic_decl
+   --% pkg_body = pkg_spec.p_body_part
+   --% pkg_spec.p_parent_basic_decl
+   --% pkg_body.p_parent_basic_decl
+   --% foo_spec = pkg_spec.find(lal.SubpDecl)
+   --% foo_spec.p_parent_basic_decl
+   --% foo_body = pkg_body.find(lal.NullSubpDecl)
+   --% foo_body.p_parent_basic_decl
+
+   generic
+   procedure Bar;
+
+   procedure Bar is null;
+
+   procedure My_Bar is new Bar;
+   --% bar_decl = node.p_designated_generic_decl
+   --% bar_decl.p_parent_basic_decl
+   --% bar_body = bar_decl.p_body_part()
+   --% bar_body.p_parent_basic_decl
+begin
+   null;
+end Test;

testsuite/tests/properties/parent_basic_decl_generic_body/test.out

@@ -0,0 +1,59 @@
+Working on node <SubpDecl ["Foo"] test.adb:4:7-4:21>
+====================================================
+
+Eval 'node.p_parent_basic_decl'
+Result: <GenericPackageDecl ["Pkg"] test.adb:2:4-7:12>
+
+Eval 'node.p_parent_basic_decl.p_parent_basic_decl'
+Result: <SubpBody ["Test"] test.adb:1:1-37:10>
+
+Working on node <NullSubpDecl ["Foo"] test.adb:10:7-10:29>
+==========================================================
+
+Eval 'node.p_parent_basic_decl'
+Result: <PackageBody ["Pkg"] test.adb:9:4-13:12>
+
+Eval 'node.p_parent_basic_decl.p_parent_basic_decl'
+Result: <SubpBody ["Test"] test.adb:1:1-37:10>
+
+Working on node <GenericPackageInstantiation ["My_Pkg"] test.adb:15:4-15:30>
+============================================================================
+
+Set 'pkg_spec' to 'node.p_designated_generic_decl'
+Result: <| GenericPackageDecl ["Pkg"] test.adb:2:4-7:12 [test.adb:15:4] |>
+
+Set 'pkg_body' to 'pkg_spec.p_body_part'
+Result: <| PackageBody ["Pkg"] test.adb:9:4-13:12 [test.adb:15:4] |>
+
+Eval 'pkg_spec.p_parent_basic_decl'
+Result: <GenericPackageInstantiation ["My_Pkg"] test.adb:15:4-15:30>
+
+Eval 'pkg_body.p_parent_basic_decl'
+Result: <GenericPackageInstantiation ["My_Pkg"] test.adb:15:4-15:30>
+
+Set 'foo_spec' to 'pkg_spec.find(lal.SubpDecl)'
+Result: <| SubpDecl ["Foo"] test.adb:4:7-4:21 [test.adb:15:4] |>
+
+Eval 'foo_spec.p_parent_basic_decl'
+Result: <| GenericPackageDecl ["Pkg"] test.adb:2:4-7:12 [test.adb:15:4] |>
+
+Set 'foo_body' to 'pkg_body.find(lal.NullSubpDecl)'
+Result: <| NullSubpDecl ["Foo"] test.adb:10:7-10:29 [test.adb:15:4] |>
+
+Eval 'foo_body.p_parent_basic_decl'
+Result: <| PackageBody ["Pkg"] test.adb:9:4-13:12 [test.adb:15:4] |>
+
+Working on node <GenericSubpInstantiation ["My_Bar"] test.adb:30:4-30:32>
+=========================================================================
+
+Set 'bar_decl' to 'node.p_designated_generic_decl'
+Result: <| GenericSubpDecl ["Bar"] test.adb:25:4-26:18 [test.adb:30:4] |>
+
+Eval 'bar_decl.p_parent_basic_decl'
+Result: <GenericSubpInstantiation ["My_Bar"] test.adb:30:4-30:32>
+
+Set 'bar_body' to 'bar_decl.p_body_part()'
+Result: <| NullSubpDecl ["Bar"] test.adb:28:4-28:26 [test.adb:30:4] |>
+
+Eval 'bar_body.p_parent_basic_decl'
+Result: <GenericSubpInstantiation ["My_Bar"] test.adb:30:4-30:32>

testsuite/tests/properties/parent_basic_decl_generic_body/test.yaml

@@ -0,0 +1,2 @@
+driver: inline-playground
+input_sources: [test.adb]