Skip to content

Commit 7d1b6da

Browse files
committed
grt-options: extract Parse_Time.
1 parent 6bc6e9b commit 7d1b6da

2 files changed

Lines changed: 61 additions & 46 deletions

File tree

src/grt/grt-options.adb

Lines changed: 56 additions & 46 deletions
Original file line numberDiff line numberDiff line change
@@ -217,6 +217,57 @@ package body Grt.Options is
217217
end loop;
218218
end Extract_Integer;
219219

220+
function Parse_Time (Str : String) return Std_Time
221+
is
222+
Ok : Boolean;
223+
Pos : Natural;
224+
Time : Integer_64;
225+
Unit : String (1 .. 3);
226+
begin
227+
Extract_Integer (Str, Ok, Time, Pos);
228+
if not Ok then
229+
Time := 1;
230+
end if;
231+
232+
-- Check unit length and convert it to lower case.
233+
if Str'Last = Pos + 1 then
234+
Unit (3) := ' ';
235+
elsif Str'Last = Pos + 2 then
236+
Unit (3) := To_Lower (Str (Pos + 2));
237+
else
238+
Error_C ("bad unit for '");
239+
Error_C (Str);
240+
Error_E ("'");
241+
return -1;
242+
end if;
243+
Unit (1) := To_Lower (Str (Pos));
244+
Unit (2) := To_Lower (Str (Pos + 1));
245+
246+
if Unit = "fs " then
247+
null;
248+
elsif Unit = "ps " then
249+
Time := Time * (10 ** 3);
250+
elsif Unit = "ns " then
251+
Time := Time * (10 ** 6);
252+
elsif Unit = "us " then
253+
Time := Time * (10 ** 9);
254+
elsif Unit = "ms " then
255+
Time := Time * (10 ** 12);
256+
elsif Unit = "sec" then
257+
Time := Time * (10 ** 15);
258+
elsif Unit = "min" then
259+
Time := Time * (10 ** 15) * 60;
260+
elsif Unit = "hr " then
261+
Time := Time * (10 ** 15) * 3600;
262+
else
263+
Error_C ("bad unit name for '");
264+
Error_C (Str);
265+
Error_E ("'");
266+
return -1;
267+
end if;
268+
return Std_Time (Time);
269+
end Parse_Time;
270+
220271
procedure Decode_Option
221272
(Option : String; Status : out Decode_Option_Status)
222273
is
@@ -317,52 +368,11 @@ package body Grt.Options is
317368
end if;
318369
end;
319370
elsif Len > 12 and then Option (1 .. 12) = "--stop-time=" then
320-
declare
321-
Ok : Boolean;
322-
Pos : Natural;
323-
Time : Integer_64;
324-
Unit : String (1 .. 3);
325-
begin
326-
Extract_Integer (Option (13 .. Len), Ok, Time, Pos);
327-
if not Ok then
328-
Time := 1;
329-
end if;
330-
if (Len - Pos + 1) not in 2 .. 3 then
331-
Error_C ("bad unit for '");
332-
Error_C (Option);
333-
Error_E ("'");
334-
return;
335-
end if;
336-
Unit (1) := To_Lower (Option (Pos));
337-
Unit (2) := To_Lower (Option (Pos + 1));
338-
if Len = Pos + 2 then
339-
Unit (3) := To_Lower (Option (Pos + 2));
340-
else
341-
Unit (3) := ' ';
342-
end if;
343-
if Unit = "fs " then
344-
null;
345-
elsif Unit = "ps " then
346-
Time := Time * (10 ** 3);
347-
elsif Unit = "ns " then
348-
Time := Time * (10 ** 6);
349-
elsif Unit = "us " then
350-
Time := Time * (10 ** 9);
351-
elsif Unit = "ms " then
352-
Time := Time * (10 ** 12);
353-
elsif Unit = "sec" then
354-
Time := Time * (10 ** 15);
355-
elsif Unit = "min" then
356-
Time := Time * (10 ** 15) * 60;
357-
elsif Unit = "hr " then
358-
Time := Time * (10 ** 15) * 3600;
359-
else
360-
Error_C ("bad unit name for '");
361-
Error_C (Option);
362-
Error_E ("'");
363-
end if;
364-
Stop_Time := Std_Time (Time);
365-
end;
371+
Stop_Time := Parse_Time (Option (13 .. Len));
372+
if Stop_Time = -1 then
373+
-- In case of error...
374+
return;
375+
end if;
366376
elsif Len > 13 and then Option (1 .. 13) = "--stop-delta=" then
367377
declare
368378
Ok : Boolean;

src/grt/grt-options.ads

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -144,6 +144,11 @@ package Grt.Options is
144144
-- or append_mode (TEXTIO)
145145
Unbuffered_Writes : Boolean := False;
146146

147+
-- Helper: extract time from STR (a number followed by a unit, without
148+
-- spaces; the number is optionnal). In case of error, display an error
149+
-- message and returns -1.
150+
function Parse_Time (Str : String) return Std_Time;
151+
147152
-- Set the time resolution.
148153
-- Only call this subprogram if you are allowed to set the time resolution.
149154
procedure Set_Time_Resolution (Res : Character);

0 commit comments

Comments
 (0)