Merge branch 'topic/210-subp-name' into 'master'

Test: Add option to display the tested subprogram in the test runner log

Closes #210

See merge request eng/ide/libadalang-tools!306

Author: leocreuse

src/test-actions.adb

@@ -577,6 +577,7 @@ package body Test.Actions is
       Test.Common.Show_Test_Duration := Arg (Cmd, Test_Duration);
       Test.Common.Relocatable_Harness := Arg (Cmd, Relocatable_Harness);
       Test.Common.Test_Filtering := Arg (Cmd, Test_Filtering);
+      Test.Common.Include_Subp_Name := Arg (Cmd, Include_Subp_Name);
 
       Test.Common.Strict_Execution := Arg (Cmd, Strict)
         or else (Ada.Environment_Variables.Exists ("GNATTEST_STRICT")
@@ -1321,6 +1322,7 @@ package body Test.Actions is
       Put (" --exit-status=(on|off)             - Default usage of the exit status\n");
       Put (" --omit-sloc                        - Don't record subprogram sloc in test package\n");
       Put (" --no-command-line                  - Don't add command line support to test driver\n");
+      Put (" --include-subp-name                - Include the tested subprogram's name in the output\n");
       Put (" --test-duration                    - Show timing for each test\n");
       Put (" --test-filtering                   - Add test filtering option to generated driver\n");
       Put (" --no-test-filtering                - Suppress test filtering in generated driver\n");

src/test-command_lines.ads

@@ -53,7 +53,8 @@ package Test.Command_Lines is
       Dump_Test_Inputs,
       Unparse,
       Enum_Strat,
-      Minimize);
+      Minimize,
+      Include_Subp_Name);
 
    package Test_Boolean_Switches is new Boolean_Switches
      (Descriptor,

src/test-common.ads

@@ -120,6 +120,10 @@ package Test.Common is
    --  if Subp is a subprigram declaration it will return subprogram's name;
    --  if Subp is an overloaded operator - it's text name
 
+   function Get_Subp_FQN (Node : Basic_Decl'Class) return String is
+    (Image (Node.As_Basic_Decl.P_Fully_Qualified_Name));
+   --  Return the fully qualified name of Node
+
    function Enclosing_Unit_Name (Node : Ada_Node'Class) return String is
       (Node_Image (P_Top_Level_Decl (Node, Node.Unit).P_Defining_Name));
    --  Returns name of the compilation unit enclosing given node
@@ -325,6 +329,10 @@ package Test.Common is
 
    Reporter_Name : GNAT.OS_Lib.String_Access := new String'("gnattest");
 
+   Include_Subp_Name : Boolean := False;
+   --  Whether the AUnit testcases' names should include the name of the
+   --  subprogram. Default is False for backwards compatibility reasons.
+
    No_Command_Line : Boolean := False;
 
    Harness_Only : Boolean := False;

src/test-skeleton.adb

@@ -536,6 +536,12 @@ package body Test.Skeleton is
    --  Returns the list of possible setters for all subprograms called from
    --  the body of given subprogram.
 
+   function Get_TR_Name_Suffix (Subp : Basic_Decl'Class) return String is
+     (if Include_Subp_Name then " (" & Get_Subp_FQN (Subp) & ")" else "");
+   --  Return the string that either contains the name of the tested subprogram
+   --  in Subp in parenthesis, or the empty string, based on whether
+   --  --include-subp-name was passed on the command line.
+
    ---------
    -- "<" --
    ---------
@@ -1553,6 +1559,7 @@ package body Test.Skeleton is
                   & Trim (Subp_Span.Start_Line'Img, Both)
                   & ":"
                   & Trim (Subp_Span.Start_Column'Img, Both)
+                  & Get_TR_Name_Suffix (Subp.Subp_Declaration.As_Basic_Decl)
                   & " instance at "
                   & Instance_Sloc.all);
             else
@@ -1562,6 +1569,7 @@ package body Test.Skeleton is
                   & Trim (Subp_Span.Start_Line'Img, Both)
                   & ":"
                   & Trim (Subp_Span.Start_Column'Img, Both)
+                  & Get_TR_Name_Suffix (Subp.Subp_Declaration.As_Basic_Decl)
                   & ":");
             end if;
          end;
@@ -2049,6 +2057,7 @@ package body Test.Skeleton is
                               & ":"
                               & Trim
                                 (First_Column_Number (ISub)'Img, Both)
+                              & Get_TR_Name_Suffix (ISub)
                               & ": inherited at "
                               & Base_Name (Type_Dec.Unit.Get_Filename)
                               & ":"
@@ -2200,6 +2209,7 @@ package body Test.Skeleton is
                      & Trim
                        (First_Column_Number (OSub)'Img,
                         Both)
+                     & Get_TR_Name_Suffix (OSub)
                      & ": overridden at "
                      & Base_Name
                        (TR_W.Original_Type.Unit.Get_Filename)
@@ -3595,6 +3605,7 @@ package body Test.Skeleton is
                & Trim (First_Line_Number (TC.Elem)'Img, Both)
                & ":"
                & Trim (First_Column_Number (TC.Elem)'Img, Both)
+               & (if Include_Subp_Name then " (" & TC.Name.all & ")" else "")
                & ":");
          else
             TR_Info_Add.TR_Info.Tested_Sloc := new String'
@@ -3603,6 +3614,7 @@ package body Test.Skeleton is
                & Trim (First_Line_Number (TC.Elem)'Img, Both)
                & ":"
                & Trim (First_Column_Number (TC.Elem)'Img, Both)
+               & (if Include_Subp_Name then " (" & TC.Name.all & ")" else "")
                & " instance at "
                & Instance_Sloc);
          end if;

testsuite/tests/test/210-runner-subp-name/gen.adb

@@ -0,0 +1,8 @@
+package body Gen is
+
+   procedure Gen (X : T) is
+   begin
+      null;
+   end Gen;
+
+end Gen;

testsuite/tests/test/210-runner-subp-name/gen.ads

@@ -0,0 +1,5 @@
+generic
+   type T is private;
+package Gen is
+   procedure Gen (X : T);
+end Gen;

testsuite/tests/test/210-runner-subp-name/pkg.adb

@@ -0,0 +1,11 @@
+package body Pkg is
+
+   procedure Simple (X : Integer) is null;
+   procedure With_TC (X : Integer) is null;
+
+   procedure Inherited_Prim (X : Pkg_T) is null;
+   procedure Overridden_Prim (X : Pkg_T) is null;
+
+   procedure Generic_Proc (X : T) is null;
+
+end Pkg;

testsuite/tests/test/210-runner-subp-name/pkg.ads

@@ -0,0 +1,15 @@
+package Pkg is
+
+   procedure Simple (X : Integer);
+   procedure With_TC (X : Integer);
+
+   type Pkg_T is tagged null record;
+
+   procedure Inherited_Prim (X : Pkg_T);
+   procedure Overridden_Prim (X : Pkg_T);
+
+   generic
+      type T is private;
+   procedure Generic_Proc (X : T);
+
+end Pkg;

testsuite/tests/test/210-runner-subp-name/prj.gpr

@@ -0,0 +1,5 @@
+project Prj is
+
+   for Object_Dir use "obj";
+
+end Prj;

testsuite/tests/test/210-runner-subp-name/test.out

@@ -0,0 +1,9 @@
+pkg.ads:8:4 (Pkg.Inherited_Prim): info: corresponding test PASSED
+pkg.ads:9:4 (Pkg.Overridden_Prim): info: corresponding test PASSED
+pkg.ads:3:4 (Pkg.Simple): info: corresponding test PASSED
+pkg.ads:4:4 (Pkg.With_TC): info: corresponding test PASSED
+gen.ads:4:4 (Gen.Gen) instance at user.ads:11:4: info: corresponding test PASSED
+user.ads:7:4 (User.Overridden_Prim): info: corresponding test PASSED
+pkg.ads:8:4 (Pkg.Inherited_Prim): inherited at user.ads:6:4: info: corresponding test PASSED
+pkg.ads:9:4 (Pkg.Overridden_Prim): overridden at user.ads:7:4: info: corresponding test PASSED
+8 tests run: 8 passed; 0 failed; 0 crashed.