Mercurial > hg > CbC > CbC_gcc

comparison gcc/ada/libgnat/a-calfor.adb @ 145:1830386684a0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc-9.2.0
author anatofuz
date Thu, 13 Feb 2020 11:34:05 +0900
parents 84e7813d76e9
children
comparison
equal deleted inserted replaced
131:84e7813d76e9 145:1830386684a0
4 -- -- 4 -- --
5 -- A D A . C A L E N D A R . F O R M A T T I N G -- 5 -- A D A . C A L E N D A R . F O R M A T T I N G --
6 -- -- 6 -- --
7 -- B o d y -- 7 -- B o d y --
8 -- -- 8 -- --
9 -- Copyright (C) 2006-2018, Free Software Foundation, Inc. -- 9 -- Copyright (C) 2006-2019, Free Software Foundation, Inc. --
10 -- -- 10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under -- 11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- -- 12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- -- 13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
50 -- Subsidiary to the two versions of Value. Determine whether the character 50 -- Subsidiary to the two versions of Value. Determine whether the character
51 -- of string S at position Index is a digit. This catches invalid input 51 -- of string S at position Index is a digit. This catches invalid input
52 -- such as 1983-*1-j3 u5:n7:k9 which should be 1983-01-03 05:07:09. Raise 52 -- such as 1983-*1-j3 u5:n7:k9 which should be 1983-01-03 05:07:09. Raise
53 -- Constraint_Error if there is a mismatch. 53 -- Constraint_Error if there is a mismatch.
54 54
55 procedure Split_Duration
56 (Seconds : Duration;
57 Hour : out Natural;
58 Minute : out Minute_Number;
59 Second : out Second_Number;
60 Sub_Second : out Second_Duration);
61 -- Version of Split that allows durations < 100 hours.
62 -- Will raise Time_Error if Seconds >= 100 hours.
63
55 ---------------- 64 ----------------
56 -- Check_Char -- 65 -- Check_Char --
57 ---------------- 66 ----------------
58 67
59 procedure Check_Char (S : String; C : Character; Index : Integer) is 68 procedure Check_Char (S : String; C : Character; Index : Integer) is
138 function Image 147 function Image
139 (Elapsed_Time : Duration; 148 (Elapsed_Time : Duration;
140 Include_Time_Fraction : Boolean := False) return String 149 Include_Time_Fraction : Boolean := False) return String
141 is 150 is
142 To_Char : constant array (0 .. 9) of Character := "0123456789"; 151 To_Char : constant array (0 .. 9) of Character := "0123456789";
143 Hour : Hour_Number; 152 Hour : Natural;
144 Minute : Minute_Number; 153 Minute : Minute_Number;
145 Second : Second_Number; 154 Second : Second_Number;
146 Sub_Second : Duration; 155 Sub_Second : Duration;
147 SS_Nat : Natural; 156 SS_Nat : Natural;
148 157
153 Last : constant Integer := (if Include_Time_Fraction then 12 else 9); 162 Last : constant Integer := (if Include_Time_Fraction then 12 else 9);
154 163
155 Result : String := "-00:00:00.00"; 164 Result : String := "-00:00:00.00";
156 165
157 begin 166 begin
158 Split (abs (Elapsed_Time), Hour, Minute, Second, Sub_Second); 167 Split_Duration (abs Elapsed_Time, Hour, Minute, Second, Sub_Second);
159 168
160 -- Hour processing, positions 2 and 3 169 -- Hour processing, positions 2 and 3
161 170
162 Result (2) := To_Char (Hour / 10); 171 Result (2) := To_Char (Hour / 10);
163 Result (3) := To_Char (Hour mod 10); 172 Result (3) := To_Char (Hour mod 10);
359 Day_Duration (Minute * 60) + 368 Day_Duration (Minute * 60) +
360 Day_Duration (Second) + 369 Day_Duration (Second) +
361 Sub_Second; 370 Sub_Second;
362 end Seconds_Of; 371 end Seconds_Of;
363 372
373 --------------------
374 -- Split_Duration --
375 --------------------
376
377 procedure Split_Duration
378 (Seconds : Duration;
379 Hour : out Natural;
380 Minute : out Minute_Number;
381 Second : out Second_Number;
382 Sub_Second : out Second_Duration)
383 is
384 Secs : Natural;
385 begin
386 -- Check that Seconds is below 100 hours
387
388 if Seconds >= 3600.0 * 100.0 then
389 raise Time_Error;
390 end if;
391
392 Secs := (if Seconds = 0.0 then 0 else Natural (Seconds - 0.5));
393
394 Sub_Second := Second_Duration (Seconds - Duration (Secs));
395 Hour := Natural (Secs / 3_600);
396 Secs := Secs mod 3_600;
397 Minute := Minute_Number (Secs / 60);
398 Second := Second_Number (Secs mod 60);
399 end Split_Duration;
400
364 ----------- 401 -----------
365 -- Split -- 402 -- Split --
366 ----------- 403 -----------
367 404
368 procedure Split 405 procedure Split
370 Hour : out Hour_Number; 407 Hour : out Hour_Number;
371 Minute : out Minute_Number; 408 Minute : out Minute_Number;
372 Second : out Second_Number; 409 Second : out Second_Number;
373 Sub_Second : out Second_Duration) 410 Sub_Second : out Second_Duration)
374 is 411 is
375 Secs : Natural; 412 Unchecked_Hour : Natural;
376
377 begin 413 begin
378 -- Validity checks 414 -- Validity checks
379 415
380 if not Seconds'Valid then 416 if not Seconds'Valid then
381 raise Constraint_Error; 417 raise Constraint_Error;
382 end if; 418 end if;
383 419
384 Secs := (if Seconds = 0.0 then 0 else Natural (Seconds - 0.5)); 420 Split_Duration (Seconds, Unchecked_Hour, Minute, Second, Sub_Second);
385 421
386 Sub_Second := Second_Duration (Seconds - Day_Duration (Secs)); 422 if Unchecked_Hour > Hour_Number'Last then
387 Hour := Hour_Number (Secs / 3_600);
388 Secs := Secs mod 3_600;
389 Minute := Minute_Number (Secs / 60);
390 Second := Second_Number (Secs mod 60);
391
392 -- Validity checks
393
394 if not Hour'Valid
395 or else not Minute'Valid
396 or else not Second'Valid
397 or else not Sub_Second'Valid
398 then
399 raise Time_Error; 423 raise Time_Error;
400 end if; 424 end if;
425
426 Hour := Unchecked_Hour;
401 end Split; 427 end Split;
402 428
403 ----------- 429 -----------
404 -- Split -- 430 -- Split --
405 ----------- 431 -----------