/usr/share/ada/adainclude/ahven/ahven-parameters.adb is in libahven3-dev 2.1-2.
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 | --
-- Copyright (c) 2008 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.Command_Line;
with Ada.Text_IO;
use Ada.Command_Line;
use Ada.Text_IO;
package body Ahven.Parameters is
-- Possible options:
-- -c : capture output
-- -d : result directory
-- -q : quiet mode
-- -t : timeout
-- -v : verbose mode (default)
-- -x : XML output
--
procedure Parse_Options (Info : in out Parameter_Info;
Mode : Parameter_Mode;
Option : String;
Dir_Next : out Boolean;
Timeout_Next : out Boolean) is
procedure Check_Invalid (C : Character) is
begin
case Mode is
when NORMAL_PARAMETERS =>
if C = 'n' then
raise Invalid_Parameter;
end if;
when TAP_PARAMETERS =>
if (C = 'd') or (C = 'x') then
raise Invalid_Parameter;
end if;
end case;
end Check_Invalid;
begin
Dir_Next := False;
Timeout_Next := False;
for A in Option'Range loop
Check_Invalid (Option (A));
case Option (A) is
when 'c' =>
Info.Capture_Output := True;
when 'd' =>
Dir_Next := True;
when 't' =>
Timeout_Next := True;
when 'v' =>
Info.Verbose_Output := True;
when 'q' =>
Info.Verbose_Output := False;
when 'x' =>
Info.Xml_Output := True;
when others =>
raise Invalid_Parameter;
end case;
end loop;
end Parse_Options;
-- Recognize command line parameters.
-- Option "--" can be used to separate options and test names.
--
procedure Parse_Parameters (Mode : Parameter_Mode;
Info : out Parameter_Info) is
procedure Handle_Parameter (P : in out Parameter_Info;
Arg : String;
Index : Positive);
-- Parse one parameter and update P if necessary.
Files_Only : Boolean := False;
Dir_Next : Boolean := False;
Timeout_Next : Boolean := False;
procedure Handle_Parameter (P : in out Parameter_Info;
Arg : String;
Index : Positive)
is
begin
if Dir_Next then
P.Result_Dir := Index;
Dir_Next := False;
elsif Timeout_Next then
P.Timeout := Framework.Test_Duration'Value (Arg);
Timeout_Next := False;
elsif Arg = "--" then
Files_Only := True;
elsif Arg'Size > 1 then
if (not Files_Only) and (Arg (Arg'First) = '-') then
Parse_Options
(Info => P,
Mode => Mode,
Option => Arg (Arg'First + 1 .. Arg'Last),
Dir_Next => Dir_Next,
Timeout_Next => Timeout_Next);
else
P.Test_Name := Index;
end if;
end if;
end Handle_Parameter;
begin
-- Default values
Info := (Verbose_Output => True,
Xml_Output => False,
Capture_Output => False,
Test_Name => 0,
Result_Dir => 0,
Timeout => 0.0);
for A in Positive range 1 .. Argument_Count loop
Handle_Parameter (Info, Argument (A), A);
end loop;
if Dir_Next then
raise Invalid_Parameter;
end if;
end Parse_Parameters;
procedure Usage (Mode : Parameter_Mode := NORMAL_PARAMETERS) is
begin
case Mode is
when NORMAL_PARAMETERS =>
Put_Line
("Possible parameters: [-cqvx] [-d directory] [--] [testname]");
Put_Line (" -d : directory for test results");
Put_Line (" -x : output in XML format");
when TAP_PARAMETERS =>
Put_Line ("Possible parameters: [-cqv] [--] [testname]");
end case;
Put_Line (" -c : capture and report test outputs");
Put_Line (" -q : quiet results");
Put_Line (" -t : test timeout, infinite default");
Put_Line (" -v : verbose results (default)");
Put_Line (" -- : end of parameters (optional)");
end Usage;
function Capture (Info : Parameter_Info) return Boolean is
begin
return Info.Capture_Output;
end Capture;
function Verbose (Info : Parameter_Info) return Boolean is
begin
return Info.Verbose_Output;
end Verbose;
function XML_Results (Info : Parameter_Info) return Boolean is
begin
return Info.Xml_Output;
end XML_Results;
function Single_Test (Info : Parameter_Info) return Boolean is
begin
return (Info.Test_Name /= 0);
end Single_Test;
function Test_Name (Info : Parameter_Info) return String is
begin
if Info.Test_Name = 0 then
return "";
else
return Argument (Info.Test_Name);
end if;
end Test_Name;
function Result_Dir (Info : Parameter_Info) return String is
begin
if Info.Result_Dir = 0 then
return "";
else
return Argument (Info.Result_Dir);
end if;
end Result_Dir;
function Timeout (Info : Parameter_Info) return Framework.Test_Duration is
begin
return Info.Timeout;
end Timeout;
end Ahven.Parameters;
|