Skip to content

Commit

Permalink
Merge branch 'topic/machu/228-retrieve-parameters-dump-procedure-name…
Browse files Browse the repository at this point in the history
…' into 'master'

Retrieve parameters dump procedure name

Closes #228

See merge request eng/ide/libadalang-tools!275
  • Loading branch information
Volham22 committed Dec 13, 2024
2 parents bb5f2d6 + 66e2a1e commit a5042af
Show file tree
Hide file tree
Showing 2 changed files with 58 additions and 0 deletions.
39 changes: 39 additions & 0 deletions src/tgen/tgen-libgen.adb
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand Down Expand Up @@ -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;
19 changes: 19 additions & 0 deletions src/tgen/tgen-libgen.ads
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand Down

0 comments on commit a5042af

Please sign in to comment.