From e7ad5193ffe319d715f7d5b8e54eea0457f0bb72 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Laurent=20Th=C3=A9venoux?= <thevenoux@adacore.com>
Date: Tue, 30 Jul 2024 15:24:10 +0200
Subject: [PATCH] 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 <AssignStmt test.adb:6:4-6:28>
+*******************************************************
+
+Expr: <Id "I" test.adb:6:4-6:5>
+  references:    <DefiningName "I" test.adb:4:4-4:5>
+  type:          <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+  expected type: None
+Expr: <AttributeRef test.adb:6:9-6:27>
+  references:    None
+  type:          <ConcreteTypeDecl ["Universal_Int_Type_"] __standard:116:3-116:45>
+  expected type: <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+Expr: <Id "Pro" test.adb:6:9-6:12>
+  references:    <DefiningName "Pro" test.adb:2:14-2:17>
+  type:          None
+  expected type: None
+Expr: <Id "Mechanism_Code" test.adb:6:13-6:27>
+  references:    None
+  type:          None
+  expected type: None
+
+Resolving xrefs for node <AssignStmt test.adb:8:4-8:32>
+*******************************************************
+
+Expr: <Id "I" test.adb:8:4-8:5>
+  references:    <DefiningName "I" test.adb:4:4-4:5>
+  type:          <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+  expected type: None
+Expr: <AttributeRef test.adb:8:9-8:31>
+  references:    None
+  type:          <ConcreteTypeDecl ["Universal_Int_Type_"] __standard:116:3-116:45>
+  expected type: <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+Expr: <Id "Pro" test.adb:8:9-8:12>
+  references:    <DefiningName "Pro" test.adb:2:14-2:17>
+  type:          None
+  expected type: None
+Expr: <Id "Mechanism_Code" test.adb:8:13-8:27>
+  references:    None
+  type:          None
+  expected type: None
+Expr: <Int test.adb:8:29-8:30>
+  references:    None
+  type:          <ConcreteTypeDecl ["Universal_Int_Type_"] __standard:116:3-116:45>
+  expected type: <ConcreteTypeDecl ["Universal_Int_Type_"] __standard:116:3-116:45>
+
+Resolving xrefs for node <AssignStmt test.adb:10:4-10:32>
+*********************************************************
+
+Expr: <Id "I" test.adb:10:4-10:5>
+  references:    <DefiningName "I" test.adb:4:4-4:5>
+  type:          <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+  expected type: None
+Expr: <AttributeRef test.adb:10:9-10:31>
+  references:    None
+  type:          <ConcreteTypeDecl ["Universal_Int_Type_"] __standard:116:3-116:45>
+  expected type: <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
+Expr: <Id "Pro" test.adb:10:9-10:12>
+  references:    <DefiningName "Pro" test.adb:2:14-2:17>
+  type:          None
+  expected type: None
+Expr: <Id "Mechanism_Code" test.adb:10:13-10:27>
+  references:    None
+  type:          None
+  expected type: None
+Expr: <Int test.adb:10:29-10:30>
+  references:    None
+  type:          <ConcreteTypeDecl ["Universal_Int_Type_"] __standard:116:3-116:45>
+  expected type: <ConcreteTypeDecl ["Universal_Int_Type_"] __standard:116:3-116:45>
+
+
+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]