From 1b2434df477be4e0b8f5f59c7e8c163fdadb5ec8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Laurent=20Th=C3=A9venoux?= <thevenoux@adacore.com>
Date: Fri, 14 Jun 2024 15:06:58 +0200
Subject: [PATCH] Do not memoize Name.name_designated_type_env

---
 ada/ast.py                                    |  6 ++-
 .../use_clause_in_instantiation/test.adb      | 21 +++++++++
 .../use_clause_in_instantiation/test.out      | 43 +++++++++++++++++++
 .../use_clause_in_instantiation/test.yaml     |  3 ++
 4 files changed, 72 insertions(+), 1 deletion(-)
 create mode 100644 testsuite/tests/name_resolution/use_clause_in_instantiation/test.adb
 create mode 100644 testsuite/tests/name_resolution/use_clause_in_instantiation/test.out
 create mode 100644 testsuite/tests/name_resolution/use_clause_in_instantiation/test.yaml

diff --git a/ada/ast.py b/ada/ast.py
index 93a7a5a61..9c8239374 100644
--- a/ada/ast.py
+++ b/ada/ast.py
@@ -16158,7 +16158,11 @@ def is_static_subtype():
         """
         return Entity.name_designated_type.is_static_decl
 
-    @langkit_property(memoized=True)
+    # ATTENTION: As for Name.use_package_name_designated_env this property must
+    # not be memoized because of an unsoundness issue between infinite
+    # recursion guards in lexical envs and memoized properties. See
+    # libadalang#1307.
+    @langkit_property(memoized=False)
     def name_designated_type_env():
         return Entity.name_designated_type._.primitives_env
 
diff --git a/testsuite/tests/name_resolution/use_clause_in_instantiation/test.adb b/testsuite/tests/name_resolution/use_clause_in_instantiation/test.adb
new file mode 100644
index 000000000..20d2ed3cf
--- /dev/null
+++ b/testsuite/tests/name_resolution/use_clause_in_instantiation/test.adb
@@ -0,0 +1,21 @@
+procedure Test is
+   generic package GP is
+      generic function GF return Boolean;
+   private
+      -- The following use clause was known to raise an infinite recursion in
+      -- Name.name_designated_type_env because of an unsoundness issue between
+      -- infinite recursion guards in lexical envs and memoized properties.
+
+      use type Integer;
+   end GP;
+
+   package body GP is
+      function GF return Boolean is (True);
+   end GP;
+
+   package P is new GP;
+   function F is new P.GF;
+   pragma Test_Statement;
+begin
+   null;
+end Test;
diff --git a/testsuite/tests/name_resolution/use_clause_in_instantiation/test.out b/testsuite/tests/name_resolution/use_clause_in_instantiation/test.out
new file mode 100644
index 000000000..102024ee2
--- /dev/null
+++ b/testsuite/tests/name_resolution/use_clause_in_instantiation/test.out
@@ -0,0 +1,43 @@
+Analyzing test.adb
+##################
+
+Resolving xrefs for node <GenericSubpInstantiation ["F"] test.adb:17:4-17:27>
+*****************************************************************************
+
+Expr: <DottedName test.adb:17:22-17:26>
+  references:    <| DefiningName "GF" test.adb:3:24-3:26 [test.adb:16:4] |>
+  type:          None
+  expected type: None
+Expr: <Id "P" test.adb:17:22-17:23>
+  references:    <DefiningName "P" test.adb:16:12-16:13>
+  type:          None
+  expected type: None
+Expr: <Id "GF" test.adb:17:24-17:26>
+  references:    <| DefiningName "GF" test.adb:3:24-3:26 [test.adb:16:4] |>
+  type:          None
+  expected type: None
+Traversing generic node <| GenericSubpDecl ["GF"] test.adb:3:7-3:42 [test.adb:16:4, test.adb:17:4] |>
+*****************************************************************************************************
+
+Resolving xrefs for node <| SubpSpec test.adb:3:15-3:41 [test.adb:16:4, test.adb:17:4] |>
+*****************************************************************************************
+
+Expr: <| Id "Boolean" test.adb:3:34-3:41 [test.adb:16:4, test.adb:17:4] |>
+  references:    <DefiningName "Boolean" __standard:3:8-3:15>
+  type:          None
+  expected type: None
+
+Traversing generic node <| ExprFunction ["GF"] test.adb:13:7-13:44 [test.adb:16:4, test.adb:17:4] |>
+****************************************************************************************************
+
+Resolving xrefs for node <| SubpSpec test.adb:13:7-13:33 [test.adb:16:4, test.adb:17:4] |>
+******************************************************************************************
+
+Expr: <| Id "Boolean" test.adb:13:26-13:33 [test.adb:16:4, test.adb:17:4] |>
+  references:    <DefiningName "Boolean" __standard:3:8-3:15>
+  type:          None
+  expected type: None
+
+
+
+Done.
diff --git a/testsuite/tests/name_resolution/use_clause_in_instantiation/test.yaml b/testsuite/tests/name_resolution/use_clause_in_instantiation/test.yaml
new file mode 100644
index 000000000..6c2fc1a63
--- /dev/null
+++ b/testsuite/tests/name_resolution/use_clause_in_instantiation/test.yaml
@@ -0,0 +1,3 @@
+driver: name-resolution
+input_sources: [test.adb]
+traverse_generics: true