/usr/share/ada/adainclude/ahven/ahven-tap_runner.adb is in libahven4-dev 2.4+repack-1.
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 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 | --
-- Copyright (c) 2008-2009 Tero Koskinen <tero.koskinen@iki.fi>
--
-- Permission to use, copy, modify, and distribute this software for any
-- purpose with or without fee is hereby granted, provided that the above
-- copyright notice and this permission notice appear in all copies.
--
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
--
with Ada.Text_IO;
with Ada.Strings.Fixed;
with Ada.Characters.Latin_1;
with Ahven.Parameters;
with Ahven.AStrings;
with Ahven.Long_AStrings;
package body Ahven.Tap_Runner is
use Ada.Text_IO;
use Ahven.Framework;
use Ahven.AStrings;
function Count_Image (Count : Test_Count_Type) return String is
use Ada.Strings;
begin
return Fixed.Trim (Test_Count_Type'Image (Count), Both);
end Count_Image;
procedure Print_Data (Message : String; Prefix : String) is
Start_Of_Line : Boolean := True;
begin
for I in Message'Range loop
if Start_Of_Line then
Put (Prefix);
Start_Of_Line := False;
end if;
if Message (I) = Ada.Characters.Latin_1.LF then
New_Line;
Start_Of_Line := True;
elsif Message (I) /= Ada.Characters.Latin_1.CR then
Put (Message (I));
end if;
end loop;
if not Start_Of_Line then
New_Line;
end if;
end Print_Data;
procedure Run (Suite : in out Framework.Test'Class) is
Listener : Tap_Listener;
Params : Parameters.Parameter_Info;
begin
Parameters.Parse_Parameters (Parameters.TAP_PARAMETERS, Params);
Listener.Verbose := Parameters.Verbose (Params);
Listener.Capture_Output := Parameters.Capture (Params);
if Parameters.Single_Test (Params) then
Put_Line ("1.." & Count_Image (Test_Count
(Suite, Parameters.Test_Name (Params))));
Framework.Execute
(T => Suite,
Test_Name => Parameters.Test_Name (Params),
Listener => Listener,
Timeout => Parameters.Timeout (Params));
else
Put_Line ("1.." & Count_Image (Test_Count (Suite)));
Framework.Execute (Suite, Listener, Parameters.Timeout (Params));
end if;
exception
when Parameters.Invalid_Parameter =>
Parameters.Usage (Parameters.TAP_PARAMETERS);
end Run;
procedure Print_Info (Info : Context) is
begin
if Length (Info.Message) > 0 then
Print_Data (Message => To_String (Info.Message), Prefix => "# ");
end if;
if Long_AStrings.Length (Info.Long_Message) > 0 then
Print_Data
(Message => Long_AStrings.To_String (Info.Long_Message),
Prefix => "# ");
end if;
end Print_Info;
procedure Print_Log_File (Filename : String; Prefix : String) is
Handle : File_Type;
Char : Character := ' ';
First : Boolean := True;
Start_Of_Line : Boolean := True;
begin
Open (Handle, In_File, Filename);
loop
exit when End_Of_File (Handle);
Get (Handle, Char);
if First then
Put_Line (Prefix & "===== Output =======");
First := False;
end if;
if Start_Of_Line then
Put (Prefix);
Start_Of_Line := False;
end if;
Put (Char);
if End_Of_Line (Handle) then
New_Line;
Start_Of_Line := True;
end if;
end loop;
Close (Handle);
if not First then
Put_Line (Prefix & "====================");
end if;
exception
when Name_Error =>
-- Missing output file is ok.
Put_Line (Prefix & "no output");
end Print_Log_File;
procedure Add_Pass (Listener : in out Tap_Listener;
Info : Context) is
use Ada.Strings;
use Ada.Strings.Fixed;
begin
if Listener.Capture_Output then
Temporary_Output.Restore_Output;
Temporary_Output.Close_Temp (Listener.Output_File);
end if;
Put ("ok ");
Put (Count_Image (Listener.Current_Test) & " ");
Put (To_String (Info.Test_Name) & ": " & To_String (Info.Routine_Name));
New_Line;
end Add_Pass;
procedure Report_Not_Ok (Listener : in out Tap_Listener;
Info : Context;
Severity : String) is
use Ada.Strings;
use Ada.Strings.Fixed;
begin
if Listener.Capture_Output then
Temporary_Output.Restore_Output;
Temporary_Output.Close_Temp (Listener.Output_File);
end if;
Put ("not ok ");
Put (Count_Image (Listener.Current_Test) & " ");
Put (To_String (Info.Test_Name) & ": " & To_String (Info.Routine_Name));
New_Line;
if Listener.Verbose then
Print_Info (Info);
if Listener.Capture_Output then
Print_Log_File
(Filename => Temporary_Output.Get_Name (Listener.Output_File),
Prefix => "# ");
end if;
end if;
end Report_Not_Ok;
procedure Add_Failure (Listener : in out Tap_Listener;
Info : Context) is
begin
Report_Not_Ok (Listener, Info, "fail");
end Add_Failure;
procedure Add_Error (Listener : in out Tap_Listener;
Info : Context) is
begin
Report_Not_Ok (Listener, Info, "error");
end Add_Error;
procedure Add_Skipped (Listener : in out Tap_Listener;
Info : Context) is
use Ada.Strings;
use Ada.Strings.Fixed;
begin
if Listener.Capture_Output then
Temporary_Output.Restore_Output;
Temporary_Output.Close_Temp (Listener.Output_File);
end if;
Put ("ok ");
Put (Count_Image (Listener.Current_Test) & " ");
Put (To_String (Info.Test_Name) & ": " & To_String (Info.Routine_Name));
Put (" # SKIP " & To_String (Info.Message));
New_Line;
end Add_Skipped;
procedure Start_Test (Listener : in out Tap_Listener;
Info : Context) is
begin
if Info.Test_Kind = ROUTINE then
Listener.Current_Test := Listener.Current_Test + 1;
if Listener.Capture_Output then
Temporary_Output.Create_Temp (Listener.Output_File);
Temporary_Output.Redirect_Output (Listener.Output_File);
end if;
end if;
end Start_Test;
procedure End_Test (Listener : in out Tap_Listener;
Info : Context) is
Handle : Ada.Text_IO.File_Type;
begin
if Listener.Capture_Output then
Ada.Text_IO.Open (Handle, Ada.Text_IO.Out_File,
Temporary_Output.Get_Name (Listener.Output_File));
Ada.Text_IO.Delete (Handle);
end if;
exception
when Name_Error =>
-- Missing file is safe to ignore, we are going to delete it anyway
null;
end End_Test;
end Ahven.Tap_Runner;
|