From ebabc59f6fb9a8e0df53f8490109ecff11c109f3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Laurent=20Th=C3=A9venoux?= Date: Tue, 30 Jul 2024 14:12:45 +0200 Subject: [PATCH 1/7] Support implicit dereference through subtype declarations --- ada/nodes.lkt | 3 +++ .../name_resolution/implicit_deref_4/test.adb | 19 ++++++++++++++ .../name_resolution/implicit_deref_4/test.out | 25 +++++++++++++++++++ .../implicit_deref_4/test.yaml | 2 ++ 4 files changed, 49 insertions(+) create mode 100644 testsuite/tests/name_resolution/implicit_deref_4/test.adb create mode 100644 testsuite/tests/name_resolution/implicit_deref_4/test.out create mode 100644 testsuite/tests/name_resolution/implicit_deref_4/test.yaml diff --git a/ada/nodes.lkt b/ada/nodes.lkt index 7c7f5d008..8ce826aa9 100644 --- a/ada/nodes.lkt +++ b/ada/nodes.lkt @@ -6613,6 +6613,9 @@ class SubtypeDecl: BaseSubtypeDecl { case t => t } + fun get_imp_deref(): Entity[Expr] = + self.get_type().get_imp_deref() + fun discrete_range(): DiscreteRange = self.subtype.discrete_range() @with_dynvars(env, origin, entry_point) diff --git a/testsuite/tests/name_resolution/implicit_deref_4/test.adb b/testsuite/tests/name_resolution/implicit_deref_4/test.adb new file mode 100644 index 000000000..bf5d53232 --- /dev/null +++ b/testsuite/tests/name_resolution/implicit_deref_4/test.adb @@ -0,0 +1,19 @@ +procedure Test is + type Database is tagged null record; + + type Connection (D : access Database) is tagged null record + with Implicit_Dereference => D; + + subtype Sub_Connection is Connection; + + function Get (DB : Database'Class) return Boolean is (True); + + procedure P (DB : Sub_Connection) is + B : Boolean := Get (DB); + pragma Test_Statement; + begin + null; + end P; +begin + null; +end; diff --git a/testsuite/tests/name_resolution/implicit_deref_4/test.out b/testsuite/tests/name_resolution/implicit_deref_4/test.out new file mode 100644 index 000000000..cde12277f --- /dev/null +++ b/testsuite/tests/name_resolution/implicit_deref_4/test.out @@ -0,0 +1,25 @@ +Analyzing test.adb +################## + +Resolving xrefs for node +*************************************************************** + +Expr: + references: + type: None + expected type: None +Expr: + references: + type: + expected type: +Expr: + references: + type: + expected type: None +Expr: + references: + type: + expected type: + + +Done. diff --git a/testsuite/tests/name_resolution/implicit_deref_4/test.yaml b/testsuite/tests/name_resolution/implicit_deref_4/test.yaml new file mode 100644 index 000000000..173e325ff --- /dev/null +++ b/testsuite/tests/name_resolution/implicit_deref_4/test.yaml @@ -0,0 +1,2 @@ +driver: name-resolution +input_sources: [test.adb] From eeca7e8ea854cce9c4c332f4b8c618da1e75be8d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Laurent=20Th=C3=A9venoux?= Date: Tue, 30 Jul 2024 14:25:18 +0200 Subject: [PATCH 2/7] Extend iterable_cursor_type support to subtype declarations --- ada/nodes.lkt | 10 +- .../name_resolution/iterable_aspect/test.adb | 9 ++ .../name_resolution/iterable_aspect/test.out | 128 ++++++++++++------ 3 files changed, 104 insertions(+), 43 deletions(-) diff --git a/ada/nodes.lkt b/ada/nodes.lkt index 8ce826aa9..a1a1d00c4 100644 --- a/ada/nodes.lkt +++ b/ada/nodes.lkt @@ -5590,7 +5590,7 @@ class BaseTypeDecl: BasicDecl { # is defined by the `Cursor` type declaration. self.children_env().get_first(s"Cursor").as![BaseTypeDecl] # Check out cursor type for types with `Iterable` aspect - or? self.as[TypeDecl].iterable_cursor_type() + or? self.iterable_cursor_type() fun is_not_root_int_type(): Bool = not node.is_null and self != node.root_int_type() @@ -6446,6 +6446,10 @@ class BaseTypeDecl: BasicDecl { fun iterable_comp_type(): Entity[BaseTypeDecl] = null[Entity[BaseTypeDecl]] + @with_dynvars(origin) + fun iterable_cursor_type(): Entity[BaseTypeDecl] = + null[Entity[BaseTypeDecl]] + |" Return the canonical type declaration for this type declaration. For |" subtypes, it will return the base type declaration. @exported @@ -6566,6 +6570,10 @@ class BaseSubtypeDecl: BaseTypeDecl { fun iterable_comp_type(): Entity[BaseTypeDecl] = self.get_type().iterable_comp_type() + @with_dynvars(origin) + fun iterable_cursor_type(): Entity[BaseTypeDecl] = + self.get_type().iterable_cursor_type() + @with_dynvars(origin=null[AdaNode]) fun is_record_type(): Bool = self.get_type().is_record_type() diff --git a/testsuite/tests/name_resolution/iterable_aspect/test.adb b/testsuite/tests/name_resolution/iterable_aspect/test.adb index 2b072b8ff..af73ca8bf 100644 --- a/testsuite/tests/name_resolution/iterable_aspect/test.adb +++ b/testsuite/tests/name_resolution/iterable_aspect/test.adb @@ -55,6 +55,10 @@ procedure Test is procedure My_Put_Line (S : String) is null; + subtype Sub_List is List; + + My_Sub_List : Sub_List := (S => "Subwou"); + begin for E of My_List loop @@ -77,4 +81,9 @@ begin end loop; pragma Test_Block; + for E in My_Sub_List loop + My_Put_Line (Get_Element (My_Sub_List, E)'Image); + end loop; + pragma Test_Block; + end Test; diff --git a/testsuite/tests/name_resolution/iterable_aspect/test.out b/testsuite/tests/name_resolution/iterable_aspect/test.out index 62f9d0a55..a1b7d7493 100644 --- a/testsuite/tests/name_resolution/iterable_aspect/test.out +++ b/testsuite/tests/name_resolution/iterable_aspect/test.out @@ -1,154 +1,198 @@ Analyzing test.adb ################## -Resolving xrefs for node +Resolving xrefs for node ********************************************************** -Expr: +Expr: references: type: expected type: None -Resolving xrefs for node +Resolving xrefs for node ******************************************************* -Expr: +Expr: references: type: None expected type: None -Expr: +Expr: references: type: None expected type: None -Expr: +Expr: references: None type: expected type: -Expr: - references: +Expr: + references: type: expected type: None -Expr: +Expr: references: None type: None expected type: None -Resolving xrefs for node +Resolving xrefs for node ********************************************************** -Expr: +Expr: references: type: expected type: None -Resolving xrefs for node +Resolving xrefs for node ******************************************************* -Expr: +Expr: references: type: None expected type: None -Expr: +Expr: references: type: None expected type: None -Expr: +Expr: references: None type: expected type: -Expr: +Expr: references: type: expected type: None -Expr: +Expr: references: type: expected type: None -Expr: +Expr: references: type: expected type: -Expr: - references: +Expr: + references: type: expected type: -Expr: +Expr: references: None type: None expected type: None -Resolving xrefs for node +Resolving xrefs for node ********************************************************** -Expr: +Expr: references: type: expected type: None -Resolving xrefs for node +Resolving xrefs for node ******************************************************* -Expr: +Expr: references: type: None expected type: None -Expr: +Expr: references: type: None expected type: None -Expr: +Expr: references: None type: expected type: -Expr: - references: +Expr: + references: type: expected type: None -Expr: +Expr: references: None type: None expected type: None -Resolving xrefs for node +Resolving xrefs for node ********************************************************** -Expr: +Expr: references: type: expected type: None -Resolving xrefs for node +Resolving xrefs for node ******************************************************* -Expr: +Expr: references: type: None expected type: None -Expr: +Expr: references: type: None expected type: None -Expr: +Expr: references: None type: expected type: -Expr: +Expr: references: type: expected type: None -Expr: +Expr: references: type: expected type: None -Expr: +Expr: references: type: expected type: -Expr: - references: +Expr: + references: type: expected type: -Expr: +Expr: + references: None + type: None + expected type: None + +Resolving xrefs for node +********************************************************** + +Expr: + references: + type: + expected type: None + +Resolving xrefs for node +******************************************************* + +Expr: + references: + type: None + expected type: None +Expr: + references: + type: None + expected type: None +Expr: + references: None + type: + expected type: +Expr: + references: + type: + expected type: None +Expr: + references: + type: + expected type: None +Expr: + references: + type: + expected type: +Expr: + references: + type: + expected type: +Expr: references: None type: None expected type: None From 12f1624434492f3f2fc17b5a54ecee2e8dcdb5d5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Laurent=20Th=C3=A9venoux?= Date: Tue, 30 Jul 2024 14:38:15 +0200 Subject: [PATCH 3/7] Extend 'Result attribute designated_env support to expression function --- ada/nodes.lkt | 9 +- .../name_resolution/post_result/test.out | 82 ++++++++++++++++++- .../post_result/test_result_attr.adb | 4 + 3 files changed, 89 insertions(+), 6 deletions(-) diff --git a/ada/nodes.lkt b/ada/nodes.lkt index a1a1d00c4..7125a4071 100644 --- a/ada/nodes.lkt +++ b/ada/nodes.lkt @@ -12760,8 +12760,13 @@ class AttributeRef: Name { @with_dynvars(env, origin, no_visibility=false) fun designated_env(): LexicalEnv = - if self.is_access_attr() or self.attribute.name_is(s"Old") then self.prefix.designated_env() - elif self.attribute.name_is(s"Result") then node.parents().find((p) => p is BasicSubpDecl | SubpBody).as_entity.as[BasicDecl].subp_spec_or_null().return_type().defining_env() + if self.is_access_attr() or self.attribute.name_is(s"Old") then + self.prefix.designated_env() + elif self.attribute.name_is(s"Result") then + node.parents().find( + (p) => p is BasicSubpDecl | BaseSubpBody + ).as_entity.as[BasicDecl].subp_spec_or_null().return_type() + .defining_env() else null[LexicalEnv] |" Return the subprogram declaration referred by this attribute name, diff --git a/testsuite/tests/name_resolution/post_result/test.out b/testsuite/tests/name_resolution/post_result/test.out index fbfee0e20..cd6914cbf 100644 --- a/testsuite/tests/name_resolution/post_result/test.out +++ b/testsuite/tests/name_resolution/post_result/test.out @@ -174,18 +174,92 @@ Expr: type: expected type: -Resolving xrefs for node +Resolving xrefs for node +********************************************************************************** + + +Resolving xrefs for node +******************************************************************************* + +Expr: + references: + type: None + expected type: None + +Resolving xrefs for node +******************************************************************************** + +Expr: + type: + expected type: +Expr: + references: + type: None + expected type: None +Expr: + references: None + type: + expected type: + +Resolving xrefs for node +******************************************************************* + +Expr: + references: + type: None + expected type: None + +Resolving xrefs for node +********************************************************************** + +Expr: + references: None + type: None + expected type: None +Expr: + type: + expected type: +Expr: + references: + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: + type: None + expected type: None +Expr: + references: None + type: None + expected type: None +Expr: + references: + type: + expected type: +Expr: + expected type: + +Resolving xrefs for node ****************************************************************** -Resolving xrefs for node +Resolving xrefs for node ****************************************************************** -Expr: +Expr: references: type: None expected type: None -Expr: +Expr: references: type: None expected type: None diff --git a/testsuite/tests/name_resolution/post_result/test_result_attr.adb b/testsuite/tests/name_resolution/post_result/test_result_attr.adb index 571752de5..1201a7303 100644 --- a/testsuite/tests/name_resolution/post_result/test_result_attr.adb +++ b/testsuite/tests/name_resolution/post_result/test_result_attr.adb @@ -14,6 +14,10 @@ procedure Test_Result_Attr is pragma Post (T2'Result = True); + type T3 is record A : Integer; end record; + + function Expr return T3 is (A => 8) with + Post => Expr'Result.A = 8; begin null; end Test_Result_Attr; From b788065b912a770bf0b4646096a73b32ca0219bb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Laurent=20Th=C3=A9venoux?= Date: Tue, 30 Jul 2024 14:47:44 +0200 Subject: [PATCH 4/7] Add support for the Code_Address attribute --- ada/nodes.lkt | 3 +- .../name_resolution/address_clause/subp.adb | 5 ++- .../name_resolution/address_clause/test.out | 35 +++++++++++++++++++ 3 files changed, 41 insertions(+), 2 deletions(-) diff --git a/ada/nodes.lkt b/ada/nodes.lkt index 7125a4071..b00f7e39c 100644 --- a/ada/nodes.lkt +++ b/ada/nodes.lkt @@ -12791,7 +12791,8 @@ class AttributeRef: Name { elif rel_name == s"Enum_Rep" then self.enum_rep_equation() elif rel_name in s"Invalid_Value" | s"First_Valid" | s"Last_Valid" then self.self_type_equation() elif rel_name == s"Identity" then self.identity_equation() - elif rel_name == s"Address" then self.address_equation() + elif rel_name in s"Address" | s"Code_Address" then + self.address_equation() elif rel_name in s"Small" | s"Model_Small" | s"Safe_Small" | s"Epsilon" | s"Model_Epsilon" | s"Large" | s"Safe_Large" | s"Delta" | s"Safe_First" | s"Safe_Last" then self.universal_real_equation() elif rel_name == s"Img" then self.img_equation(node.std_string_type()) elif rel_name == s"Tag" then self.tag_attr_equation() diff --git a/testsuite/tests/name_resolution/address_clause/subp.adb b/testsuite/tests/name_resolution/address_clause/subp.adb index 8a2ca313f..051e8f7d1 100644 --- a/testsuite/tests/name_resolution/address_clause/subp.adb +++ b/testsuite/tests/name_resolution/address_clause/subp.adb @@ -16,7 +16,10 @@ procedure Subp is for C'Address use X.A; pragma Test_Statement; begin - null; + if C'Code_Address /= C'Address then + raise; + end if; + pragma Test_Statement; end; end P; begin diff --git a/testsuite/tests/name_resolution/address_clause/test.out b/testsuite/tests/name_resolution/address_clause/test.out index 72c58d29c..55bc234eb 100644 --- a/testsuite/tests/name_resolution/address_clause/test.out +++ b/testsuite/tests/name_resolution/address_clause/test.out @@ -61,5 +61,40 @@ Expr: type: expected type: +Resolving xrefs for node +****************************************************** + +Expr: + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: + type: None + expected type: None +Expr: + references: None + type: None + expected type: None +Expr: + references: None + type: None + expected type: None +Expr: + references: None + type: + expected type: +Expr: + references: + type: None + expected type: None +Expr: + references: None + type: None + expected type: None + Done. From 17eb60a9c7d2207b44b02145d9ee8b5d56562372 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Laurent=20Th=C3=A9venoux?= Date: Tue, 30 Jul 2024 15:01:55 +0200 Subject: [PATCH 5/7] Add support for the Scale attribute --- ada/nodes.lkt | 5 ++++- .../name_resolution/unint_attrs/test.out | 22 ++++++++++++++++++- .../unint_attrs/test_unint_attrs.adb | 1 + 3 files changed, 26 insertions(+), 2 deletions(-) diff --git a/ada/nodes.lkt b/ada/nodes.lkt index b00f7e39c..dfd00e469 100644 --- a/ada/nodes.lkt +++ b/ada/nodes.lkt @@ -12783,7 +12783,10 @@ class AttributeRef: Name { # Attributes that simply return subprograms elif rel_name in s"Succ" | s"Pred" | s"Min" | s"Max" | s"Ceiling" | s"Floor" | s"Rounding" | s"Unbiased_Rounding" | s"Leading_Part" | s"Truncation" | s"Exponent" | s"Fraction" | s"Copy_Sign" | s"Remainder" | s"Adjacent" | s"Machine" | s"Machine_Rounding" | s"Scaling" | s"Compose" | s"Mod" | s"Value" | s"Wide_Value" | s"Wide_Wide_Value" | s"Fixed_Value" | s"Integer_Value" | s"Pos" | s"Val" | s"Enum_Val" | s"Write" | s"Read" | s"Output" | s"Input" | s"Put_Image" | s"Asm_Input" | s"Asm_Output" | s"Model" | s"Round" then self.attribute_subprogram_equation() elif rel_name in s"Size" | s"VADS_Size" then self.size_equation() - elif rel_name in s"Max_Size_In_Storage_Elements" | s"Aft" | s"Object_Size" | s"Value_Size" | s"Storage_Size" then self.subtype_attr_equation() + elif rel_name in s"Max_Size_In_Storage_Elements" + | s"Aft" | s"Object_Size" | s"Value_Size" | s"Storage_Size" + | s"Scale" + then self.subtype_attr_equation() elif rel_name in s"Access" | s"Unchecked_Access" | s"Unrestricted_Access" then self.access_equation() elif rel_name == s"Image" then self.image_equation(node.std_string_type()) elif rel_name == s"Wide_Image" then self.image_equation(node.std_wide_string_type()) diff --git a/testsuite/tests/name_resolution/unint_attrs/test.out b/testsuite/tests/name_resolution/unint_attrs/test.out index c94c02f1a..e3929a87f 100644 --- a/testsuite/tests/name_resolution/unint_attrs/test.out +++ b/testsuite/tests/name_resolution/unint_attrs/test.out @@ -545,7 +545,27 @@ Expr: type: None expected type: None -Resolving xrefs for node +Resolving xrefs for node +*************************************************************************** + +Expr: + references: + type: None + expected type: None +Expr: + references: None + type: + expected type: +Expr: + references: + type: None + expected type: None +Expr: + references: None + type: None + expected type: None + +Resolving xrefs for node ******************************************************************* diff --git a/testsuite/tests/name_resolution/unint_attrs/test_unint_attrs.adb b/testsuite/tests/name_resolution/unint_attrs/test_unint_attrs.adb index 612b8aec4..caeaf9fea 100644 --- a/testsuite/tests/name_resolution/unint_attrs/test_unint_attrs.adb +++ b/testsuite/tests/name_resolution/unint_attrs/test_unint_attrs.adb @@ -39,6 +39,7 @@ begin V : constant Natural := Standard'Storage_Unit; W : constant Natural := Standard'Wchar_T_Size; X : constant Natural := Natural'Stream_Size; + Y : constant Integer := Volt'Scale; begin null; end; From ba9d35846533fe7de62902ffa103a42e6391a1e0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Laurent=20Th=C3=A9venoux?= Date: Tue, 30 Jul 2024 15:08:45 +0200 Subject: [PATCH 6/7] Add support for the Max_Alignment_For_Allocation attribute --- ada/nodes.lkt | 2 +- .../tests/name_resolution/size_attrs/test.adb | 3 ++ .../tests/name_resolution/size_attrs/test.out | 34 +++++++++++++++---- 3 files changed, 31 insertions(+), 8 deletions(-) diff --git a/ada/nodes.lkt b/ada/nodes.lkt index dfd00e469..d8a2a1799 100644 --- a/ada/nodes.lkt +++ b/ada/nodes.lkt @@ -12783,7 +12783,7 @@ class AttributeRef: Name { # Attributes that simply return subprograms elif rel_name in s"Succ" | s"Pred" | s"Min" | s"Max" | s"Ceiling" | s"Floor" | s"Rounding" | s"Unbiased_Rounding" | s"Leading_Part" | s"Truncation" | s"Exponent" | s"Fraction" | s"Copy_Sign" | s"Remainder" | s"Adjacent" | s"Machine" | s"Machine_Rounding" | s"Scaling" | s"Compose" | s"Mod" | s"Value" | s"Wide_Value" | s"Wide_Wide_Value" | s"Fixed_Value" | s"Integer_Value" | s"Pos" | s"Val" | s"Enum_Val" | s"Write" | s"Read" | s"Output" | s"Input" | s"Put_Image" | s"Asm_Input" | s"Asm_Output" | s"Model" | s"Round" then self.attribute_subprogram_equation() elif rel_name in s"Size" | s"VADS_Size" then self.size_equation() - elif rel_name in s"Max_Size_In_Storage_Elements" + elif rel_name in s"Max_Size_In_Storage_Elements" | s"Max_Alignment_For_Allocation" | s"Aft" | s"Object_Size" | s"Value_Size" | s"Storage_Size" | s"Scale" then self.subtype_attr_equation() diff --git a/testsuite/tests/name_resolution/size_attrs/test.adb b/testsuite/tests/name_resolution/size_attrs/test.adb index 15492571f..428136fd1 100644 --- a/testsuite/tests/name_resolution/size_attrs/test.adb +++ b/testsuite/tests/name_resolution/size_attrs/test.adb @@ -23,6 +23,9 @@ begin I := R'Max_Size_In_Storage_Elements; pragma Test_Statement; + I := R'Max_Alignment_For_Allocation; + pragma Test_Statement; + I := R'VADS_Size; pragma Test_Statement; diff --git a/testsuite/tests/name_resolution/size_attrs/test.out b/testsuite/tests/name_resolution/size_attrs/test.out index 712c17d58..82b0ab8bb 100644 --- a/testsuite/tests/name_resolution/size_attrs/test.out +++ b/testsuite/tests/name_resolution/size_attrs/test.out @@ -101,14 +101,14 @@ Expr: type: None expected type: None -Resolving xrefs for node +Resolving xrefs for node ********************************************************* Expr: references: type: expected type: None -Expr: +Expr: references: None type: expected type: @@ -116,27 +116,47 @@ Expr: references: type: None expected type: None -Expr: +Expr: references: None type: None expected type: None -Resolving xrefs for node +Resolving xrefs for node ********************************************************* Expr: references: type: expected type: None -Expr: +Expr: references: None type: expected type: -Expr: +Expr: + references: + type: None + expected type: None +Expr: + references: None + type: None + expected type: None + +Resolving xrefs for node +********************************************************* + +Expr: + references: + type: + expected type: None +Expr: + references: None + type: + expected type: +Expr: references: type: None expected type: None -Expr: +Expr: references: None type: None expected type: None From e7ad5193ffe319d715f7d5b8e54eea0457f0bb72 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Laurent=20Th=C3=A9venoux?= Date: Tue, 30 Jul 2024 15:24:10 +0200 Subject: [PATCH 7/7] Add support for the Mechanism_Code attribute --- ada/nodes.lkt | 14 ++++ .../name_resolution/mechanism_code/test.adb | 12 +++ .../name_resolution/mechanism_code/test.out | 73 +++++++++++++++++++ .../name_resolution/mechanism_code/test.yaml | 2 + 4 files changed, 101 insertions(+) create mode 100644 testsuite/tests/name_resolution/mechanism_code/test.adb create mode 100644 testsuite/tests/name_resolution/mechanism_code/test.out create mode 100644 testsuite/tests/name_resolution/mechanism_code/test.yaml diff --git a/ada/nodes.lkt b/ada/nodes.lkt index d8a2a1799..d53107010 100644 --- a/ada/nodes.lkt +++ b/ada/nodes.lkt @@ -12838,6 +12838,7 @@ class AttributeRef: Name { elif rel_name == s"Abort_Signal" then %eq(node.ref_var(), node.std_entity(s"abort_signal_")) and %eq(node.type_var(), null[Entity[BaseTypeDecl]]) elif rel_name in s"Has_Same_Storage" | s"Overlaps_Storage" then self.storage_equation() elif rel_name == s"Deref" then self.deref_equation() + elif rel_name == s"Mechanism_Code" then self.mechanism_code_equation() else raise[Equation] PropertyError("Unhandled attribute") } @@ -13116,6 +13117,18 @@ class AttributeRef: Name { default_val=%false ) + |" Return the xref equation for the ``Mechanism_Code`` attribute. + @with_dynvars(env, origin, entry_point) + fun mechanism_code_equation(): Equation = + self.prefix.xref_no_overloading() + and self.universal_int_bind(node.type_var()) + and self.args?[0].do( + (arg) => arg.expr().sub_equation() + and self.universal_int_bind(arg.expr().expected_type_var()) + and arg.expr().matches_expected_type(), + default_val=%true + ) + |" Return the xref equation for the ``Has_Same_Storage`` and |" ``Overlaps_Storage`` attributes. @with_dynvars(env, origin, entry_point) @@ -15128,6 +15141,7 @@ class Identifier: BaseId implements TokenNode { fun is_attr_with_args(): Bool = node.symbol in s"First" | s"Last" | s"Range" | s"Length" | s"Has_Same_Storage" | s"Overlaps_Storage" | s"Deref" + | s"Mechanism_Code" @with_dynvars(origin) fun complete_items(): Array[CompletionItem] = self.parent.complete_items() diff --git a/testsuite/tests/name_resolution/mechanism_code/test.adb b/testsuite/tests/name_resolution/mechanism_code/test.adb new file mode 100644 index 000000000..ed22d2deb --- /dev/null +++ b/testsuite/tests/name_resolution/mechanism_code/test.adb @@ -0,0 +1,12 @@ +procedure Test is + procedure Pro (A, B, C : Integer) is null; + + I : Integer; +begin + I := Pro'Mechanism_Code; + pragma Test_Statement; + I := Pro'Mechanism_Code (1); + pragma Test_Statement; + I := Pro'Mechanism_Code (3); + pragma Test_Statement; +end; diff --git a/testsuite/tests/name_resolution/mechanism_code/test.out b/testsuite/tests/name_resolution/mechanism_code/test.out new file mode 100644 index 000000000..d585ee8e1 --- /dev/null +++ b/testsuite/tests/name_resolution/mechanism_code/test.out @@ -0,0 +1,73 @@ +Analyzing test.adb +################## + +Resolving xrefs for node +******************************************************* + +Expr: + references: + type: + expected type: None +Expr: + references: None + type: + expected type: +Expr: + references: + type: None + expected type: None +Expr: + references: None + type: None + expected type: None + +Resolving xrefs for node +******************************************************* + +Expr: + references: + type: + expected type: None +Expr: + references: None + type: + expected type: +Expr: + references: + type: None + expected type: None +Expr: + references: None + type: None + expected type: None +Expr: + references: None + type: + expected type: + +Resolving xrefs for node +********************************************************* + +Expr: + references: + type: + expected type: None +Expr: + references: None + type: + expected type: +Expr: + references: + type: None + expected type: None +Expr: + references: None + type: None + expected type: None +Expr: + references: None + type: + expected type: + + +Done. diff --git a/testsuite/tests/name_resolution/mechanism_code/test.yaml b/testsuite/tests/name_resolution/mechanism_code/test.yaml new file mode 100644 index 000000000..173e325ff --- /dev/null +++ b/testsuite/tests/name_resolution/mechanism_code/test.yaml @@ -0,0 +1,2 @@ +driver: name-resolution +input_sources: [test.adb]