aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gcc/ada/a-calari.adb142
-rw-r--r--gcc/ada/a-calari.ads60
-rw-r--r--gcc/ada/a-calend-mingw.adb397
-rw-r--r--gcc/ada/a-calend-vms.adb61
-rw-r--r--gcc/ada/a-calend-vms.ads66
-rw-r--r--gcc/ada/a-calend.adb254
-rw-r--r--gcc/ada/a-calend.ads64
-rw-r--r--gcc/ada/a-calfor.adb1135
-rw-r--r--gcc/ada/a-calfor.ads163
-rw-r--r--gcc/ada/a-catizo.adb67
-rw-r--r--gcc/ada/a-catizo.ads48
-rw-r--r--gcc/ada/impunit.adb16
-rw-r--r--gcc/ada/sysdep.c83
13 files changed, 2121 insertions, 435 deletions
diff --git a/gcc/ada/a-calari.adb b/gcc/ada/a-calari.adb
new file mode 100644
index 0000000..de02a90
--- /dev/null
+++ b/gcc/ada/a-calari.adb
@@ -0,0 +1,142 @@
+------------------------------------------------------------------------------
+-- --
+-- 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;
diff --git a/gcc/ada/a-calari.ads b/gcc/ada/a-calari.ads
new file mode 100644
index 0000000..11c0e32
--- /dev/null
+++ b/gcc/ada/a-calari.ads
@@ -0,0 +1,60 @@
+------------------------------------------------------------------------------
+-- --
+-- 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;
diff --git a/gcc/ada/a-calend-mingw.adb b/gcc/ada/a-calend-mingw.adb
deleted file mode 100644
index 0ec1ca9..0000000
--- a/gcc/ada/a-calend-mingw.adb
+++ /dev/null
@@ -1,397 +0,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;
diff --git a/gcc/ada/a-calend-vms.adb b/gcc/ada/a-calend-vms.adb
index 2a5c70f..67a5697 100644
--- a/gcc/ada/a-calend-vms.adb
+++ b/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;
diff --git a/gcc/ada/a-calend-vms.ads b/gcc/ada/a-calend-vms.ads
index ed3c964..3f68ffb 100644
--- a/gcc/ada/a-calend-vms.ads
+++ b/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;
diff --git a/gcc/ada/a-calend.adb b/gcc/ada/a-calend.adb
index 5812958..02851ad 100644
--- a/gcc/ada/a-calend.adb
+++ b/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;
diff --git a/gcc/ada/a-calend.ads b/gcc/ada/a-calend.ads
index a394e2b..9f4e66a 100644
--- a/gcc/ada/a-calend.ads
+++ b/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;
diff --git a/gcc/ada/a-calfor.adb b/gcc/ada/a-calfor.adb
new file mode 100644
index 0000000..23d2ab5
--- /dev/null
+++ b/gcc/ada/a-calfor.adb
@@ -0,0 +1,1135 @@
+------------------------------------------------------------------------------
+-- --
+-- 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;
diff --git a/gcc/ada/a-calfor.ads b/gcc/ada/a-calfor.ads
new file mode 100644
index 0000000..89e704b
--- /dev/null
+++ b/gcc/ada/a-calfor.ads
@@ -0,0 +1,163 @@
+------------------------------------------------------------------------------
+-- --
+-- 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;
diff --git a/gcc/ada/a-catizo.adb b/gcc/ada/a-catizo.adb
new file mode 100644
index 0000000..8243e8b
--- /dev/null
+++ b/gcc/ada/a-catizo.adb
@@ -0,0 +1,67 @@
+------------------------------------------------------------------------------
+-- --
+-- 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;
diff --git a/gcc/ada/a-catizo.ads b/gcc/ada/a-catizo.ads
new file mode 100644
index 0000000..83907c4
--- /dev/null
+++ b/gcc/ada/a-catizo.ads
@@ -0,0 +1,48 @@
+------------------------------------------------------------------------------
+-- --
+-- 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;
diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb
index a720a28..e849797 100644
--- a/gcc/ada/impunit.adb
+++ b/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
diff --git a/gcc/ada/sysdep.c b/gcc/ada/sysdep.c
index 055c99f1..0562766 100644
--- a/gcc/ada/sysdep.c
+++ b/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