diff --git a/ada/ast.py b/ada/ast.py index af51c492c..b8b735599 100644 --- a/ada/ast.py +++ b/ada/ast.py @@ -5052,15 +5052,23 @@ def defining_env(): Entity.base_types.map(lambda bt: bt._.defining_env) )).concat(Entity.previous_part_env.singleton).env_group(), - Entity.match( - lambda ar=T.ArrayTypeDef: ar.comp_type.defining_env, + Self.is_a(T.ArrayTypeDef), + Array([ + Entity.cast(T.ArrayTypeDef).comp_type.defining_env, + Entity.dottable_subps_env + ]).env_group(), + Self.is_a(T.AccessDef), + Array([ # An access to procedure will have a null accessed_type, hence # the use of the underscore. - lambda ac=T.AccessDef: ac.accessed_type._.defining_env, + Entity.cast(T.AccessDef).accessed_type._.defining_env, + Entity.dottable_subps_env + ]).env_group(), - lambda _: EmptyEnv - ) + # In any case, include the type's `dottable_subps_env` so as to + # fully support the universal dot notation feature. + Entity.dottable_subps_env ) containing_type = Property( diff --git a/testsuite/tests/name_resolution/prefixed_untagged/test.out b/testsuite/tests/name_resolution/prefixed_untagged/test.out index c45d72907..028e2c42a 100644 --- a/testsuite/tests/name_resolution/prefixed_untagged/test.out +++ b/testsuite/tests/name_resolution/prefixed_untagged/test.out @@ -34,4 +34,128 @@ Expr: expected type: None +Analyzing test_access.adb +######################### + +Resolving xrefs for node +************************************************************** + +Expr: + references: + type: None + expected type: None +Expr: + references: + type: + expected type: +Expr: + references: + type: None + expected type: None + + +Analyzing test_array.adb +######################## + +Resolving xrefs for node +************************************************************* + +Expr: + references: + type: None + expected type: None +Expr: + references: + type: + expected type: +Expr: + references: + type: None + expected type: None + + +Analyzing test_scalar.adb +######################### + +Resolving xrefs for node +************************************************************** + +Expr: + references: + type: None + expected type: None +Expr: + references: + type: + expected type: +Expr: + references: + type: None + expected type: None + +Resolving xrefs for node +************************************************************** + +Expr: + references: + type: None + expected type: None +Expr: + references: + type: + expected type: +Expr: + references: + type: None + expected type: None + +Resolving xrefs for node +************************************************************** + +Expr: + references: + type: None + expected type: None +Expr: + references: + type: + expected type: +Expr: + references: + type: None + expected type: None + +Resolving xrefs for node +************************************************************** + +Expr: + references: + type: None + expected type: None +Expr: + references: + type: + expected type: +Expr: + references: + type: None + expected type: None + +Resolving xrefs for node +************************************************************** + +Expr: + references: + type: None + expected type: None +Expr: + references: + type: + expected type: +Expr: + references: + type: None + expected type: None + + Done. diff --git a/testsuite/tests/name_resolution/prefixed_untagged/test.yaml b/testsuite/tests/name_resolution/prefixed_untagged/test.yaml index 173e325ff..93e00d1d5 100644 --- a/testsuite/tests/name_resolution/prefixed_untagged/test.yaml +++ b/testsuite/tests/name_resolution/prefixed_untagged/test.yaml @@ -1,2 +1,2 @@ driver: name-resolution -input_sources: [test.adb] +input_sources: [test.adb, test_access.adb, test_array.adb, test_scalar.adb] diff --git a/testsuite/tests/name_resolution/prefixed_untagged/test_access.adb b/testsuite/tests/name_resolution/prefixed_untagged/test_access.adb new file mode 100644 index 000000000..8ff01d4af --- /dev/null +++ b/testsuite/tests/name_resolution/prefixed_untagged/test_access.adb @@ -0,0 +1,15 @@ +procedure Test_Access is + package Pkg is + type T is null record; + type T_Access is access all T; + + procedure Foo (Self : T_Access) is null; + end Pkg; + + use Pkg; + + X : T_Access; +begin + X.Foo; + pragma Test_Statement; +end Test_Access; diff --git a/testsuite/tests/name_resolution/prefixed_untagged/test_array.adb b/testsuite/tests/name_resolution/prefixed_untagged/test_array.adb new file mode 100644 index 000000000..822f17201 --- /dev/null +++ b/testsuite/tests/name_resolution/prefixed_untagged/test_array.adb @@ -0,0 +1,16 @@ +procedure Test_Array is + package Pkg is + type T is null record; + type T_Array is array (Positive range <>) of T; + + procedure Foo (Self : T_Array) is null; + end Pkg; + + use Pkg; + + X : T_Array (1 .. 10); +begin + X.Foo; + pragma Test_Statement; +end Test_Array; + diff --git a/testsuite/tests/name_resolution/prefixed_untagged/test_scalar.adb b/testsuite/tests/name_resolution/prefixed_untagged/test_scalar.adb new file mode 100644 index 000000000..5aa05ec0b --- /dev/null +++ b/testsuite/tests/name_resolution/prefixed_untagged/test_scalar.adb @@ -0,0 +1,35 @@ +procedure Test_Scalar is + package Pkg is + type Enum_T is (A, B, C); + type Int_T is range 1 .. 10; + type Mod_T is mod 3; + type Fixed_T is delta 0.1 range 0.0 .. 10.0; + type Float_T is digits 8; + + procedure Foo (Self : Enum_T) is null; + procedure Foo (Self : Int_T) is null; + procedure Foo (Self : Mod_T) is null; + procedure Foo (Self : Fixed_T) is null; + procedure Foo (Self : Float_T) is null; + end Pkg; + + use Pkg; + + X_1 : Enum_T; + X_2 : Int_T; + X_3 : Mod_T; + X_4 : Fixed_T; + X_5 : Float_T; +begin + X_1.Foo; + pragma Test_Statement; + X_2.Foo; + pragma Test_Statement; + X_3.Foo; + pragma Test_Statement; + X_4.Foo; + pragma Test_Statement; + X_5.Foo; + pragma Test_Statement; +end Test_Scalar; +