diff --git a/ada/ast.py b/ada/ast.py index 52e42661e..1143f1a6e 100644 --- a/ada/ast.py +++ b/ada/ast.py @@ -23495,7 +23495,7 @@ class PackageBody(Body): # Since the reference to the package decl is non transitive, we still # want to reference the envs that are "used" there. reference(Self.cast(AdaNode).singleton, - through=T.PackageBody.package_decl_uses_clauses_envs, + through=T.PackageBody.package_decl_use_clauses_envs, cond=Not(Self.is_compilation_unit_root) | Self.is_subunit) ) @@ -23511,17 +23511,17 @@ class PackageBody(Body): declarative_parts = Property(Entity.decls.singleton) @langkit_property() - def package_decl_uses_clauses_envs(): + def package_decl_use_clauses_envs(): """ Return the environments for the use clauses of the package decl of this body. Used because they need to be explicitly referenced. """ - pd = Var(imprecise_fallback.bind( + return imprecise_fallback.bind( False, Entity.decl_part.cast_or_raise(T.BasePackageDecl) - )) - - return Array([pd.public_part.use_clauses_envs, - pd.private_part._.use_clauses_envs]).env_group() + ).then(lambda pd: Array([ + pd.public_part.use_clauses_envs, + pd.private_part._.use_clauses_envs + ]).env_group()) class TaskBody(Body): diff --git a/testsuite/tests/name_resolution/invalid_subunit/pkg-inner.adb b/testsuite/tests/name_resolution/invalid_subunit/pkg-inner.adb new file mode 100644 index 000000000..e02349523 --- /dev/null +++ b/testsuite/tests/name_resolution/invalid_subunit/pkg-inner.adb @@ -0,0 +1,7 @@ +separate (Pkg) +package body Inner is + procedure Not_Used is null; +begin + I := 1; + pragma Test_Statement; +end Inner; diff --git a/testsuite/tests/name_resolution/invalid_subunit/pkg.adb b/testsuite/tests/name_resolution/invalid_subunit/pkg.adb new file mode 100644 index 000000000..a338a4b17 --- /dev/null +++ b/testsuite/tests/name_resolution/invalid_subunit/pkg.adb @@ -0,0 +1,6 @@ +package body Pkg is + -- package body Inner is separate; + -- We explicitly make the code illegal by commenting out the stub. + -- Libadalang should be able to handle this gracefully without property + -- errors. +end Pkg; diff --git a/testsuite/tests/name_resolution/invalid_subunit/pkg.ads b/testsuite/tests/name_resolution/invalid_subunit/pkg.ads new file mode 100644 index 000000000..6c9969420 --- /dev/null +++ b/testsuite/tests/name_resolution/invalid_subunit/pkg.ads @@ -0,0 +1,7 @@ +package Pkg is + package Inner is + procedure Not_Used; + + I : Integer; + end Inner; +end Pkg; diff --git a/testsuite/tests/name_resolution/invalid_subunit/test.out b/testsuite/tests/name_resolution/invalid_subunit/test.out new file mode 100644 index 000000000..117b7f3ba --- /dev/null +++ b/testsuite/tests/name_resolution/invalid_subunit/test.out @@ -0,0 +1,17 @@ +Analyzing pkg-inner.adb +####################### + +Resolving xrefs for node +************************************************************ + +Expr: + references: + type: + expected type: None +Expr: + references: None + type: + expected type: + + +Done. diff --git a/testsuite/tests/name_resolution/invalid_subunit/test.yaml b/testsuite/tests/name_resolution/invalid_subunit/test.yaml new file mode 100644 index 000000000..b8722998c --- /dev/null +++ b/testsuite/tests/name_resolution/invalid_subunit/test.yaml @@ -0,0 +1,2 @@ +driver: name-resolution +input_sources: [pkg-inner.adb]