Skip to content

R
riscv-gcc-1
Commit 6e451134 by Hristian Kirtchev Committed by Arnaud Charlet
Options

a-calend-vms.adb (Leap_Sec_Ops): Temp body for package in private part of Ada.Calendar... 

2006-10-31  Hristian Kirtchev  <kirtchev@adacore.com>
	    Jose Ruiz  <ruiz@adacore.com>

	* a-calend-vms.adb (Leap_Sec_Ops): Temp body for package in private
	part of Ada.Calendar: all subprogram raise Unimplemented.
	(Split_W_Offset): Temp function body, raising Unimplemented

	* a-calend.ads, a-calend-vms.ads: 
	Add imported variable Invalid_TZ_Offset used to designate targets unable
	to support time zones.
	(Unimplemented): Temporary function raised by the body of new
	subprograms below.
	(Leap_Sec_Ops): New package in the private part of Ada.Calendar. This
	unit provides handling of leap seconds and is used by the new Ada 2005
	packages Ada.Calendar.Arithmetic and Ada.Calendar.Formatting.
	(Split_W_Offset): Identical spec to that of Ada.Calendar.Split. This
	version returns an extra value which is the offset to UTC.

	* a-calend.adb (Split_W_Offset): Add call to localtime_tzoff.
	(Leap_Sec_Ops): New body for package in private part of Ada.Calendar.
	(Split_W_Offset): New function body.
	(Time_Of): When a date is close to UNIX epoch, compute the time for
	that date plus one day (that amount is later substracted after
	executing mktime) so there are no problems with time zone adjustments.

	* a-calend-mingw.adb: Remove Windows specific version no longer needed.

	* a-calari.ads, a-calari.adb, a-calfor.ads, a-calfor.adb,
	a-catizo.ads, a-catizo.adb: New files.

        * impunit.adb: Add new Ada 2005 entries

	* sysdep.c: Add external variable __gnat_invalid_tz_offset.
	Rename all occurences of "__gnat_localtime_r" to
	"__gnat_localtime_tzoff".
	(__gnat_localtime_tzoff for Windows): Add logic to retrieve the time
	zone data and calculate the GMT offset.
	(__gnat_localtime_tzoff for Darwin, Free BSD, Linux, Lynx and Tru64):
	Use the field "tm_gmtoff" to extract the GMT offset.
	(__gnat_localtime_tzoff for AIX, HPUX, SGI Irix and Sun Solaris): Use
	the external variable "timezone" to calculate the GMT offset.

