From 68e26900f87051b6930b9f67ab239316d88f1502 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Laurent=20Th=C3=A9venoux?= <thevenoux@adacore.com>
Date: Wed, 12 Apr 2023 17:40:20 +0200
Subject: [PATCH] nameres: fix record assoc expression matching type predicate

When building record assoc expression equation, the predicate used to
check that expected_type matches the expression type should use the
predicate that consider that assoc expression is a for-assignment
match.
---
 ada/ast.py                                    |  2 +-
 .../anonymous_type_match/test.adb             | 23 +++++++++++++
 .../anonymous_type_match/test.out             | 32 +++++++++++++++++++
 .../anonymous_type_match/test.yaml            |  2 ++
 4 files changed, 58 insertions(+), 1 deletion(-)
 create mode 100644 testsuite/tests/name_resolution/anonymous_type_match/test.adb
 create mode 100644 testsuite/tests/name_resolution/anonymous_type_match/test.out
 create mode 100644 testsuite/tests/name_resolution/anonymous_type_match/test.yaml

diff --git a/ada/ast.py b/ada/ast.py
index d0be091b5..ea0520acc 100644
--- a/ada/ast.py
+++ b/ada/ast.py
@@ -15453,7 +15453,7 @@ def record_assoc_equation():
                     match.formal.formal_decl.type_expression.designated_type
                 ),
                 match.actual.assoc.expr.sub_equation,
-                match.actual.assoc.expr.matches_expected_type,
+                match.actual.assoc.expr.matches_expected_assign_type,
                 match.actual.name.then(
                     lambda n: Bind(n.ref_var, match.formal.formal_decl),
                     LogicTrue()
diff --git a/testsuite/tests/name_resolution/anonymous_type_match/test.adb b/testsuite/tests/name_resolution/anonymous_type_match/test.adb
new file mode 100644
index 000000000..3f05220fc
--- /dev/null
+++ b/testsuite/tests/name_resolution/anonymous_type_match/test.adb
@@ -0,0 +1,23 @@
+procedure Test is
+   type Obj is tagged null record;
+
+   type T is record
+      Class : access Obj'Class;
+   end record;
+
+   type Obj2 is new Obj with record
+      I : Integer;
+   end record;
+
+   procedure P (Prm : access Obj2);
+
+   procedure P (Prm : access Obj2) is
+       E : T := T'(Class => Prm);
+       pragma Test_Statement;
+   begin
+      null;
+   end P;
+
+begin
+   null;
+end Test;
diff --git a/testsuite/tests/name_resolution/anonymous_type_match/test.out b/testsuite/tests/name_resolution/anonymous_type_match/test.out
new file mode 100644
index 000000000..db5bc5bce
--- /dev/null
+++ b/testsuite/tests/name_resolution/anonymous_type_match/test.out
@@ -0,0 +1,32 @@
+Analyzing test.adb
+##################
+
+Resolving xrefs for node <ObjectDecl ["E"] test.adb:15:8-15:34>
+***************************************************************
+
+Expr: <Id "T" test.adb:15:12-15:13>
+  references:    <DefiningName "T" test.adb:4:9-4:10>
+  type:          None
+  expected type: None
+Expr: <QualExpr test.adb:15:17-15:33>
+  references:    <DefiningName "T" test.adb:4:9-4:10>
+  type:          <ConcreteTypeDecl ["T"] test.adb:4:4-6:15>
+  expected type: <ConcreteTypeDecl ["T"] test.adb:4:4-6:15>
+Expr: <Id "T" test.adb:15:17-15:18>
+  references:    <DefiningName "T" test.adb:4:9-4:10>
+  type:          None
+  expected type: None
+Expr: <Aggregate test.adb:15:19-15:33>
+  type:          <ConcreteTypeDecl ["T"] test.adb:4:4-6:15>
+  expected type: <ConcreteTypeDecl ["T"] test.adb:4:4-6:15>
+Expr: <Id "Class" test.adb:15:20-15:25>
+  references:    <DefiningName "Class" test.adb:5:7-5:12>
+  type:          None
+  expected type: None
+Expr: <Id "Prm" test.adb:15:29-15:32>
+  references:    <DefiningName "Prm" test.adb:14:17-14:20>
+  type:          <AnonymousTypeDecl ["None"] test.adb:14:23-14:34>
+  expected type: <AnonymousTypeDecl ["None"] test.adb:5:15-5:31>
+
+
+Done.
diff --git a/testsuite/tests/name_resolution/anonymous_type_match/test.yaml b/testsuite/tests/name_resolution/anonymous_type_match/test.yaml
new file mode 100644
index 000000000..173e325ff
--- /dev/null
+++ b/testsuite/tests/name_resolution/anonymous_type_match/test.yaml
@@ -0,0 +1,2 @@
+driver: name-resolution
+input_sources: [test.adb]