From 8afa23457e1400bbaa9c5a78415014d0fc7a8183 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Laurent=20Th=C3=A9venoux?= <thevenoux@adacore.com>
Date: Tue, 16 Jul 2024 15:18:24 +0200
Subject: [PATCH] Add user-defined indexing support for ClasswideTypeDecl

---
 ada/nodes.lkt                                 |  8 +++++
 .../name_resolution/ud_indexing_7/test.adb    | 35 +++++++++++++++++++
 .../name_resolution/ud_indexing_7/test.out    | 25 +++++++++++++
 .../name_resolution/ud_indexing_7/test.yaml   |  2 ++
 4 files changed, 70 insertions(+)
 create mode 100644 testsuite/tests/name_resolution/ud_indexing_7/test.adb
 create mode 100644 testsuite/tests/name_resolution/ud_indexing_7/test.out
 create mode 100644 testsuite/tests/name_resolution/ud_indexing_7/test.yaml

diff --git a/ada/nodes.lkt b/ada/nodes.lkt
index fda7b05ce..7243fa3f4 100644
--- a/ada/nodes.lkt
+++ b/ada/nodes.lkt
@@ -6571,6 +6571,14 @@ class ClasswideTypeDecl: BaseTypeDecl {
     @with_dynvars(origin)
     fun is_iterable_type(): Bool = self.type_decl().is_iterable_type()
 
+    fun has_ud_indexing(): Bool = self.type_decl.has_ud_indexing
+
+    fun constant_indexing_fns(): Array[Entity[BasicDecl]] =
+        self.type_decl.constant_indexing_fns
+
+    fun variable_indexing_fns(): Array[Entity[BasicDecl]] =
+        self.type_decl.variable_indexing_fns
+
     fun is_task_type(): Bool = self.type_decl().is_task_type()
 
     @with_dynvars(origin)
diff --git a/testsuite/tests/name_resolution/ud_indexing_7/test.adb b/testsuite/tests/name_resolution/ud_indexing_7/test.adb
new file mode 100644
index 000000000..0abcf3783
--- /dev/null
+++ b/testsuite/tests/name_resolution/ud_indexing_7/test.adb
@@ -0,0 +1,35 @@
+procedure Test is
+   package String_Vector is
+      type Virtual_String_Vector is tagged private with
+         Constant_Indexing => Element;
+
+      function Element
+        (Self  : Virtual_String_Vector'Class;
+         Index : Positive) return Character;
+   private
+      type Virtual_String_Vector is tagged record
+         Data : Character;
+      end record;
+   end String_Vector;
+
+   package body String_Vector is
+      function Element
+        (Self  : Virtual_String_Vector'Class;
+         Index : Positive) return Character is
+      begin
+         return 'x';
+      end;
+   end String_Vector;
+
+   use String_Vector;
+
+
+   procedure P (X : Virtual_String_Vector'Class) is
+      C : Character;
+   begin
+      C := X (1);
+      pragma Test_Statement;
+   end P;
+begin
+   null;
+end;
diff --git a/testsuite/tests/name_resolution/ud_indexing_7/test.out b/testsuite/tests/name_resolution/ud_indexing_7/test.out
new file mode 100644
index 000000000..3344f3f5c
--- /dev/null
+++ b/testsuite/tests/name_resolution/ud_indexing_7/test.out
@@ -0,0 +1,25 @@
+Analyzing test.adb
+##################
+
+Resolving xrefs for node <AssignStmt test.adb:30:7-30:18>
+*********************************************************
+
+Expr: <Id "C" test.adb:30:7-30:8>
+  references:    <DefiningName "C" test.adb:28:7-28:8>
+  type:          <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>
+  expected type: None
+Expr: <CallExpr test.adb:30:12-30:17>
+  references:    <DefiningName "X" test.adb:27:17-27:18>
+  type:          <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>
+  expected type: <ConcreteTypeDecl ["Character"] __standard:21:3-21:27>
+Expr: <Id "X" test.adb:30:12-30:13>
+  references:    <DefiningName "X" test.adb:27:17-27:18>
+  type:          <ClasswideTypeDecl ["Virtual_String_Vector"] test.adb:3:7-4:39>
+  expected type: None
+Expr: <Int test.adb:30:15-30:16>
+  references:    None
+  type:          <ConcreteTypeDecl ["Universal_Int_Type_"] __standard:116:3-116:45>
+  expected type: <SubtypeDecl ["Positive"] __standard:6:3-6:57>
+
+
+Done.
diff --git a/testsuite/tests/name_resolution/ud_indexing_7/test.yaml b/testsuite/tests/name_resolution/ud_indexing_7/test.yaml
new file mode 100644
index 000000000..173e325ff
--- /dev/null
+++ b/testsuite/tests/name_resolution/ud_indexing_7/test.yaml
@@ -0,0 +1,2 @@
+driver: name-resolution
+input_sources: [test.adb]