From 7c53a488082585c7ca931487629bc84dc2c3b25a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Laurent=20Th=C3=A9venoux?= <thevenoux@adacore.com>
Date: Tue, 21 Nov 2023 17:21:56 +0100
Subject: [PATCH] Fix identity_type property to support ParamSpec

'Identity can be called on object referring to a ParamSpec.
---
 ada/ast.py                                    |  4 ++-
 .../name_resolution/identity_attr/test.adb    | 15 +++++++++-
 .../name_resolution/identity_attr/test.out    | 29 ++++++++++++++++++-
 3 files changed, 45 insertions(+), 3 deletions(-)

diff --git a/ada/ast.py b/ada/ast.py
index acec62067..fdadd3ba0 100644
--- a/ada/ast.py
+++ b/ada/ast.py
@@ -3024,8 +3024,10 @@ def identity_type():
             # An object decl on which you can call 'Identity implies that its
             # type is a task type.
             lambda _=T.ObjectDecl: Self.task_id_type,
-            # As well as for for loop variable declarations
+            # As well as for for loop variable declarations and parameter
+            # specifications.
             lambda _=T.ForLoopVarDecl: Self.task_id_type,
+            lambda _=T.BaseFormalParamDecl: Self.task_id_type,
             lambda _: No(T.BaseTypeDecl.entity)
         )
 
diff --git a/testsuite/tests/name_resolution/identity_attr/test.adb b/testsuite/tests/name_resolution/identity_attr/test.adb
index 793e86b4d..bf624bb2e 100644
--- a/testsuite/tests/name_resolution/identity_attr/test.adb
+++ b/testsuite/tests/name_resolution/identity_attr/test.adb
@@ -15,7 +15,7 @@ procedure Test is
    end TT;
 
    X : TT;
-   X_Array : array (1 .. 10) of T;
+   X_Array : array (1 .. 10) of TT;
 begin
    if T'Identity = X'Identity then
       null;
@@ -34,4 +34,17 @@ begin
       end if;
       pragma Test_Statement_UID;
    end loop;
+
+   --  Should also work on ParamSpec
+   declare
+      function F
+        (A_Task  : TT;
+         Compare : Ada.Task_Identification.Task_ID) return Boolean is
+      begin
+         return A_Task'Identity /= Compare;
+         pragma Test_Statement_UID;
+      end F;
+   begin
+      null;
+   end;
 end Test;
diff --git a/testsuite/tests/name_resolution/identity_attr/test.out b/testsuite/tests/name_resolution/identity_attr/test.out
index cb0382645..15ee11bd8 100644
--- a/testsuite/tests/name_resolution/identity_attr/test.out
+++ b/testsuite/tests/name_resolution/identity_attr/test.out
@@ -83,7 +83,7 @@ Expr: <AttributeRef test.adb:32:10-32:20>
   expected type: ada.task_identification.task_id
 Expr: <Id "I" test.adb:32:10-32:11>
   references:    test().i
-  type:          None
+  type:          test().tt
   expected type: None
 Expr: <Id "Identity" test.adb:32:12-32:20>
   references:    None
@@ -114,5 +114,32 @@ Expr: <Id "Current_Task" test.adb:32:47-32:59>
   type:          ada.task_identification.task_id
   expected type: ada.task_identification.task_id
 
+Resolving xrefs for node <ReturnStmt test.adb:44:10-44:44>
+**********************************************************
+
+Expr: <RelationOp test.adb:44:17-44:43>
+  type:          standard.boolean
+  expected type: standard.boolean
+Expr: <AttributeRef test.adb:44:17-44:32>
+  references:    None
+  type:          ada.task_identification.task_id
+  expected type: ada.task_identification.task_id
+Expr: <Id "A_Task" test.adb:44:17-44:23>
+  references:    test().f((test.tt, ada.task_identification.task_id) -> standard.boolean).a_task
+  type:          test().tt
+  expected type: None
+Expr: <Id "Identity" test.adb:44:24-44:32>
+  references:    None
+  type:          None
+  expected type: None
+Expr: <OpNeq "/=" test.adb:44:33-44:35>
+  references:    ada.task_identification."="((ada.task_identification.task_id, ada.task_identification.task_id) -> standard.boolean)
+  type:          None
+  expected type: None
+Expr: <Id "Compare" test.adb:44:36-44:43>
+  references:    test().f((test.tt, ada.task_identification.task_id) -> standard.boolean).compare
+  type:          ada.task_identification.task_id
+  expected type: ada.task_identification.task_id
+
 
 Done.