/usr/share/ada/adainclude/aunit/aunit-test_results-text_reporter.adb is in libaunit2-dev 1.03-7.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 | ------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- A U N I T . T E S T _ R E S U L T S . T E X T _ R E P O R T E R --
-- --
-- B o d y --
-- --
-- $Revision: 1.5 $
-- --
-- Copyright (C) 2000-2001 Ada Core Technologies, Inc. --
-- --
-- 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 2, 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. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Exceptions; use Ada.Exceptions;
with Ada.Unchecked_Deallocation;
with AUnit.Options; use AUnit.Options;
-- Very simple reporter to console
package body AUnit.Test_Results.Text_Reporter is
procedure Deallocate_Success_List (L : in out Success_Lists.List);
procedure Destroy is new Ada.Unchecked_Deallocation (String, String_Access);
-- Report the contents of an error or failure list
procedure Dump_Failure_List
(L : in out Failure_Lists.List; Is_Assertion : Boolean := True);
-- List successful tests
procedure Dump_Success_List
(L : in out Success_Lists.List; Is_Assertion : Boolean := True);
-- Report the contents of an error or failure list
procedure Dump_Failure_List
(L : in out Failure_Lists.List; Is_Assertion : Boolean := True) is
Err_Rec : Test_Failure;
use Failure_Lists;
begin
Start (L);
while not Off (L) loop
Err_Rec := Item (L);
Put_Line
(" " & Err_Rec.Test_Name.all
& ": " & ASCII.LF &
" " & Err_Rec.Routine_Name.all & ": ");
if not Is_Assertion then
Put_Line (" " & "**" & Exception_Name (Err_Rec.E.all)
& "** : ");
Put (" ");
end if;
Put_Line (" " & Exception_Message (Err_Rec.E.all));
New_Line;
Destroy (Err_Rec.Routine_Name);
Destroy (Err_Rec.Test_Name);
Remove (L);
end loop;
end Dump_Failure_List;
-- List successful tests
procedure Dump_Success_List
(L : in out Success_Lists.List; Is_Assertion : Boolean := True) is
Rec : Test_Success;
use Success_Lists;
begin
Start (L);
while not Off (L) loop
Rec := Item (L);
Put_Line
(" " & Rec.Test_Name.all
& ": " & Rec.Routine_Name.all);
Destroy (Rec.Routine_Name);
Destroy (Rec.Test_Name);
Remove (L);
end loop;
end Dump_Success_List;
procedure Deallocate_Success_List (L : in out Success_Lists.List) is
Rec : Test_Success;
use Success_Lists;
begin
Start (L);
while not Off (L) loop
Rec := Item (L);
Destroy (Rec.Routine_Name);
Destroy (Rec.Test_Name);
Remove (L);
end loop;
end Deallocate_Success_List;
-- Report on a test run
procedure Report (R : Result) is
S : Success_Lists.List := Successes (R);
F : Failure_Lists.List := Failures (R);
E : Failure_Lists.List := Errors (R);
begin
Put_Line (" Total Tests Run: " & Natural'Image (Test_Count (R)));
New_Line;
Put_Line (" Successful Tests:" & Natural'Image (Success_Count (R)));
if Verbose then
Dump_Success_List (S);
else
Deallocate_Success_List (S);
end if;
New_Line;
Put_Line (" Failed Tests:" & Natural'Image (Failure_Count (R)));
Dump_Failure_List (F);
New_Line;
Put_Line (" Unexpected Errors:" & Natural'Image (Error_Count (R)));
Dump_Failure_List (E, False);
if Elapsed (R) > 0.0 then
New_Line;
Put_Line ("Time: " & Duration'Image (Elapsed (R)) & " seconds");
end if;
end Report;
end AUnit.Test_Results.Text_Reporter;
|