From-SVN: r118234
parent 014c9caa
Showing with 2121 additions and 435 deletions
gcc/ada/a-calari.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . C A L E N D A R . A R I T H M E T I C --
-- --
-- B o d y --
-- --
-- Copyright (C) 2006, Free Software Foundation, 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. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Unchecked_Conversion;
package body Ada.Calendar.Arithmetic is
use Leap_Sec_Ops;
Day_Duration : constant Duration := 86_400.0;
---------
-- "+" --
---------
function "+" (Left : Time; Right : Day_Count) return Time is
begin
return Left + Integer (Right) * Day_Duration;
end "+";
function "+" (Left : Day_Count; Right : Time) return Time is
begin
return Integer (Left) * Day_Duration + Right;
end "+";
---------
-- "-" --
---------
function "-" (Left : Time; Right : Day_Count) return Time is
begin
return Left - Integer (Right) * Day_Duration;
end "-";
function "-" (Left, Right : Time) return Day_Count is
Days : Day_Count;
Seconds : Duration;
Leap_Seconds : Leap_Seconds_Count;
begin
Difference (Left, Right, Days, Seconds, Leap_Seconds);
return Days;
end "-";
----------------
-- Difference --
----------------
procedure Difference
(Left, Right : Time;
Days : out Day_Count;
Seconds : out Duration;
Leap_Seconds : out Leap_Seconds_Count)
is
Diff : Duration;
Earlier : Time;
Later : Time;
Leaps_Dur : Duration;
Negate : Boolean;
Next_Leap : Time;
Secs_Diff : Long_Integer;
Sub_Seconds : Duration;
begin
if Left >= Right then
Later := Left;
Earlier := Right;
Negate := False;
else
Later := Right;
Earlier := Left;
Negate := True;
end if;
Diff := Later - Earlier;
Cumulative_Leap_Secs (Earlier, Later, Leaps_Dur, Next_Leap);
if Later >= Next_Leap then
Leaps_Dur := Leaps_Dur + 1.0;
end if;
Diff := Diff - Leaps_Dur;
declare
type D_Int is range 0 .. 2 ** (Duration'Size - 1) - 1;
for D_Int'Size use Duration'Size;
Small_Div : constant D_Int := D_Int (1.0 / Duration'Small);
D_As_Int : D_Int;
function To_D_As_Int is new Unchecked_Conversion (Duration, D_Int);
function To_Duration is new Unchecked_Conversion (D_Int, Duration);
begin
D_As_Int := To_D_As_Int (Diff);
Secs_Diff := Long_Integer (D_As_Int / Small_Div);
Sub_Seconds := To_Duration (D_As_Int rem Small_Div);
end;
Days := Day_Count (Secs_Diff / 86_400);
Seconds := Duration (Secs_Diff mod 86_400) + Sub_Seconds;
Leap_Seconds := Leap_Seconds_Count (Leaps_Dur);
if Negate then
Days := -Days;
Seconds := -Seconds;
Leap_Seconds := -Leap_Seconds;
end if;
end Difference;
end Ada.Calendar.Arithmetic;
gcc/ada/a-calari.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . C A L E N D A R . A R I T H M E T I C --
-- --
-- S p e c --
-- --
-- Copyright (C) 2005 - 2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- apply solely to the contents of the part following the private keyword. --
-- --
-- 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. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
package Ada.Calendar.Arithmetic is
-- Arithmetic on days:
type Day_Count is range
-(366 * (1 + Year_Number'Last - Year_Number'First))
..
+(366 * (1 + Year_Number'Last - Year_Number'First));
subtype Leap_Seconds_Count is Integer range -2047 .. 2047;
procedure Difference
(Left, Right : Time;
Days : out Day_Count;
Seconds : out Duration;
Leap_Seconds : out Leap_Seconds_Count);
function "+" (Left : Time; Right : Day_Count) return Time;
function "+" (Left : Day_Count; Right : Time) return Time;
function "-" (Left : Time; Right : Day_Count) return Time;
function "-" (Left, Right : Time) return Day_Count;
end Ada.Calendar.Arithmetic;
gcc/ada/a-calend-mingw.adb deleted 100644 → 0
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . C A L E N D A R --
-- --
-- B o d y --
-- --
-- Copyright (C) 1997-2005, Free Software Foundation, 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, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This is the Windows NT/95 version
-- Why do we need separate version ???
-- Do we need *this* much code duplication???
with System.OS_Primitives;
-- used for Clock
with System.OS_Interface;
package body Ada.Calendar is
use System.OS_Interface;
------------------------------
-- Use of Pragma Unsuppress --
------------------------------
-- This implementation of Calendar takes advantage of the permission in
-- Ada 95 of using arithmetic overflow checks to check for out of bounds
-- time values. This means that we must catch the constraint error that
-- results from arithmetic overflow, so we use pragma Unsuppress to make
-- sure that overflow is enabled, using software overflow checking if
-- necessary. That way, compiling Calendar with options to suppress this
-- checking will not affect its correctness.
------------------------
-- Local Declarations --
------------------------
Ada_Year_Min : constant := 1901;
Ada_Year_Max : constant := 2099;
-- Win32 time constants
epoch_1970 : constant := 16#19D_B1DE_D53E_8000#; -- win32 UTC epoch
system_time_ns : constant := 100; -- 100 ns per tick
Sec_Unit : constant := 10#1#E9;
---------
-- "+" --
---------
function "+" (Left : Time; Right : Duration) return Time is
pragma Unsuppress (Overflow_Check);
begin
return (Left + Time (Right));
exception
when Constraint_Error =>
raise Time_Error;
end "+";
function "+" (Left : Duration; Right : Time) return Time is
pragma Unsuppress (Overflow_Check);
begin
return (Time (Left) + Right);
exception
when Constraint_Error =>
raise Time_Error;
end "+";
---------
-- "-" --
---------
function "-" (Left : Time; Right : Duration) return Time is
pragma Unsuppress (Overflow_Check);
begin
return Left - Time (Right);
exception
when Constraint_Error =>
raise Time_Error;
end "-";
function "-" (Left : Time; Right : Time) return Duration is
pragma Unsuppress (Overflow_Check);
begin
return Duration (Left) - Duration (Right);
exception
when Constraint_Error =>
raise Time_Error;
end "-";
---------
-- "<" --
---------
function "<" (Left, Right : Time) return Boolean is
begin
return Duration (Left) < Duration (Right);
end "<";
----------
-- "<=" --
----------
function "<=" (Left, Right : Time) return Boolean is
begin
return Duration (Left) <= Duration (Right);
end "<=";
---------
-- ">" --
---------
function ">" (Left, Right : Time) return Boolean is
begin
return Duration (Left) > Duration (Right);
end ">";
----------
-- ">=" --
----------
function ">=" (Left, Right : Time) return Boolean is
begin
return Duration (Left) >= Duration (Right);
end ">=";
-----------
-- Clock --
-----------
-- The Ada.Calendar.Clock function gets the time from the soft links
-- interface which will call the appropriate function depending wether
-- tasking is involved or not.
function Clock return Time is
begin
return Time (System.OS_Primitives.Clock);
end Clock;
---------
-- Day --
---------
function Day (Date : Time) return Day_Number is
DY : Year_Number;
DM : Month_Number;
DD : Day_Number;
DS : Day_Duration;
begin
Split (Date, DY, DM, DD, DS);
return DD;
end Day;
-----------
-- Month --
-----------
function Month (Date : Time) return Month_Number is
DY : Year_Number;
DM : Month_Number;
DD : Day_Number;
DS : Day_Duration;
begin
Split (Date, DY, DM, DD, DS);
return DM;
end Month;
-------------
-- Seconds --
-------------
function Seconds (Date : Time) return Day_Duration is
DY : Year_Number;
DM : Month_Number;
DD : Day_Number;
DS : Day_Duration;
begin
Split (Date, DY, DM, DD, DS);
return DS;
end Seconds;
-----------
-- Split --
-----------
procedure Split
(Date : Time;
Year : out Year_Number;
Month : out Month_Number;
Day : out Day_Number;
Seconds : out Day_Duration)
is
Date_Int : aliased Long_Long_Integer;
Date_Loc : aliased Long_Long_Integer;
Timbuf : aliased SYSTEMTIME;
Int_Date : Long_Long_Integer;
Sub_Seconds : Duration;
begin
-- We take the sub-seconds (decimal part) of Date and this is added
-- to compute the Seconds. This way we keep the precision of the
-- high-precision clock that was lost with the Win32 API calls
-- below.
if Date < 0.0 then
-- this is a Date before Epoch (January 1st, 1970)
Sub_Seconds := Duration (Date) -
Duration (Long_Long_Integer (Date + Duration'(0.5)));
Int_Date := Long_Long_Integer (Date - Sub_Seconds);
-- For Date = -86400.1 we are 2 days before Epoch at 0.1 seconds
-- from day 1 before Epoch. It means that it is 23h 59m 59.9s.
-- here we adjust for that.
if Sub_Seconds < 0.0 then
Int_Date := Int_Date - 1;
Sub_Seconds := 1.0 + Sub_Seconds;
end if;
else
-- this is a Date after Epoch (January 1st, 1970)
Sub_Seconds := Duration (Date) -
Duration (Long_Long_Integer (Date - Duration'(0.5)));
Int_Date := Long_Long_Integer (Date - Sub_Seconds);
end if;
-- Date_Int is the number of seconds from Epoch
Date_Int := Long_Long_Integer
(Int_Date * Sec_Unit / system_time_ns) + epoch_1970;
if not FileTimeToLocalFileTime (Date_Int'Access, Date_Loc'Access) then
raise Time_Error;
end if;
if not FileTimeToSystemTime (Date_Loc'Access, Timbuf'Access) then
raise Time_Error;
end if;
if Timbuf.wYear not in Ada_Year_Min .. Ada_Year_Max then
raise Time_Error;
end if;
Seconds :=
Duration (Timbuf.wHour) * 3_600.0 +
Duration (Timbuf.wMinute) * 60.0 +
Duration (Timbuf.wSecond) +
Sub_Seconds;
Day := Integer (Timbuf.wDay);
Month := Integer (Timbuf.wMonth);
Year := Integer (Timbuf.wYear);
end Split;
-------------
-- Time_Of --
-------------
function Time_Of
(Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
Seconds : Day_Duration := 0.0)
return Time
is
Timbuf : aliased SYSTEMTIME;
Now : aliased Long_Long_Integer;
Loc : aliased Long_Long_Integer;
Int_Secs : Integer;
Secs : Integer;
Add_One_Day : Boolean := False;
Date : Time;
begin
-- The following checks are redundant with respect to the constraint
-- error checks that should normally be made on parameters, but we
-- decide to raise Constraint_Error in any case if bad values come
-- in (as a result of checks being off in the caller, or for other
-- erroneous or bounded error cases).
if not Year 'Valid
or else not Month 'Valid
or else not Day 'Valid
or else not Seconds'Valid
then
raise Constraint_Error;
end if;
if Seconds = 0.0 then
Int_Secs := 0;
else
Int_Secs := Integer (Seconds - 0.5);
end if;
-- Timbuf.wMillisec is to keep the msec. We can't use that because the
-- high-resolution clock has a precision of 1 Microsecond.
-- Anyway the sub-seconds part is not needed to compute the number
-- of seconds in UTC.
if Int_Secs = 86_400 then
Secs := 0;
Add_One_Day := True;
else
Secs := Int_Secs;
end if;
Timbuf.wMilliseconds := 0;
Timbuf.wSecond := WORD (Secs mod 60);
Timbuf.wMinute := WORD ((Secs / 60) mod 60);
Timbuf.wHour := WORD (Secs / 3600);
Timbuf.wDay := WORD (Day);
Timbuf.wMonth := WORD (Month);
Timbuf.wYear := WORD (Year);
if not SystemTimeToFileTime (Timbuf'Access, Loc'Access) then
raise Time_Error;
end if;
if not LocalFileTimeToFileTime (Loc'Access, Now'Access) then
raise Time_Error;
end if;
-- Here we have the UTC now translate UTC to Epoch time (UNIX style
-- time based on 1 january 1970) and add there the sub-seconds part.
declare
Sub_Sec : constant Duration := Seconds - Duration (Int_Secs);
begin
Date := Time ((Now - epoch_1970) * system_time_ns / Sec_Unit) +
Sub_Sec;
end;
if Add_One_Day then
Date := Date + Duration (86400.0);
end if;
return Date;
end Time_Of;
----------
-- Year --
----------
function Year (Date : Time) return Year_Number is
DY : Year_Number;
DM : Month_Number;
DD : Day_Number;
DS : Day_Duration;
begin
Split (Date, DY, DM, DD, DS);
return DY;
end Year;
begin
System.OS_Primitives.Initialize;
end Ada.Calendar;
gcc/ada/a-calend-vms.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, Free Software Foundation, 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- --
......@@ -224,7 +224,7 @@ package body Ada.Calendar is
procedure Numtim (
Status : out Unsigned_Longword;
Timbuf : out Unsigned_Word_Array;
Timadr : in Time);
Timadr : Time);
pragma Interface (External, Numtim);
......@@ -256,6 +256,22 @@ package body Ada.Calendar is
Year := Integer (Timbuf (1));
end Split;
-----------------------
-- Split_With_Offset --
-----------------------
procedure Split_With_Offset
(Date : Time;
Year : out Year_Number;
Month : out Month_Number;
Day : out Day_Number;
Seconds : out Day_Duration;
Offset : out Long_Integer)
is
begin
raise Unimplemented;
end Split_With_Offset;
-------------
-- Time_Of --
-------------
......@@ -270,7 +286,7 @@ package body Ada.Calendar is
procedure Cvt_Vectim (
Status : out Unsigned_Longword;
Input_Time : in Unsigned_Word_Array;
Input_Time : Unsigned_Word_Array;
Resultant_Time : out Time);
pragma Interface (External, Cvt_Vectim);
......@@ -358,4 +374,43 @@ package body Ada.Calendar is
return DY;
end Year;
-------------------
-- Leap_Sec_Ops --
-------------------
-- The package that is used by the Ada 2005 children of Ada.Calendar:
-- Ada.Calendar.Arithmetic and Ada.Calendar.Formatting.
package body Leap_Sec_Ops is
--------------------------
-- Cumulative_Leap_Secs --
--------------------------
procedure Cumulative_Leap_Secs
(Start_Date : Time;
End_Date : Time;
Leaps_Between : out Duration;
Next_Leap_Sec : out Time)
is
begin
raise Unimplemented;
end Cumulative_Leap_Secs;
----------------------
-- All_Leap_Seconds --
----------------------
function All_Leap_Seconds return Duration is
begin
raise Unimplemented;
return 0.0;
end All_Leap_Seconds;
-- Start of processing in package Leap_Sec_Ops
begin
null;
end Leap_Sec_Ops;
end Ada.Calendar;
gcc/ada/a-calend-vms.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
......@@ -87,6 +87,8 @@ package Ada.Calendar is
Time_Error : exception;
Unimplemented : exception;
private
pragma Inline (Clock);
......@@ -118,4 +120,66 @@ private
-- Relative Time is positive, whereas relative OS_Time is negative,
-- but this declaration makes for easier conversion.
-- The following package provides handling of leap seconds. It is
-- used by Ada.Calendar.Arithmetic and Ada.Calendar.Formatting, both
-- Ada 2005 children of Ada.Calendar.
package Leap_Sec_Ops is
After_Last_Leap : constant Time := Time'Last;
-- Bigger by far than any leap second value. Not within range of
-- Ada.Calendar specified dates.
procedure Cumulative_Leap_Secs
(Start_Date : Time;
End_Date : Time;
Leaps_Between : out Duration;
Next_Leap_Sec : out Time);
-- Leaps_Between is the sum of the leap seconds that have occured
-- on or after Start_Date and before (strictly before) End_Date.
-- Next_Leap_Sec represents the next leap second occurence on or
-- after End_Date. If there are no leaps seconds after End_Date,
-- After_Last_Leap is returned. This does not provide info about
-- the next leap second (pos/neg or ?). After_Last_Leap can be used
-- as End_Date to count all the leap seconds that have occured on
-- or after Start_Date.
--
-- Important Notes: any fractional parts of Start_Date and End_Date
-- are discarded before the calculations are done. For instance: if
-- 113 seconds is a leap second (it isn't) and 113.5 is input as an
-- End_Date, the leap second at 113 will not be counted in
-- Leaps_Between, but it will be returned as Next_Leap_Sec. Thus, if
-- the caller wants to know if the End_Date is a leap second, the
-- comparison should be:
--
-- End_Date >= Next_Leap_Sec;
--
-- After_Last_Leap is designed so that this comparison works without
-- having to first check if Next_Leap_Sec is a valid leap second.
function All_Leap_Seconds return Duration;
-- Returns the sum off all of the leap seoncds.
end Leap_Sec_Ops;
procedure Split_With_Offset
(Date : Time;
Year : out Year_Number;
Month : out Month_Number;
Day : out Day_Number;
Seconds : out Day_Duration;
Offset : out Long_Integer);
-- Split_W_Offset has the same spec as Split with the addition of an
-- offset value which give the offset of the local time zone from UTC
-- at the input Date. This value comes for free during the implementation
-- of Split and is needed by UTC_Time_Offset. The returned Offset time
-- is straight from the C tm struct and is in seconds. If the system
-- dependent code has no way to find the offset it will return the value
-- Invalid_TZ_Offset declared below. Otherwise no checking is done, so
-- it is up to the user to check both for Invalid_TZ_Offset and otherwise
-- for a value that is acceptable.
Invalid_TZ_Offset : Long_Integer;
pragma Import (C, Invalid_TZ_Offset, "__gnat_invalid_tzoff");
end Ada.Calendar;
gcc/ada/a-calend.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, Free Software Foundation, 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- --
......@@ -54,9 +54,10 @@ package body Ada.Calendar is
-- Local Declarations --
------------------------
type Char_Pointer is access Character;
subtype int is Integer;
type char_Pointer is access Character;
subtype int is Integer;
subtype long is Long_Integer;
type long_Pointer is access all long;
-- Synonyms for C types. We don't want to get them from Interfaces.C
-- because there is no point in loading that unit just for calendar.
......@@ -71,7 +72,7 @@ package body Ada.Calendar is
tm_yday : int; -- days since January 1 (0 .. 365)
tm_isdst : int; -- Daylight Savings Time flag (-1 .. +1)
tm_gmtoff : long; -- offset from CUT in seconds
tm_zone : Char_Pointer; -- timezone abbreviation
tm_zone : char_Pointer; -- timezone abbreviation
end record;
type tm_Pointer is access all tm;
......@@ -80,8 +81,15 @@ package body Ada.Calendar is
type time_t_Pointer is access all time_t;
procedure localtime_r (C : time_t_Pointer; res : tm_Pointer);
pragma Import (C, localtime_r, "__gnat_localtime_r");
procedure localtime_tzoff
(C : time_t_Pointer;
res : tm_Pointer;
off : long_Pointer);
pragma Import (C, localtime_tzoff, "__gnat_localtime_tzoff");
-- This is a lightweight wrapper around the system library localtime_r
-- function. Parameter 'off' captures the UTC offset which is either
-- retrieved from the tm struct or calculated from the 'timezone' extern
-- and the tm_isdst flag in the tm struct.
function mktime (TM : tm_Pointer) return time_t;
pragma Import (C, mktime);
......@@ -260,6 +268,24 @@ package body Ada.Calendar is
Day : out Day_Number;
Seconds : out Day_Duration)
is
Offset : Long_Integer;
begin
Split_With_Offset (Date, Year, Month, Day, Seconds, Offset);
end Split;
-----------------------
-- Split_With_Offset --
-----------------------
procedure Split_With_Offset
(Date : Time;
Year : out Year_Number;
Month : out Month_Number;
Day : out Day_Number;
Seconds : out Day_Duration;
Offset : out Long_Integer)
is
-- The following declare bounds for duration that are comfortably
-- wider than the maximum allowed output result for the Ada range
-- of representable split values. These are used for a quick check
......@@ -273,11 +299,12 @@ package body Ada.Calendar is
-- Finally the actual variables used in the computation
Adjusted_Seconds : aliased time_t;
D : Duration;
Frac_Sec : Duration;
Year_Val : Integer;
Adjusted_Seconds : aliased time_t;
Local_Offset : aliased long;
Tm_Val : aliased tm;
Year_Val : Integer;
begin
-- For us a time is simply a signed duration value, so we work with
......@@ -331,23 +358,26 @@ package body Ada.Calendar is
type D_Int is range 0 .. 2 ** (Duration'Size - 1) - 1;
for D_Int'Size use Duration'Size;
Small_Div : constant D_Int := D_Int (1.0 / Duration'Small);
D_As_Int : D_Int;
function To_D_As_Int is new Unchecked_Conversion (Duration, D_Int);
function To_D_Int is new Unchecked_Conversion (Duration, D_Int);
function To_Duration is new Unchecked_Conversion (D_Int, Duration);
D_As_Int : constant D_Int := To_D_Int (D);
Small_Div : constant D_Int := D_Int (1.0 / Duration'Small);
begin
D_As_Int := To_D_As_Int (D);
Adjusted_Seconds := time_t (D_As_Int / Small_Div);
Frac_Sec := To_Duration (D_As_Int rem Small_Div);
end;
localtime_r (Adjusted_Seconds'Unchecked_Access, Tm_Val'Unchecked_Access);
localtime_tzoff
(Adjusted_Seconds'Unchecked_Access,
Tm_Val'Unchecked_Access,
Local_Offset'Unchecked_Access);
Year_Val := Tm_Val.tm_year + 1900 + Year_Val;
Month := Tm_Val.tm_mon + 1;
Day := Tm_Val.tm_mday;
Offset := Long_Integer (Local_Offset);
-- The Seconds value is a little complex. The localtime function
-- returns the integral number of seconds, which is what we want, but
......@@ -375,7 +405,7 @@ package body Ada.Calendar is
else
Year := Year_Val;
end if;
end Split;
end Split_With_Offset;
-------------
-- Time_Of --
......@@ -444,6 +474,20 @@ package body Ada.Calendar is
TM_Val.tm_year := Year_Val - 1900;
-- If time is very close to UNIX epoch mktime may behave uncorrectly
-- because of the way the different time zones are handled (a date
-- after epoch in a given time zone may correspond to a GMT date
-- before epoch). Adding one day to the date (this amount is latter
-- substracted) avoids this problem.
if Year_Val = Unix_Year_Min
and then Month = 1
and then Day = 1
then
TM_Val.tm_mday := TM_Val.tm_mday + 1;
Duration_Adjust := Duration_Adjust - Duration (86400.0);
end if;
-- Since we do not have information on daylight savings, rely on the
-- default information.
......@@ -476,6 +520,186 @@ package body Ada.Calendar is
return DY;
end Year;
-------------------
-- Leap_Sec_Ops --
-------------------
-- The package that is used by the Ada 2005 children of Ada.Calendar:
-- Ada.Calendar.Arithmetic and Ada.Calendar.Formatting.
package body Leap_Sec_Ops is
-- This package must be updated when leap seconds are added. Adding a
-- leap second requires incrementing the value of N_Leap_Secs and adding
-- the day of the new leap second to the end of Leap_Second_Dates.
-- Elaboration of the Leap_Sec_Ops package takes care of converting the
-- Leap_Second_Dates table to a form that is better suited for the
-- procedures provided by this package (a table that would be more
-- difficult to maintain by hand).
N_Leap_Secs : constant := 23;
type Leap_Second_Date is record
Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
end record;
Leap_Second_Dates :
constant array (1 .. N_Leap_Secs) of Leap_Second_Date :=
((1972, 6, 30), (1972, 12, 31), (1973, 12, 31), (1974, 12, 31),
(1975, 12, 31), (1976, 12, 31), (1977, 12, 31), (1978, 12, 31),
(1979, 12, 31), (1981, 6, 30), (1982, 6, 30), (1983, 6, 30),
(1985, 6, 30), (1987, 12, 31), (1989, 12, 31), (1990, 12, 31),
(1992, 6, 30), (1993, 6, 30), (1994, 6, 30), (1995, 12, 31),
(1997, 6, 30), (1998, 12, 31), (2005, 12, 31));
Leap_Second_Times : array (1 .. N_Leap_Secs) of Time;
-- This is the needed internal representation that is calculated
-- from Leap_Second_Dates during elaboration;
--------------------------
-- Cumulative_Leap_Secs --
--------------------------
procedure Cumulative_Leap_Secs
(Start_Date : Time;
End_Date : Time;
Leaps_Between : out Duration;
Next_Leap_Sec : out Time)
is
End_T : Time;
K : Positive;
Leap_Index : Positive;
Start_Tmp : Time;
Start_T : Time;
type D_Int is range 0 .. 2 ** (Duration'Size - 1) - 1;
for D_Int'Size use Duration'Size;
Small_Div : constant D_Int := D_Int (1.0 / Duration'Small);
D_As_Int : D_Int;
function To_D_As_Int is new Unchecked_Conversion (Duration, D_Int);
begin
Next_Leap_Sec := After_Last_Leap;
-- We want to throw away the fractional part of seconds. Before
-- proceding with this operation, make sure our working values
-- are non-negative.
if End_Date < 0.0 then
Leaps_Between := 0.0;
return;
end if;
if Start_Date < 0.0 then
Start_Tmp := Time (0.0);
else
Start_Tmp := Start_Date;
end if;
if Start_Date <= Leap_Second_Times (N_Leap_Secs) then
-- Manipulate the fixed point value as an integer, similar to
-- Ada.Calendar.Split in order to remove the fractional part
-- from the time we will work with, Start_T and End_T.
D_As_Int := To_D_As_Int (Duration (Start_Tmp));
D_As_Int := D_As_Int / Small_Div;
Start_T := Time (D_As_Int);
D_As_Int := To_D_As_Int (Duration (End_Date));
D_As_Int := D_As_Int / Small_Div;
End_T := Time (D_As_Int);
Leap_Index := 1;
loop
exit when Leap_Second_Times (Leap_Index) >= Start_T;
Leap_Index := Leap_Index + 1;
end loop;
K := Leap_Index;
loop
exit when K > N_Leap_Secs or else
Leap_Second_Times (K) >= End_T;
K := K + 1;
end loop;
if K <= N_Leap_Secs then
Next_Leap_Sec := Leap_Second_Times (K);
end if;
Leaps_Between := Duration (K - Leap_Index);
else
Leaps_Between := Duration (0.0);
end if;
end Cumulative_Leap_Secs;
----------------------
-- All_Leap_Seconds --
----------------------
function All_Leap_Seconds return Duration is
begin
return Duration (N_Leap_Secs);
-- Presumes each leap second is +1.0 second;
end All_Leap_Seconds;
-- Start of processing in package Leap_Sec_Ops
begin
declare
Days : Natural;
Is_Leap_Year : Boolean;
Years : Natural;
Cumulative_Days_Before_Month :
constant array (Month_Number) of Natural :=
(0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334);
begin
for J in 1 .. N_Leap_Secs loop
Years := Leap_Second_Dates (J).Year - Unix_Year_Min;
Days := (Years / 4) * Days_In_4_Years;
Years := Years mod 4;
Is_Leap_Year := False;
if Years = 1 then
Days := Days + 365;
elsif Years = 2 then
Is_Leap_Year := True;
-- 1972 or multiple of 4 after
Days := Days + 365 * 2;
elsif Years = 3 then
Days := Days + 365 * 3 + 1;
end if;
Days := Days + Cumulative_Days_Before_Month
(Leap_Second_Dates (J).Month);
if Is_Leap_Year
and then Leap_Second_Dates (J).Month > 2
then
Days := Days + 1;
end if;
Days := Days + Leap_Second_Dates (J).Day;
Leap_Second_Times (J) :=
Time (Days * Duration (86_400.0) + Duration (J - 1));
-- Add one to get to the leap second. Add J - 1 previous
-- leap seconds.
end loop;
end;
end Leap_Sec_Ops;
begin
System.OS_Primitives.Initialize;
end Ada.Calendar;
gcc/ada/a-calend.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
......@@ -127,4 +127,66 @@ private
type Time is new Duration;
-- The following package provides handling of leap seconds. It is
-- used by Ada.Calendar.Arithmetic and Ada.Calendar.Formatting, both
-- Ada 2005 children of Ada.Calendar.
package Leap_Sec_Ops is
After_Last_Leap : constant Time := Time'Last;
-- Bigger by far than any leap second value. Not within range of
-- Ada.Calendar specified dates.
procedure Cumulative_Leap_Secs
(Start_Date : Time;
End_Date : Time;
Leaps_Between : out Duration;
Next_Leap_Sec : out Time);
-- Leaps_Between is the sum of the leap seconds that have occured
-- on or after Start_Date and before (strictly before) End_Date.
-- Next_Leap_Sec represents the next leap second occurence on or
-- after End_Date. If there are no leaps seconds after End_Date,
-- After_Last_Leap is returned. This does not provide info about
-- the next leap second (pos/neg or ?). After_Last_Leap can be used
-- as End_Date to count all the leap seconds that have occured on
-- or after Start_Date.
--
-- Important Notes: any fractional parts of Start_Date and End_Date
-- are discarded before the calculations are done. For instance: if
-- 113 seconds is a leap second (it isn't) and 113.5 is input as an
-- End_Date, the leap second at 113 will not be counted in
-- Leaps_Between, but it will be returned as Next_Leap_Sec. Thus, if
-- the caller wants to know if the End_Date is a leap second, the
-- comparison should be:
--
-- End_Date >= Next_Leap_Sec;
--
-- After_Last_Leap is designed so that this comparison works without
-- having to first check if Next_Leap_Sec is a valid leap second.
function All_Leap_Seconds return Duration;
-- Returns the sum off all of the leap seoncds.
end Leap_Sec_Ops;
procedure Split_With_Offset
(Date : Time;
Year : out Year_Number;
Month : out Month_Number;
Day : out Day_Number;
Seconds : out Day_Duration;
Offset : out Long_Integer);
-- Split_W_Offset has the same spec as Split with the addition of an
-- offset value which give the offset of the local time zone from UTC
-- at the input Date. This value comes for free during the implementation
-- of Split and is needed by UTC_Time_Offset. The returned Offset time
-- is straight from the C tm struct and is in seconds. If the system
-- dependent code has no way to find the offset it will return the value
-- Invalid_TZ_Offset declared below. Otherwise no checking is done, so
-- it is up to the user to check both for Invalid_TZ_Offset and otherwise
-- for a value that is acceptable.
Invalid_TZ_Offset : Long_Integer;
pragma Import (C, Invalid_TZ_Offset, "__gnat_invalid_tzoff");
end Ada.Calendar;
gcc/ada/a-calfor.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . C A L E N D A R . F O R M A T T I N G --
-- --
-- B o d y --
-- --
-- Copyright (C) 2006, Free Software Foundation, 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. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Ada.Calendar; use Ada.Calendar;
with Ada.Calendar.Time_Zones; use Ada.Calendar.Time_Zones;
with Unchecked_Conversion;
package body Ada.Calendar.Formatting is
use Leap_Sec_Ops;
Days_In_4_Years : constant := 365 * 3 + 366;
Seconds_In_Day : constant := 86_400;
Seconds_In_4_Years : constant := Days_In_4_Years * Seconds_In_Day;
Seconds_In_Non_Leap_Year : constant := 365 * Seconds_In_Day;
-- Exact time bounds for the range of Ada time: January 1, 1901 -
-- December 31, 2099. These bounds are based on the Unix Time of Epoc,
-- January 1, 1970. Start of Time is -69 years from TOE while End of
-- time is +130 years and one second from TOE.
Start_Of_Time : constant Time :=
Time (-(17 * Seconds_In_4_Years +
Seconds_In_Non_Leap_Year));
End_Of_Time : constant Time :=
Time (32 * Seconds_In_4_Years +
2 * Seconds_In_Non_Leap_Year) +
All_Leap_Seconds;
Days_In_Month : constant array (Month_Number) of Day_Number :=
(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
procedure Check_Char (S : String; C : Character; Index : Integer);
-- Subsidiary to the two versions of Value. Determine whether the
-- input strint S has character C at position Index. Raise
-- Constraint_Error if there is a mismatch.
procedure Check_Digit (S : String; Index : Integer);
-- Subsidiary to the two versions of Value. Determine whether the
-- character of string S at position Index is a digit. This catches
-- invalid input such as 1983-*1-j3 u5:n7:k9 which should be
-- 1983-01-03 05:07:09. Raise Constraint_Error if there is a mismatch.
----------------
-- Check_Char --
----------------
procedure Check_Char (S : String; C : Character; Index : Integer) is
begin
if S (Index) /= C then
raise Constraint_Error;
end if;
end Check_Char;
-----------------
-- Check_Digit --
-----------------
procedure Check_Digit (S : String; Index : Integer) is
begin
if S (Index) not in '0' .. '9' then
raise Constraint_Error;
end if;
end Check_Digit;
---------
-- Day --
---------
function Day
(Date : Time;
Time_Zone : Time_Zones.Time_Offset := 0) return Day_Number
is
Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
Hour : Hour_Number;
Minute : Minute_Number;
Second : Second_Number;
Sub_Second : Second_Duration;
Leap_Second : Boolean;
begin
Split (Date, Year, Month, Day,
Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone);
return Day;
end Day;
-----------------
-- Day_Of_Week --
-----------------
function Day_Of_Week (Date : Time) return Day_Name is
Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
Hour : Hour_Number;
Minute : Minute_Number;
Second : Second_Number;
Sub_Second : Second_Duration;
Leap_Second : Boolean;
D : Duration;
Day_Count : Long_Long_Integer;
Midday_Date : Time;
Secs_Count : Long_Long_Integer;
begin
-- Split the Date to obtain the year, month and day, then build a time
-- value for the middle of the same day, so that we don't have to worry
-- about leap seconds in the subsequent arithmetic.
Split (Date, Year, Month, Day,
Hour, Minute, Second, Sub_Second, Leap_Second);
Midday_Date := Time_Of (Year, Month, Day, 12, 0, 0);
D := Midday_Date - Start_Of_Time;
-- D is a positive Duration value counting seconds since 1901. Convert
-- it into an integer for ease of arithmetic.
declare
type D_Int is range 0 .. 2 ** (Duration'Size - 1) - 1;
for D_Int'Size use Duration'Size;
function To_D_Int is new Unchecked_Conversion (Duration, D_Int);
D_As_Int : constant D_Int := To_D_Int (D);
Small_Div : constant D_Int := D_Int (1.0 / Duration'Small);
begin
Secs_Count := Long_Long_Integer (D_As_Int / Small_Div);
end;
Day_Count := Secs_Count / Seconds_In_Day;
Day_Count := Day_Count + 1; -- Jan 1, 1901 was a Tuesday;
return Day_Name'Val (Day_Count mod 7);
end Day_Of_Week;
----------
-- Hour --
----------
function Hour
(Date : Time;
Time_Zone : Time_Zones.Time_Offset := 0) return Hour_Number
is
Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
Hour : Hour_Number;
Minute : Minute_Number;
Second : Second_Number;
Sub_Second : Second_Duration;
Leap_Second : Boolean;
begin
Split (Date, Year, Month, Day,
Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone);
return Hour;
end Hour;
-----------
-- Image --
-----------
function Image
(Elapsed_Time : Duration;
Include_Time_Fraction : Boolean := False) return String
is
Hour : Hour_Number;
Minute : Minute_Number;
Second : Second_Number;
Sub_Second : Second_Duration;
SS_Nat : Natural;
Result : String := "00:00:00.00";
begin
Split (Elapsed_Time, Hour, Minute, Second, Sub_Second);
SS_Nat := Natural (Sub_Second * 100.0);
declare
Hour_Str : constant String := Hour_Number'Image (Hour);
Minute_Str : constant String := Minute_Number'Image (Minute);
Second_Str : constant String := Second_Number'Image (Second);
SS_Str : constant String := Natural'Image (SS_Nat);
begin
-- Hour processing, positions 1 and 2
if Hour < 10 then
Result (2) := Hour_Str (2);
else
Result (1) := Hour_Str (2);
Result (2) := Hour_Str (3);
end if;
-- Minute processing, positions 4 and 5
if Minute < 10 then
Result (5) := Minute_Str (2);
else
Result (4) := Minute_Str (2);
Result (5) := Minute_Str (3);
end if;
-- Second processing, positions 7 and 8
if Second < 10 then
Result (8) := Second_Str (2);
else
Result (7) := Second_Str (2);
Result (8) := Second_Str (3);
end if;
-- Optional sub second processing, positions 10 and 11
if Include_Time_Fraction then
if SS_Nat < 10 then
Result (11) := SS_Str (2);
else
Result (10) := SS_Str (2);
Result (11) := SS_Str (3);
end if;
return Result;
else
return Result (1 .. 8);
end if;
end;
end Image;
-----------
-- Image --
-----------
function Image
(Date : Time;
Include_Time_Fraction : Boolean := False;
Time_Zone : Time_Zones.Time_Offset := 0) return String
is
Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
Hour : Hour_Number;
Minute : Minute_Number;
Second : Second_Number;
Sub_Second : Second_Duration;
SS_Nat : Natural;
Leap_Second : Boolean;
Result : String := "0000-00-00 00:00:00.00";
begin
Split (Date, Year, Month, Day,
Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone);
SS_Nat := Natural (Sub_Second * 100.0);
declare
Year_Str : constant String := Year_Number'Image (Year);
Month_Str : constant String := Month_Number'Image (Month);
Day_Str : constant String := Day_Number'Image (Day);
Hour_Str : constant String := Hour_Number'Image (Hour);
Minute_Str : constant String := Minute_Number'Image (Minute);
Second_Str : constant String := Second_Number'Image (Second);
SS_Str : constant String := Natural'Image (SS_Nat);
begin
-- Year processing, positions 1, 2, 3 and 4
Result (1) := Year_Str (2);
Result (2) := Year_Str (3);
Result (3) := Year_Str (4);
Result (4) := Year_Str (5);
-- Month processing, positions 6 and 7
if Month < 10 then
Result (7) := Month_Str (2);
else
Result (6) := Month_Str (2);
Result (7) := Month_Str (3);
end if;
-- Day processing, positions 9 and 10
if Day < 10 then
Result (10) := Day_Str (2);
else
Result (9) := Day_Str (2);
Result (10) := Day_Str (3);
end if;
-- Hour processing, positions 12 and 13
if Hour < 10 then
Result (13) := Hour_Str (2);
else
Result (12) := Hour_Str (2);
Result (13) := Hour_Str (3);
end if;
-- Minute processing, positions 15 and 16
if Minute < 10 then
Result (16) := Minute_Str (2);
else
Result (15) := Minute_Str (2);
Result (16) := Minute_Str (3);
end if;
-- Second processing, positions 18 and 19
if Second < 10 then
Result (19) := Second_Str (2);
else
Result (18) := Second_Str (2);
Result (19) := Second_Str (3);
end if;
-- Optional sub second processing, positions 21 and 22
if Include_Time_Fraction then
if SS_Nat < 10 then
Result (22) := SS_Str (2);
else
Result (21) := SS_Str (2);
Result (22) := SS_Str (3);
end if;
return Result;
else
return Result (1 .. 19);
end if;
end;
end Image;
------------
-- Minute --
------------
function Minute
(Date : Time;
Time_Zone : Time_Zones.Time_Offset := 0) return Minute_Number
is
Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
Hour : Hour_Number;
Minute : Minute_Number;
Second : Second_Number;
Sub_Second : Second_Duration;
Leap_Second : Boolean;
begin
Split (Date, Year, Month, Day,
Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone);
return Minute;
end Minute;
-----------
-- Month --
-----------
function Month
(Date : Time;
Time_Zone : Time_Zones.Time_Offset := 0) return Month_Number
is
Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
Hour : Hour_Number;
Minute : Minute_Number;
Second : Second_Number;
Sub_Second : Second_Duration;
Leap_Second : Boolean;
begin
Split (Date, Year, Month, Day,
Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone);
return Month;
end Month;
------------
-- Second --
------------
function Second (Date : Time) return Second_Number is
Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
Hour : Hour_Number;
Minute : Minute_Number;
Second : Second_Number;
Sub_Second : Second_Duration;
Leap_Second : Boolean;
begin
Split (Date, Year, Month, Day,
Hour, Minute, Second, Sub_Second, Leap_Second);
return Second;
end Second;
----------------
-- Seconds_Of --
----------------
function Seconds_Of
(Hour : Hour_Number;
Minute : Minute_Number;
Second : Second_Number := 0;
Sub_Second : Second_Duration := 0.0) return Day_Duration is
begin
-- Validity checks
if not Hour'Valid
or else not Minute'Valid
or else not Second'Valid
or else not Sub_Second'Valid
then
raise Constraint_Error;
end if;
return Day_Duration (Hour * 3600) +
Day_Duration (Minute * 60) +
Day_Duration (Second) +
Sub_Second;
end Seconds_Of;
-----------
-- Split --
-----------
procedure Split
(Seconds : Day_Duration;
Hour : out Hour_Number;
Minute : out Minute_Number;
Second : out Second_Number;
Sub_Second : out Second_Duration)
is
Secs : Natural;
begin
-- Validity checks
if not Seconds'Valid then
raise Constraint_Error;
end if;
if Seconds = 0.0 then
Secs := 0;
else
Secs := Natural (Seconds - 0.5);
end if;
Sub_Second := Second_Duration (Seconds - Day_Duration (Secs));
Hour := Hour_Number (Secs / 3600);
Secs := Secs mod 3600;
Minute := Minute_Number (Secs / 60);
Second := Second_Number (Secs mod 60);
end Split;
-----------
-- Split --
-----------
procedure Split
(Date : Time;
Year : out Year_Number;
Month : out Month_Number;
Day : out Day_Number;
Seconds : out Day_Duration;
Leap_Second : out Boolean;
Time_Zone : Time_Zones.Time_Offset := 0)
is
Hour : Hour_Number;
Minute : Minute_Number;
Second : Second_Number;
Sub_Second : Second_Duration;
begin
Split (Date, Year, Month, Day,
Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone);
Seconds := Seconds_Of (Hour, Minute, Second, Sub_Second);
end Split;
-----------
-- Split --
-----------
procedure Split
(Date : Time;
Year : out Year_Number;
Month : out Month_Number;
Day : out Day_Number;
Hour : out Hour_Number;
Minute : out Minute_Number;
Second : out Second_Number;
Sub_Second : out Second_Duration;
Time_Zone : Time_Zones.Time_Offset := 0)
is
Leap_Second : Boolean;
begin
Split (Date, Year, Month, Day,
Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone);
end Split;
-----------
-- Split --
-----------
procedure Split
(Date : Time;
Year : out Year_Number;
Month : out Month_Number;
Day : out Day_Number;
Hour : out Hour_Number;
Minute : out Minute_Number;
Second : out Second_Number;
Sub_Second : out Second_Duration;
Leap_Second : out Boolean;
Time_Zone : Time_Zones.Time_Offset := 0)
is
Ada_Year_Min : constant Year_Number := Year_Number'First;
Day_In_Year : Integer;
Day_Second : Integer;
Elapsed_Leaps : Duration;
Hour_Second : Integer;
In_Leap_Year : Boolean;
Modified_Date : Time;
Next_Leap : Time;
Remaining_Years : Integer;
Seconds_Count : Long_Long_Integer;
begin
-- Our measurement of time is the number of seconds that have elapsed
-- since the Unix TOE. To calculate a UTC date from this we do a
-- sequence of divides and mods to get the components of a date based
-- on 86,400 seconds in each day. Since, UTC time depends upon the
-- occasional insertion of leap seconds, the number of leap seconds
-- that have been added prior to the input time are then subtracted
-- from the previous calculation. In fact, it is easier to do the
-- subtraction first, so a more accurate discription of what is
-- actually done, is that the number of added leap seconds is looked
-- up using the input Time value, than that number of seconds is
-- subtracted before the sequence of divides and mods.
--
-- If the input date turns out to be a leap second, we don't add it to
-- date (we want to return 23:59:59) but we set the Leap_Second output
-- to true.
-- Is there a need to account for a difference from Unix time prior
-- to the first leap second ???
-- Step 1: Determine the number of leap seconds since the start
-- of Ada time and the input date as well as the next leap second
-- occurence and process accordingly.
Cumulative_Leap_Secs (Start_Of_Time, Date, Elapsed_Leaps, Next_Leap);
Leap_Second := Date >= Next_Leap;
Modified_Date := Date - Elapsed_Leaps;
if Leap_Second then
Modified_Date := Modified_Date - Duration (1.0);
end if;
-- Step 2: Process the time zone
Modified_Date := Modified_Date + Duration (Time_Zone * 60);
-- Step 3: Sanity check on the calculated date. Since the leap
-- seconds and the time zone have been eliminated, the result needs
-- to be within the range of Ada time.
if Modified_Date < Start_Of_Time
or else Modified_Date >= (End_Of_Time - All_Leap_Seconds)
then
raise Time_Error;
end if;
Modified_Date := Modified_Date - Start_Of_Time;
declare
type D_Int is range 0 .. 2 ** (Duration'Size - 1) - 1;
for D_Int'Size use Duration'Size;
function To_D_Int is new Unchecked_Conversion (Duration, D_Int);
function To_Duration is new Unchecked_Conversion (D_Int, Duration);
function To_Duration is new Unchecked_Conversion (Time, Duration);
D_As_Int : constant D_Int := To_D_Int (To_Duration (Modified_Date));
Small_Div : constant D_Int := D_Int (1.0 / Duration'Small);
begin
Seconds_Count := Long_Long_Integer (D_As_Int / Small_Div);
Sub_Second := Second_Duration
(To_Duration (D_As_Int rem Small_Div));
end;
-- Step 4: Calculate the number of years since the start of Ada time.
-- First consider sequences of four years, then the remaining years.
Year := Ada_Year_Min + 4 * Integer (Seconds_Count / Seconds_In_4_Years);
Seconds_Count := Seconds_Count mod Seconds_In_4_Years;
Remaining_Years := Integer (Seconds_Count / Seconds_In_Non_Leap_Year);
if Remaining_Years > 3 then
Remaining_Years := 3;
end if;
Year := Year + Remaining_Years;
-- Remove the seconds elapsed in those remaining years
Seconds_Count := Seconds_Count - Long_Long_Integer
(Remaining_Years * Seconds_In_Non_Leap_Year);
In_Leap_Year := (Year mod 4) = 0;
-- Step 5: Month and day processing. Determine the day to which the
-- remaining seconds map to.
Day_In_Year := Integer (Seconds_Count / Seconds_In_Day) + 1;
Month := 1;
if Day_In_Year > 31 then
Month := 2;
Day_In_Year := Day_In_Year - 31;
if Day_In_Year > 28
and then ((not In_Leap_Year)
or else Day_In_Year > 29)
then
Month := 3;
Day_In_Year := Day_In_Year - 28;
if In_Leap_Year then
Day_In_Year := Day_In_Year - 1;
end if;
while Day_In_Year > Days_In_Month (Month) loop
Day_In_Year := Day_In_Year - Days_In_Month (Month);
Month := Month + 1;
end loop;
end if;
end if;
-- Step 6: Hour, minute and second processing
Day := Day_In_Year;
Day_Second := Integer (Seconds_Count mod Seconds_In_Day);
Hour := Day_Second / 3600;
Hour_Second := Day_Second mod 3600;
Minute := Hour_Second / 60;
Second := Hour_Second mod 60;
end Split;
----------------
-- Sub_Second --
----------------
function Sub_Second (Date : Time) return Second_Duration is
Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
Hour : Hour_Number;
Minute : Minute_Number;
Second : Second_Number;
Sub_Second : Second_Duration;
Leap_Second : Boolean;
begin
Split (Date, Year, Month, Day,
Hour, Minute, Second, Sub_Second, Leap_Second);
return Sub_Second;
end Sub_Second;
-------------
-- Time_Of --
-------------
function Time_Of
(Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
Seconds : Day_Duration := 0.0;
Leap_Second : Boolean := False;
Time_Zone : Time_Zones.Time_Offset := 0) return Time
is
Hour : Hour_Number;
Minute : Minute_Number;
Sec_Num : Second_Number;
Sub_Sec : Second_Duration;
Whole_Part : Integer;
begin
if not Seconds'Valid then
raise Constraint_Error;
end if;
-- The fact that Seconds can go to 86,400 creates all this extra work.
-- Perhaps a Time_Of just like the next one but allowing the Second_
-- Number input to reach 60 should become an internal version that this
-- and the next version call.... but for now we do the ugly bumping up
-- of Day, Month and Year;
if Seconds = 86_400.0 then
declare
Adj_Year : Year_Number := Year;
Adj_Month : Month_Number := Month;
Adj_Day : Day_Number := Day;
begin
Hour := 0;
Minute := 0;
Sec_Num := 0;
Sub_Sec := 0.0;
if Day < Days_In_Month (Month)
or else (Month = 2
and then Year mod 4 = 0)
then
Adj_Day := Day + 1;
else
Adj_Day := 1;
if Month < 12 then
Adj_Month := Month + 1;
else
Adj_Month := 1;
Adj_Year := Year + 1;
end if;
end if;
return Time_Of (Adj_Year, Adj_Month, Adj_Day, Hour, Minute,
Sec_Num, Sub_Sec, Leap_Second, Time_Zone);
end;
end if;
declare
type D_Int is range 0 .. 2 ** (Duration'Size - 1) - 1;
for D_Int'Size use Duration'Size;
function To_D_Int is new Unchecked_Conversion (Duration, D_Int);
function To_Duration is new Unchecked_Conversion (D_Int, Duration);
D_As_Int : constant D_Int := To_D_Int (Seconds);
Small_Div : constant D_Int := D_Int (1.0 / Duration'Small);
begin
Whole_Part := Integer (D_As_Int / Small_Div);
Sub_Sec := Second_Duration
(To_Duration (D_As_Int rem Small_Div));
end;
Hour := Hour_Number (Whole_Part / 3600);
Whole_Part := Whole_Part mod 3600;
Minute := Minute_Number (Whole_Part / 60);
Sec_Num := Second_Number (Whole_Part mod 60);
return Time_Of (Year, Month, Day,
Hour, Minute, Sec_Num, Sub_Sec, Leap_Second, Time_Zone);
end Time_Of;
-------------
-- Time_Of --
-------------
function Time_Of
(Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
Hour : Hour_Number;
Minute : Minute_Number;
Second : Second_Number;
Sub_Second : Second_Duration := 0.0;
Leap_Second : Boolean := False;
Time_Zone : Time_Zones.Time_Offset := 0) return Time
is
Cumulative_Days_Before_Month :
constant array (Month_Number) of Natural :=
(0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334);
Ada_Year_Min : constant Year_Number := Year_Number'First;
Count : Integer;
Elapsed_Leap_Seconds : Duration;
Fractional_Second : Duration;
Next_Leap : Time;
Result : Time;
begin
-- The following checks are redundant with respect to the constraint
-- error checks that should normally be made on parameters, but we
-- decide to raise Constraint_Error in any case if bad values come in
-- (as a result of checks being off in the caller, or for other
-- erroneous or bounded error cases).
if not Year'Valid
or else not Month'Valid
or else not Day'Valid
or else not Hour'Valid
or else not Minute'Valid
or else not Second'Valid
or else not Sub_Second'Valid
or else not Time_Zone'Valid
then
raise Constraint_Error;
end if;
-- Start the accumulation from the beginning of Ada time
Result := Start_Of_Time;
-- Step 1: Determine the number of leap and non-leap years since 1901
-- and the input date.
-- Count the number of four year segments
Count := (Year - Ada_Year_Min) / 4;
Result := Result + Duration (Count * Seconds_In_4_Years);
-- Count the number of remaining non-leap years
Count := (Year - Ada_Year_Min) mod 4;
Result := Result + Duration (Count * Seconds_In_Non_Leap_Year);
-- Step 2: Determine the number of days elapsed singe the start of the
-- input year and add them to the result.
-- Do not include the current day since it is not over yet
Count := Cumulative_Days_Before_Month (Month) + Day - 1;
-- The input year is a leap year and we have passed February
if (Year mod 4) = 0
and then Month > 2
then
Count := Count + 1;
end if;
Result := Result + Duration (Count * Seconds_In_Day);
-- Step 3: Hour, minute and second processing
Result := Result + Duration (Hour * 3600) +
Duration (Minute * 60) +
Duration (Second);
-- The sub second may designate a whole second
if Sub_Second = 1.0 then
Result := Result + Duration (1.0);
Fractional_Second := 0.0;
else
Fractional_Second := Sub_Second;
end if;
-- Step 4: Time zone processing
Result := Result - Duration (Time_Zone * 60);
-- Step 5: The caller wants a leap second
if Leap_Second then
Result := Result + Duration (1.0);
end if;
-- Step 6: Calculate the number of leap seconds occured since the
-- start of Ada time and the current point in time. The following
-- is an approximation which does not yet count leap seconds. It
-- can be pushed beyond 1 leap second, but not more.
Cumulative_Leap_Secs
(Start_Of_Time, Result, Elapsed_Leap_Seconds, Next_Leap);
Result := Result + Elapsed_Leap_Seconds;
-- Step 7: Validity check of a leap second occurence. It requires an
-- additional comparison to Next_Leap to ensure that we landed right
-- on a valid occurence and that Elapsed_Leap_Seconds did not shoot
-- past it.
if Leap_Second
and then
not (Result >= Next_Leap
and then Result - Duration (1.0) < Next_Leap)
then
raise Time_Error;
end if;
-- Step 8: Final sanity check on the calculated duration value
if Result < Start_Of_Time
or else Result >= End_Of_Time
then
raise Time_Error;
end if;
-- Step 9: Lastly, add the sub second part
return Result + Fractional_Second;
end Time_Of;
-----------
-- Value --
-----------
function Value
(Date : String;
Time_Zone : Time_Zones.Time_Offset := 0) return Time
is
D : String (1 .. 22);
Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
Hour : Hour_Number;
Minute : Minute_Number;
Second : Second_Number;
Sub_Second : Second_Duration := 0.0;
begin
-- Validity checks
if not Time_Zone'Valid then
raise Constraint_Error;
end if;
-- Length checks
if Date'Length /= 19
and then Date'Length /= 22
then
raise Constraint_Error;
end if;
-- After the correct length has been determined, it is safe to
-- copy the Date in order to avoid Date'First + N indexing.
D (1 .. Date'Length) := Date;
-- Format checks
Check_Char (D, '-', 5);
Check_Char (D, '-', 8);
Check_Char (D, ' ', 11);
Check_Char (D, ':', 14);
Check_Char (D, ':', 17);
if Date'Length = 22 then
Check_Char (D, '.', 20);
end if;
-- Leading zero checks
Check_Digit (D, 6);
Check_Digit (D, 9);
Check_Digit (D, 12);
Check_Digit (D, 15);
Check_Digit (D, 18);
if Date'Length = 22 then
Check_Digit (D, 21);
end if;
-- Value extraction
Year := Year_Number (Year_Number'Value (D (1 .. 4)));
Month := Month_Number (Month_Number'Value (D (6 .. 7)));
Day := Day_Number (Day_Number'Value (D (9 .. 10)));
Hour := Hour_Number (Hour_Number'Value (D (12 .. 13)));
Minute := Minute_Number (Minute_Number'Value (D (15 .. 16)));
Second := Second_Number (Second_Number'Value (D (18 .. 19)));
-- Optional part
if Date'Length = 22 then
Sub_Second := Second_Duration (Second_Duration'Value (D (20 .. 22)));
end if;
-- Sanity checks
if not Year'Valid
or else not Month'Valid
or else not Day'Valid
or else not Hour'Valid
or else not Minute'Valid
or else not Second'Valid
or else not Sub_Second'Valid
then
raise Constraint_Error;
end if;
return Time_Of (Year, Month, Day,
Hour, Minute, Second, Sub_Second, False, Time_Zone);
exception
when others => raise Constraint_Error;
end Value;
-----------
-- Value --
-----------
function Value (Elapsed_Time : String) return Duration is
D : String (1 .. 11);
Hour : Hour_Number;
Minute : Minute_Number;
Second : Second_Number;
Sub_Second : Second_Duration := 0.0;
begin
-- Length checks
if Elapsed_Time'Length /= 8
and then Elapsed_Time'Length /= 11
then
raise Constraint_Error;
end if;
-- After the correct length has been determined, it is safe to
-- copy the Elapsed_Time in order to avoid Date'First + N indexing.
D (1 .. Elapsed_Time'Length) := Elapsed_Time;
-- Format checks
Check_Char (D, ':', 3);
Check_Char (D, ':', 6);
if Elapsed_Time'Length = 11 then
Check_Char (D, '.', 9);
end if;
-- Leading zero checks
Check_Digit (D, 1);
Check_Digit (D, 4);
Check_Digit (D, 7);
if Elapsed_Time'Length = 11 then
Check_Digit (D, 10);
end if;
-- Value extraction
Hour := Hour_Number (Hour_Number'Value (D (1 .. 2)));
Minute := Minute_Number (Minute_Number'Value (D (4 .. 5)));
Second := Second_Number (Second_Number'Value (D (7 .. 8)));
-- Optional part
if Elapsed_Time'Length = 11 then
Sub_Second := Second_Duration (Second_Duration'Value (D (9 .. 11)));
end if;
-- Sanity checks
if not Hour'Valid
or else not Minute'Valid
or else not Second'Valid
or else not Sub_Second'Valid
then
raise Constraint_Error;
end if;
return Seconds_Of (Hour, Minute, Second, Sub_Second);
exception
when others => raise Constraint_Error;
end Value;
----------
-- Year --
----------
function Year
(Date : Time;
Time_Zone : Time_Zones.Time_Offset := 0) return Year_Number
is
Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
Hour : Hour_Number;
Minute : Minute_Number;
Second : Second_Number;
Sub_Second : Second_Duration;
Leap_Second : Boolean;
begin
Split (Date, Year, Month, Day,
Hour, Minute, Second, Sub_Second, Leap_Second, Time_Zone);
return Year;
end Year;
end Ada.Calendar.Formatting;
gcc/ada/a-calfor.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . C A L E N D A R . F O R M A T T I N G --
-- --
-- S p e c --
-- --
-- Copyright (C) 2005 - 2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- apply solely to the contents of the part following the private keyword. --
-- --
-- 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. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Ada.Calendar.Time_Zones;
package Ada.Calendar.Formatting is
-- Day of the week
type Day_Name is
(Monday, Tuesday, Wednesday, Thursday, Friday, Saturday, Sunday);
function Day_Of_Week (Date : Time) return Day_Name;
-- Hours:Minutes:Seconds access
subtype Hour_Number is Natural range 0 .. 23;
subtype Minute_Number is Natural range 0 .. 59;
subtype Second_Number is Natural range 0 .. 59;
subtype Second_Duration is Day_Duration range 0.0 .. 1.0;
function Year
(Date : Time;
Time_Zone : Time_Zones.Time_Offset := 0) return Year_Number;
function Month
(Date : Time;
Time_Zone : Time_Zones.Time_Offset := 0) return Month_Number;
function Day
(Date : Time;
Time_Zone : Time_Zones.Time_Offset := 0) return Day_Number;
function Hour
(Date : Time;
Time_Zone : Time_Zones.Time_Offset := 0) return Hour_Number;
function Minute
(Date : Time;
Time_Zone : Time_Zones.Time_Offset := 0) return Minute_Number;
function Second
(Date : Time) return Second_Number;
function Sub_Second
(Date : Time) return Second_Duration;
function Seconds_Of
(Hour : Hour_Number;
Minute : Minute_Number;
Second : Second_Number := 0;
Sub_Second : Second_Duration := 0.0) return Day_Duration;
procedure Split
(Seconds : Day_Duration;
Hour : out Hour_Number;
Minute : out Minute_Number;
Second : out Second_Number;
Sub_Second : out Second_Duration);
procedure Split
(Date : Time;
Year : out Year_Number;
Month : out Month_Number;
Day : out Day_Number;
Hour : out Hour_Number;
Minute : out Minute_Number;
Second : out Second_Number;
Sub_Second : out Second_Duration;
Time_Zone : Time_Zones.Time_Offset := 0);
function Time_Of
(Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
Hour : Hour_Number;
Minute : Minute_Number;
Second : Second_Number;
Sub_Second : Second_Duration := 0.0;
Leap_Second : Boolean := False;
Time_Zone : Time_Zones.Time_Offset := 0) return Time;
function Time_Of
(Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
Seconds : Day_Duration := 0.0;
Leap_Second : Boolean := False;
Time_Zone : Time_Zones.Time_Offset := 0) return Time;
procedure Split
(Date : Time;
Year : out Year_Number;
Month : out Month_Number;
Day : out Day_Number;
Hour : out Hour_Number;
Minute : out Minute_Number;
Second : out Second_Number;
Sub_Second : out Second_Duration;
Leap_Second : out Boolean;
Time_Zone : Time_Zones.Time_Offset := 0);
procedure Split
(Date : Time;
Year : out Year_Number;
Month : out Month_Number;
Day : out Day_Number;
Seconds : out Day_Duration;
Leap_Second : out Boolean;
Time_Zone : Time_Zones.Time_Offset := 0);
-- Simple image and value
function Image
(Date : Time;
Include_Time_Fraction : Boolean := False;
Time_Zone : Time_Zones.Time_Offset := 0) return String;
function Value
(Date : String;
Time_Zone : Time_Zones.Time_Offset := 0) return Time;
function Image
(Elapsed_Time : Duration;
Include_Time_Fraction : Boolean := False) return String;
function Value (Elapsed_Time : String) return Duration;
end Ada.Calendar.Formatting;
gcc/ada/a-catizo.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . C A L E N D A R . T I M E _ Z O N E S --
-- --
-- B o d y --
-- --
-- Copyright (C) 2006, Free Software Foundation, 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. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
package body Ada.Calendar.Time_Zones is
---------------------
-- UTC_Time_Offset --
---------------------
function UTC_Time_Offset (Date : Time := Clock) return Time_Offset is
Year : Year_Number;
Month : Month_Number;
Day : Day_Number;
Seconds : Day_Duration;
Offset : Long_Integer;
begin
Split_With_Offset (Date, Year, Month, Day, Seconds, Offset);
-- The system dependent code does not support time zones
if Offset = Invalid_TZ_Offset then
raise Unknown_Zone_Error;
end if;
Offset := Offset / 60;
if Offset < Long_Integer (Time_Offset'First)
or else Offset > Long_Integer (Time_Offset'Last)
then
raise Unknown_Zone_Error;
end if;
return Time_Offset (Offset);
end UTC_Time_Offset;
end Ada.Calendar.Time_Zones;
gcc/ada/a-catizo.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . C A L E N D A R . T I M E _ Z O N E S --
-- --
-- S p e c --
-- --
-- Copyright (C) 2005 - 2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- apply solely to the contents of the part following the private keyword. --
-- --
-- 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. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
package Ada.Calendar.Time_Zones is
-- Time zone manipulation
type Time_Offset is range -(28 * 60) .. 28 * 60;
Unknown_Zone_Error : exception;
function UTC_Time_Offset (Date : Time := Clock) return Time_Offset;
end Ada.Calendar.Time_Zones;
gcc/ada/impunit.adb
......@@ -334,8 +334,10 @@ package body Impunit is
-- Ada Hierarchy Units from Ada 2005 Reference Manual --
--------------------------------------------------------
"a-calari", -- Ada.Calendar.Arithmetic
"a-calfor", -- Ada.Calendar.Formatting
"a-catizo", -- Ada.Calendar.Time_Zones
"a-cdlili", -- Ada.Containers.Doubly_Linked_Lists
"a-cgaaso", -- Ada.Containers.Generic_Anonymous_Array_Sort
"a-cgarso", -- Ada.Containers.Generic_Array_Sort
"a-cgcaso", -- Ada.Containers.Generic_Constrained_Array_Sort
"a-chacon", -- Ada.Characters.Conversions
......@@ -353,11 +355,10 @@ package body Impunit is
"a-coorse", -- Ada.Containers.Ordered_Sets
"a-coteio", -- Ada.Complex_Text_IO
"a-direct", -- Ada.Directories
"a-diroro", -- Ada.Dispatching.Round_Robin
"a-dispat", -- Ada.Dispatching
"a-envvar", -- Ada.Environment_Variables
"a-rttiev", -- Ada.Real_Time.Timing_Events
"a-secain", -- Ada.Strings.Equal_Case_Insensitive
"a-shcain", -- Ada.Strings.Hash_Case_Insensitive
"a-slcain", -- Ada.Strings.Less_Case_Insensitive
"a-stboha", -- Ada.Strings.Bounded.Hash
"a-stfiha", -- Ada.Strings.Fixed.Hash
"a-strhas", -- Ada.Strings.Hash
......@@ -383,6 +384,8 @@ package body Impunit is
"a-wwboio", -- Ada.Wide_Text_IO.Wide_Bounded_IO
"a-wwunio", -- Ada.Wide_Text_IO.Wide_Unbounded_IO
"a-zchara", -- Ada.Wide_Wide_Characters
"a-ztcoio", -- Ada.Wide_Wide_Text_IO.Complex_IO
"a-ztedit", -- Ada.Wide_Wide_Text_IO.Editing
"a-zttest", -- Ada.Wide_Wide_Text_IO.Text_Streams
"a-ztexio", -- Ada.Wide_Wide_Text_IO
"a-zzboio", -- Ada.Wide_Wide_Text_IO.Wide_Wide_Bounded_IO
......@@ -408,10 +411,15 @@ package body Impunit is
-- GNAT Defined Additions to Ada 2005 --
----------------------------------------
"a-cgaaso", -- Ada.Containers.Generic_Anonymous_Array_Sort
"a-chzla1", -- Ada.Characters.Wide_Wide_Latin_1
"a-chzla9", -- Ada.Characters.Wide_Wide_Latin_9
"a-ciormu", -- Ada.Containers.Indefinite_Ordered_Multisets
"a-coormu", -- Ada.Containers.Ordered_Multisets
"a-crdlli", -- Ada.Containers.Restricted_Doubly_Linked_Lists
"a-secain", -- Ada.Strings.Equal_Case_Insensitive
"a-shcain", -- Ada.Strings.Hash_Case_Insensitive
"a-slcain", -- Ada.Strings.Less_Case_Insensitive
"a-szuzti", -- Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Text_IO
"a-zchuni", -- Ada.Wide_Wide_Characters.Unicode
......
gcc/ada/sysdep.c
......@@ -44,7 +44,6 @@
#include "tsystem.h"
#include <fcntl.h>
#include <sys/stat.h>
#include <time.h>
#ifdef VMS
#include <unixio.h>
#endif
......@@ -53,6 +52,14 @@
#include "system.h"
#endif
#include <time.h>
#if defined (sun) && defined (__SVR4) && !defined (__vxworks)
/* The declaration is present in <time.h> but conditionalized
on a couple of macros we don't define. */
extern struct tm *localtime_r(const time_t *, struct tm *);
#endif
#include "adaint.h"
/*
......@@ -664,8 +671,6 @@ rts_get_nShowCmd (void)
/* This gets around a problem with using the old threads library on VMS 7.0. */
#include <time.h>
extern long get_gmtoff (void);
long
......@@ -680,27 +685,57 @@ get_gmtoff (void)
}
#endif
/* This value is returned as the time zone offset when a valid value
cannot be determined. It is simply a bizarre value that will never
occur. It is 3 days plus 73 seconds (offset is in seconds. */
long __gnat_invalid_tzoff = 259273;
/* Definition of __gnat_locatime_r used by a-calend.adb */
#if defined (__EMX__)
#if defined (__EMX__) || defined (__MINGW32__)
#ifdef CERT
/* For the Cert run times on native Windows we use dummy functions
for locking and unlocking tasks since we do not support multiple
threads on this configuration (Cert run time on native Windows). */
void dummy (void) {}
void (*Lock_Task) () = &dummy;
void (*Unlock_Task) () = &dummy;
#else
#define Lock_Task system__soft_links__lock_task
extern void (*Lock_Task) (void);
#define Unlock_Task system__soft_links__unlock_task
extern void (*Unlock_Task) (void);
/* Provide reentrant version of localtime on OS/2. */
#endif
/* Reentrant localtime for Windows and OS/2. */
extern struct tm *__gnat_localtime_r (const time_t *, struct tm *);
extern struct tm *
__gnat_localtime_tzoff (const time_t *, struct tm *, long *);
struct tm *
__gnat_localtime_r (const time_t *timer, struct tm *tp)
__gnat_localtime_tzoff (const time_t *timer, struct tm *tp, long *off)
{
DWORD dwRet;
struct tm *tmp;
TIME_ZONE_INFORMATION tzi;
(*Lock_Task) ();
tmp = localtime (timer);
memcpy (tp, tmp, sizeof (struct tm));
dwRet = GetTimeZoneInformation (&tzi);
*off = tzi.Bias;
if (tp->tm_isdst > 0)
*off = *off + tzi.DaylightBias;
*off = *off * -60;
(*Unlock_Task) ();
return tp;
}
......@@ -714,31 +749,51 @@ __gnat_localtime_r (const time_t *timer, struct tm *tp)
spec is required. Only use when ___THREADS_POSIX4ad4__ is defined,
the Lynx convention when building against the legacy API. */
extern struct tm *__gnat_localtime_r (const time_t *, struct tm *);
extern struct tm *
__gnat_localtime_tzoff (const time_t *, struct tm *, long *);
struct tm *
__gnat_localtime_r (const time_t *timer, struct tm *tp)
__gnat_localtime_tzoff (const time_t *timer, struct tm *tp, long *off)
{
localtime_r (tp, timer);
*off = __gnat_invalid_tzoff;
return NULL;
}
#else
#if defined (VMS) || defined (__MINGW32__)
#if defined (VMS)
/* __gnat_localtime_r is not needed on NT and VMS */
/* __gnat_localtime_tzoff is not needed on VMS */
#else
/* All other targets provide a standard localtime_r */
extern struct tm *__gnat_localtime_r (const time_t *, struct tm *);
extern struct tm *
__gnat_localtime_tzoff (const time_t *, struct tm *, long *);
struct tm *
__gnat_localtime_r (const time_t *timer, struct tm *tp)
__gnat_localtime_tzoff (const time_t *timer, struct tm *tp, long *off)
{
return (struct tm *) localtime_r (timer, tp);
localtime_r (timer, tp);
/* AIX, HPUX, SGI Irix, Sun Solaris */
#if defined (_AIX) || defined (__hpux__) || defined (sgi) || defined (sun)
*off = (long) -timezone;
if (tp->tm_isdst > 0)
*off = *off + 3600;
/* Lynx, VXWorks */
#elif defined (__Lynx__) || defined (__vxworks)
*off = __gnat_invalid_tzoff;
/* Darwin, Free BSD, Linux, Tru64 */
#else
*off = tp->tm_gmtoff;
#endif
return NULL;
}
#endif
#endif
#endif
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment