diff --git a/Makefile b/Makefile
index ad21034..f3892a7 100644
--- a/Makefile
+++ b/Makefile
@@ -36,7 +36,7 @@ clean-lib:
$(RM) -fr lib/aunit lib/aunit-obj
clean: clean-lib
- -${MAKE} -C docs clean
+ -${MAKE} -C doc clean
install-clean-legacy:
ifneq (,$(wildcard $(INSTALL)/lib/gnat/manifests/aunit))
diff --git a/include/aunit/reporters/full_runtime/aunit-reporter-trx.adb b/include/aunit/reporters/full_runtime/aunit-reporter-trx.adb
new file mode 100644
index 0000000..94705f8
--- /dev/null
+++ b/include/aunit/reporters/full_runtime/aunit-reporter-trx.adb
@@ -0,0 +1,321 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- A U N I T . R E P O R T E R . T R X --
+-- --
+-- B o d y --
+-- --
+-- --
+-- Copyright (C) 2000-2020, AdaCore --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- . --
+-- --
+-- GNAT is maintained by AdaCore (http://www.adacore.com) --
+-- --
+------------------------------------------------------------------------------
+
+with Ada.Calendar;
+with Ada.Text_IO;
+with Ada.Strings.Unbounded;
+with Ada.Containers.Vectors;
+with Ada_Containers;
+
+package body AUnit.Reporter.TRX is
+
+ procedure Put_Line (File : Ada.Text_IO.File_Type; S : String)
+ renames Ada.Text_IO.Put_Line;
+
+ package SU renames Ada.Strings.Unbounded;
+
+ type Test_Outcome is (Passed, Failed, Error);
+
+ function Outcome_Str (Outcome : Test_Outcome) return String is
+ begin
+ return (case Outcome is
+ when Passed => "Passed",
+ when Failed => "Failed",
+ when Error => "Failed");
+ end Outcome_Str;
+
+ type Test_Data is record
+ Name : SU.Unbounded_String;
+ Outcome : Test_Outcome;
+ Duration : SU.Unbounded_String;
+ Routine_Name : SU.Unbounded_String;
+ -- for assertion failures
+ Failure_Message : SU.Unbounded_String;
+ Failure_Source_Name : SU.Unbounded_String;
+ Line : SU.Unbounded_String;
+ -- for exceptions
+ Exception_Name : SU.Unbounded_String;
+ Exception_Message : SU.Unbounded_String;
+ Backtrace : SU.Unbounded_String;
+ end record;
+
+ function Get_Test_Data (Test : Test_Result) return Test_Data;
+
+ package Test_Data_Vecs is new Ada.Containers.Vectors
+ (Element_Type => Test_Data,
+ Index_Type => Positive);
+
+ procedure Iterate
+ (Container : Test_Data_Vecs.Vector;
+ Process : not null access procedure (Position : Test_Data_Vecs.Cursor))
+ renames Test_Data_Vecs.Iterate;
+
+ function Get_All_Results (R : Result'Class)
+ return Test_Data_Vecs.Vector is
+ All_Results : Test_Data_Vecs.Vector;
+ F, E, S : Result_Lists.List;
+
+ procedure Get_Result_List (L : Result_Lists.List) is
+ use Result_Lists;
+ C : Cursor := First (L);
+ begin
+ -- Note: can't use Iterate because it violates restriction
+ -- No_Implicit_Dynamic_Code
+ while Has_Element (C) loop
+ All_Results.Append (Get_Test_Data (Element (C)));
+ Next (C);
+ end loop;
+ end Get_Result_List;
+
+ begin
+ Failures (R, F);
+ Errors (R, E);
+ Successes (R, S);
+ Get_Result_List (F);
+ Get_Result_List (E);
+ Get_Result_List (S);
+ return All_Results;
+ end Get_All_Results;
+
+ procedure Report (Engine : TRX_Reporter;
+ R : in out Result'Class;
+ Options : AUnit_Options := Default_Options)
+ is
+ pragma Unreferenced (Options);
+
+ File : Ada.Text_IO.File_Type renames Engine.File.all;
+
+ use type Ada_Containers.Count_Type;
+ Total : constant Ada_Containers.Count_Type := Test_Count (R);
+ Failures : constant Ada_Containers.Count_Type := Failure_Count (R)
+ + Error_Count (R);
+ Successes : constant Ada_Containers.Count_Type := Total - Failures;
+
+ function Str(I : Ada_Containers.Count_Type) return String is
+ S : constant String := I'Image;
+ begin
+ return S(2..S'Last); -- remove leading space
+ end Str;
+
+ procedure Report_Test_Name (Test_Cursor : Test_Data_Vecs.Cursor) is
+ Test : constant Test_Data := Test_Data_Vecs.Element (Test_Cursor);
+ begin
+ Put_Line (File, " ");
+ end Report_Test_Name;
+
+ -- I found this example trx file
+ pragma Style_Checks ("M200"); -- Allow long lines
+ -- https://github.com/x97mdr/pickles/blob/master/src/Pickles/Pickles.Test/results-example-mstest.trx
+ pragma Style_Checks ("M79");
+ -- it says UnitTestResult can have StdOut (text) and ErrorInfo
+ -- containing Message and StackTrace
+ procedure Report_Test (Test_Cursor : Test_Data_Vecs.Cursor) is
+ Test : constant Test_Data := Test_Data_Vecs.Element (Test_Cursor);
+ begin
+ Put_Line (File, " ");
+ if Test.Outcome /= Passed then
+ Put_Line (File, " ");
+ end if;
+ Put_Line (File, " ");
+ end Report_Test;
+ begin -- Report
+ Put_Line (File, "");
+ Put_Line (File, "");
+ Put_Line (File, " ");
+ Put_Line (File, " ");
+ Put_Line (File, " ");
+
+ declare
+ Tests : constant Test_Data_Vecs.Vector := Get_All_Results (R);
+ begin
+ Put_Line (File, " ");
+ Iterate (Tests, Report_Test_Name'Access);
+ Put_Line (File, " ");
+
+ Put_Line (File, " ");
+ Iterate (Tests, Report_Test'Access);
+ Put_Line (File, " ");
+ end;
+
+ Put_Line (File, "");
+ end Report;
+
+ function Get_Name (Test : Test_Result) return SU.Unbounded_String is
+ begin
+ return SU.To_Unbounded_String (Test.Test_Name.all);
+ end Get_Name;
+
+ function Get_Outcome (Test : Test_Result) return Test_Outcome is
+ begin
+ if Test.Error /= null then
+ return Error;
+ end if;
+ if Test.Failure /= null then
+ return Failed;
+ end if;
+ return Passed;
+ end Get_Outcome;
+
+ function Get_Duration (Test : Test_Result) return SU.Unbounded_String is
+ use type Ada.Calendar.Time;
+ Elapsed_Seconds : Duration := Test.Elapsed.Stop - Test.Elapsed.Start;
+ H, M, S : Integer := 0;
+
+ -- pad integer with leading zero to width 2
+ function Str(I : Integer) return String is
+ S : constant String := I'Image;
+ S2 : String renames S(S'First + 1 .. S'Last);
+ begin
+ if I < 10 then
+ return "0" & S2;
+ else
+ return S2;
+ end if;
+ end Str;
+
+ function DecStr(D : Duration) return String is
+ S : constant String := D'Image;
+ begin
+ return S(S'First + 3 .. S'Last);
+ end DecStr;
+ begin
+ H := Integer (Elapsed_Seconds / 3600.0);
+ Elapsed_Seconds := Elapsed_Seconds - (H * 3600.0);
+ M := Integer (Elapsed_Seconds / 60.0);
+ Elapsed_Seconds := Elapsed_Seconds - (M * 60.0);
+ S := Integer (Elapsed_Seconds / 1.0);
+ Elapsed_Seconds := Elapsed_Seconds - (S * 1.0);
+ return SU.To_Unbounded_String (Str (H) & ":" & Str (M) & ":" & Str (S)
+ & "." & DecStr (Elapsed_Seconds));
+ end Get_Duration;
+
+ function Get_Routine_Name (Test : Test_Result) return SU.Unbounded_String is
+ begin
+ return (if Test.Routine_Name = null
+ then SU.To_Unbounded_String ("")
+ else SU.To_Unbounded_String (Test.Routine_Name.all));
+ end Get_Routine_Name;
+
+ function Get_Failure_Message (Test : Test_Result)
+ return SU.Unbounded_String is
+ begin
+ return (if Test.Failure = null
+ then SU.To_Unbounded_String ("")
+ else SU.To_Unbounded_String (Test.Failure.Message.all));
+ end Get_Failure_Message;
+
+ function Get_Failure_Source_Name (Test : Test_Result)
+ return SU.Unbounded_String is
+ begin
+ return (if Test.Failure = null
+ then SU.To_Unbounded_String ("")
+ else SU.To_Unbounded_String (Test.Failure.Source_Name.all));
+ end Get_Failure_Source_Name;
+
+ function Get_Line (Test : Test_Result) return SU.Unbounded_String is
+ begin
+ return (if Test.Failure = null
+ then SU.To_Unbounded_String ("")
+ else SU.To_Unbounded_String (Test.Failure.Line'Image));
+ end Get_Line;
+
+ function Get_Exception_Name (Test : Test_Result)
+ return SU.Unbounded_String is
+ begin
+ return (if Test.Error = null
+ then SU.To_Unbounded_String ("")
+ else SU.To_Unbounded_String (Test.Error.Exception_Name.all));
+ end Get_Exception_Name;
+
+ function Get_Exception_Message (Test : Test_Result)
+ return SU.Unbounded_String is
+ begin
+ return (if Test.Error = null then SU.To_Unbounded_String ("") else
+ (if Test.Error.Exception_message = null
+ then SU.To_Unbounded_String ("")
+ else
+ SU.To_Unbounded_String (Test.Error.Exception_Message.all)));
+ end Get_Exception_Message;
+
+ function Get_Backtrace (Test : Test_Result) return SU.Unbounded_String is
+ begin
+ return (if Test.Error = null then SU.To_Unbounded_String ("") else
+ (if Test.Error.Traceback = null
+ then SU.To_Unbounded_String ("")
+ else SU.To_Unbounded_String (Test.Error.Traceback.all)));
+ end Get_Backtrace;
+
+ function Get_Test_Data (Test : Test_Result) return Test_Data is
+ begin
+ return (Name => Get_Name (Test),
+ Outcome => Get_Outcome (Test),
+ Duration => Get_Duration (Test),
+ Routine_Name => Get_Routine_Name (Test),
+ Failure_Message => Get_Failure_Message (Test),
+ Failure_Source_Name => Get_Failure_Source_Name (Test),
+ Line => Get_Line (Test),
+ Exception_Name => Get_Exception_Name (Test),
+ Exception_Message => Get_Exception_Message (Test),
+ Backtrace => Get_Backtrace (Test)
+ );
+ end Get_Test_Data;
+
+end AUnit.Reporter.TRX;
diff --git a/include/aunit/reporters/full_runtime/aunit-reporter-trx.ads b/include/aunit/reporters/full_runtime/aunit-reporter-trx.ads
new file mode 100644
index 0000000..9322eff
--- /dev/null
+++ b/include/aunit/reporters/full_runtime/aunit-reporter-trx.ads
@@ -0,0 +1,42 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- A U N I T . R E P O R T E R . T R X --
+-- --
+-- S p e c --
+-- --
+-- --
+-- Copyright (C) 2000-2020, AdaCore --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- . --
+-- --
+-- GNAT is maintained by AdaCore (http://www.adacore.com) --
+-- --
+------------------------------------------------------------------------------
+
+package AUnit.Reporter.TRX is
+
+ type TRX_Reporter is new AUnit.Reporter.Reporter with null record;
+
+ overriding
+ procedure Report
+ (Engine : TRX_Reporter;
+ R : in out Result'Class;
+ Options : AUnit_Options := Default_Options);
+
+end AUnit.Reporter.TRX;
diff --git a/lib/gnat/aunit.gpr b/lib/gnat/aunit.gpr
index d07f63d..cb0fb48 100644
--- a/lib/gnat/aunit.gpr
+++ b/lib/gnat/aunit.gpr
@@ -6,14 +6,23 @@ project AUnit is
type Compilation_Mode_Type is ("Devel", "Install");
Mode : Compilation_Mode_Type := external ("AUNIT_BUILD_MODE", "Install");
+ Reporters := ("../../include/aunit/reporters");
+
+ case AUnit_Shared.Runtime is
+ when "full" =>
+ Reporters := Reporters & ("../../include/aunit/reporters/full_runtime");
+ when others =>
+ null;
+ end case;
+
for Source_Dirs use
("../../include/aunit/framework",
"../../include/aunit/containers",
- "../../include/aunit/reporters",
"../../include/aunit/framework/" & AUnit_Shared.Except,
"../../include/aunit/framework/" & AUnit_Shared.Calend,
"../../include/aunit/framework/" & AUnit_Shared.Memory,
- "../../include/aunit/framework/" & AUnit_Shared.FileIO);
+ "../../include/aunit/framework/" & AUnit_Shared.FileIO)
+ & Reporters;
for Library_Dir use AUnit_Shared.Library_Dir;