From 66e2a1eb69559f67dad1a7a1bfe6a6b8a4ba23fd Mon Sep 17 00:00:00 2001
From: Corentin Machu <machu@adacore.com>
Date: Thu, 12 Dec 2024 16:15:11 +0100
Subject: [PATCH] TGen: Add function to retrieve TC dump procedure names

---
 src/tgen/tgen-libgen.adb | 39 +++++++++++++++++++++++++++++++++++++++
 src/tgen/tgen-libgen.ads | 19 +++++++++++++++++++
 2 files changed, 58 insertions(+)

diff --git a/src/tgen/tgen-libgen.adb b/src/tgen/tgen-libgen.adb
index f087919a..4de1ff6d 100644
--- a/src/tgen/tgen-libgen.adb
+++ b/src/tgen/tgen-libgen.adb
@@ -25,6 +25,7 @@ with Ada.Characters.Handling;
 with Ada.Command_Line;
 with Ada.Containers;
 with Ada.Directories;
+with Ada.Strings.Unbounded.Equal_Case_Insensitive;
 with Ada.Text_IO; use Ada.Text_IO;
 
 with GNAT.OS_Lib;
@@ -1796,4 +1797,42 @@ package body TGen.Libgen is
       Put_Line (F_Type, "end " & Unit_Name & ";");
       Close (F_Type);
    end Create_Generic_Wrapper_Package_If_Not_Exists;
+
+   ---------------------------------------
+   -- Get_Test_Case_Dump_Procedure_Name --
+   ---------------------------------------
+
+   function Get_Test_Case_Dump_Procedure_Name
+      (Ctx              : Libgen_Context;
+       Parent_Pack_Name : TGen.Strings.Ada_Qualified_Name;
+       Subp_FQN         : Unbounded_String)
+   return Unbounded_String
+   is
+      Typ_Set_Cursor : constant Types_Per_Package_Maps.Cursor :=
+         Ctx.Generation_Map.Find
+            (Generation_Harness_Package (Parent_Pack_Name));
+      Is_Top_Level_Generic : constant Boolean :=
+         Ctx.Depends_On_Top_Level_Inst (Parent_Pack_Name);
+   begin
+      if not Typ_Set_Cursor.Has_Element then
+         raise Program_Error with "Sub program isn't present";
+      end if;
+
+      for Ty of Typ_Set_Cursor.Element loop
+         declare
+            Ty_FQN : constant Unbounded_String :=
+               To_Unbounded_String (Ty.Get.FQN
+                  (No_Std => True, Top_Level_Generic => Is_Top_Level_Generic));
+         begin
+            if Ada.Strings.Unbounded.Equal_Case_Insensitive (Ty_FQN, Subp_FQN)
+            then
+               return To_Unbounded_String
+                  (To_Symbol (Ty.Get.Name, Sep => '_') & "_Dump_TC");
+            end if;
+         end;
+      end loop;
+
+      return Ada.Strings.Unbounded.Null_Unbounded_String;
+   end Get_Test_Case_Dump_Procedure_Name;
+
 end TGen.Libgen;
diff --git a/src/tgen/tgen-libgen.ads b/src/tgen/tgen-libgen.ads
index faa539ec..20a992b6 100644
--- a/src/tgen/tgen-libgen.ads
+++ b/src/tgen/tgen-libgen.ads
@@ -210,6 +210,25 @@ package TGen.Libgen is
    --  `Pack_Name` being the wrapper fully qualified name and `Base_Name`
    --  the library level instantiation fully qualified name.
 
+   function Get_Test_Case_Dump_Procedure_Name
+      (Ctx              : Libgen_Context;
+       Parent_Pack_Name : TGen.Strings.Ada_Qualified_Name;
+       Subp_FQN         : Unbounded_String)
+   return Unbounded_String
+   with Pre => not Parent_Pack_Name.Is_Empty;
+   --  Returns an Unbounded_String corresponding to the procedure name used
+   --  to dump parameters for a given subprogram's fully qualified name. If no
+   --  test cases correspond to the given subprogram, this function returns
+   --  `Null_Unbounded_String`.
+   --
+   --  `Pack_Name` represents the subprogram's parent package name, and
+   --  `Subp_FQN` refers to the fully qualified name of the tested subprogram.
+   --
+   --  This function may raise a `Program_Error` if the requested subprogram is
+   --  not present in the TGen context. This typically occurs if the analysis
+   --  has not been performed yet, the requested subprogram does not exist, or
+   --  it is not supported for test case generation.
+
 private
    use TGen.Strings;
    use TGen.Context;