+2012-01-23 Robert Dewar <dewar@adacore.com>
+
+ * sprint.ads, sprint.adb (Sprint_Node_List): Add New_Lines parameter
+ (pg,po,ps): Make sure each entry starts on new line.
+
+2012-01-23 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * a-calend.ads, a-calend.adb: Define types int and int_Pointer. Update
+ the parameter profile of procedure localtime_tzoff and its associated
+ comment.
+ (Day_Of_Week): Do not treat the input date as historical
+ with respect to time zones.
+ (Split): Do not treat the input
+ date as historical with respect to time zones. (Time_Of): Do
+ not treat the input constituents as forming a historical date
+ with respect to time zones.
+ (UTC_Time_Offset): Add new formal
+ parameter Is_Historic. Add local variable Flag. Update the call
+ to localtime_tzoff.
+ * a-catizo.ads, a-catizo.adb (UTC_Time_Offset): New routine.
+ (UTC_Time_Offset (Time)): Update the call to
+ Time_Zone_Operations.UTC_Time_Offset.
+ * sysdep.c (__gnat_localtime_tzoff): Update parameter
+ profile. Split the processing of offsets on Windows into two - one
+ part of historic time stamps and the other for the current time.
+
2012-01-23 Robert Dewar <dewar@adacore.com>
* a-calend.adb: Minor reformatting.
function Day_Of_Week (Date : Time) return Integer is
Date_N : constant Time_Rep := Time_Rep (Date);
Time_Zone : constant Long_Integer :=
- Time_Zones_Operations.UTC_Time_Offset (Date);
+ Time_Zones_Operations.UTC_Time_Offset
+ (Date => Date,
+ Is_Historic => False);
+
Ada_Low_N : Time_Rep;
Day_Count : Long_Integer;
Day_Dur : Time_Dur;
else
declare
Off : constant Long_Integer :=
- Time_Zones_Operations.UTC_Time_Offset (Time (Date_N));
+ Time_Zones_Operations.UTC_Time_Offset
+ (Date => Time (Date_N),
+ Is_Historic => False);
begin
Date_N := Date_N + Time_Rep (Off) * Nano;
end;
declare
Current_Off : constant Long_Integer :=
Time_Zones_Operations.UTC_Time_Offset
- (Time (Res_N));
+ (Date => Time (Res_N),
+ Is_Historic => False);
Current_Res_N : constant Time_Rep :=
Res_N - Time_Rep (Current_Off) * Nano;
Off : constant Long_Integer :=
Time_Zones_Operations.UTC_Time_Offset
- (Time (Current_Res_N));
+ (Date => Time (Current_Res_N),
+ Is_Historic => False);
begin
Res_N := Res_N - Time_Rep (Off) * Nano;
end;
Nanos_In_56_Years : constant := (14 * 366 + 42 * 365) * Nanos_In_Day;
subtype long is Long_Integer;
+ subtype int is Integer;
type long_Pointer is access all long;
+ type int_Pointer is access all int;
type time_t is
range -(2 ** (Standard'Address_Size - Integer'(1))) ..
type time_t_Pointer is access all time_t;
procedure localtime_tzoff
- (timer : time_t_Pointer;
- off : long_Pointer);
+ (timer : time_t_Pointer;
+ is_historic : int_Pointer;
+ off : long_Pointer);
pragma Import (C, localtime_tzoff, "__gnat_localtime_tzoff");
-- This is a lightweight wrapper around the system library function
-- localtime_r. 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.
+ -- and the tm_isdst flag in the tm struct. Flag 'is_historic' denotes
+ -- whether 'timer' is a historical time stamp. If this is not the case,
+ -- the routine returns the offset of the local time zone.
---------------------
-- UTC_Time_Offset --
---------------------
- function UTC_Time_Offset (Date : Time) return Long_Integer is
+ function UTC_Time_Offset
+ (Date : Time;
+ Is_Historic : Boolean := True) return Long_Integer
+ is
Adj_Cent : Integer;
Date_N : Time_Rep;
+ Flag : aliased int;
Offset : aliased long;
Secs_T : aliased time_t;
Secs_T := time_t (Date_N / Nano);
+ -- Determine whether to treat the input date as historical or not
+
+ Flag := (if Is_Historic then 1 else 0);
+
localtime_tzoff
(Secs_T'Unchecked_Access,
+ Flag'Unchecked_Access,
Offset'Unchecked_Access);
return Offset;
begin
System.OS_Primitives.Initialize;
+
end Ada.Calendar;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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 --
package Time_Zones_Operations is
- function UTC_Time_Offset (Date : Time) return Long_Integer;
- -- Return the offset in seconds from UTC
+ function UTC_Time_Offset
+ (Date : Time;
+ Is_Historic : Boolean := True) return Long_Integer;
+ -- Return the offset in seconds from UTC of an arbitrary date. If flag
+ -- Is_Historic is set to False, then return the local time zone offset
+ -- regardless of what Date designates.
end Time_Zones_Operations;
-- --
-- B o d y --
-- --
--- Copyright (C) 2009, Free Software Foundation, Inc. --
+-- Copyright (C) 2009-2012, 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- --
-- UTC_Time_Offset --
---------------------
- function UTC_Time_Offset (Date : Time := Clock) return Time_Offset is
+ function UTC_Time_Offset return Time_Offset is
Offset_L : constant Long_Integer :=
- Time_Zones_Operations.UTC_Time_Offset (Date);
+ Time_Zones_Operations.UTC_Time_Offset
+ (Date => Clock,
+ Is_Historic => False);
+ Offset : Time_Offset;
+
+ begin
+ if Offset_L = Invalid_Time_Zone_Offset then
+ raise Unknown_Zone_Error;
+ end if;
+
+ -- The offset returned by Time_Zones_Operations.UTC_Time_Offset is in
+ -- seconds, the returned value needs to be in minutes.
+
+ Offset := Time_Offset (Offset_L / 60);
+
+ -- Validity checks
+
+ if not Offset'Valid then
+ raise Unknown_Zone_Error;
+ end if;
+
+ return Offset;
+ end UTC_Time_Offset;
+
+ ---------------------
+ -- UTC_Time_Offset --
+ ---------------------
+
+ function UTC_Time_Offset (Date : Time) return Time_Offset is
+ Offset_L : constant Long_Integer :=
+ Time_Zones_Operations.UTC_Time_Offset
+ (Date => Date,
+ Is_Historic => True);
Offset : Time_Offset;
begin
-- --
-- S p e c --
-- --
--- Copyright (C) 2005-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 2005-2012, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
Unknown_Zone_Error : exception;
- function UTC_Time_Offset (Date : Time := Clock) return Time_Offset;
+ function UTC_Time_Offset return Time_Offset;
+ -- Returns (in minutes), the difference between the implementation-defined
+ -- time zone of Calendar, and UTC time. If the time zone of the Calendar
+ -- implementation is unknown, raises Unknown_Zone_Error.
+
+ function UTC_Time_Offset (Date : Time) return Time_Offset;
-- Returns (in minutes), the difference between the implementation-defined
-- time zone of Calendar, and UTC time, at the time Date. If the time zone
-- of the Calendar implementation is unknown, raises Unknown_Zone_Error.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
Current_Source_File := No_Source_File;
if Arg in List_Range then
- Sprint_Node_List (List_Id (Arg));
+ Sprint_Node_List (List_Id (Arg), New_Lines => True);
elsif Arg in Node_Range then
Sprint_Node (Node_Id (Arg));
Current_Source_File := No_Source_File;
if Arg in List_Range then
- Sprint_Node_List (List_Id (Arg));
+ Sprint_Node_List (List_Id (Arg), New_Lines => True);
elsif Arg in Node_Range then
Sprint_Node (Node_Id (Arg));
Current_Source_File := No_Source_File;
if Arg in List_Range then
- Sprint_Node_List (List_Id (Arg));
+ Sprint_Node_List (List_Id (Arg), New_Lines => True);
elsif Arg in Node_Range then
Sprint_Node (Node_Id (Arg));
-- Sprint_Node_List --
----------------------
- procedure Sprint_Node_List (List : List_Id) is
+ procedure Sprint_Node_List (List : List_Id; New_Lines : Boolean := False) is
Node : Node_Id;
begin
exit when Node = Empty;
end loop;
end if;
+
+ if New_Lines and then Column /= 1 then
+ Write_Eol;
+ end if;
end Sprint_Node_List;
----------------------
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
-- blank is output if List is non-empty, and nothing at all is printed it
-- the argument is No_List.
- procedure Sprint_Node_List (List : List_Id);
+ procedure Sprint_Node_List (List : List_Id; New_Lines : Boolean := False);
-- Prints the nodes in a list with no separating characters. This is used
-- in the case of lists of items which are printed on separate lines using
- -- the current indentation amount. Note that Sprint_Node_List itself
- -- does not generate any New_Line calls.
+ -- the current indentation amount. New_Lines controls the generation of
+ -- New_Line calls. If False, no New_Line calls are generated. If True,
+ -- then New_Line calls are generated as needed to ensure that each list
+ -- item starts at the beginning of a line.
procedure Sprint_Opt_Node_List (List : List_Id);
-- Like Sprint_Node_List, but prints nothing if List = No_List
procedure po (Arg : Union_Id);
pragma Export (Ada, po);
-- Like pg, but prints original source for the argument (like -gnatdo
- -- output). Intended only for use from gdb for debugging purposes.
+ -- output). Intended only for use from gdb for debugging purposes. In
+ -- the list case, an end of line is output to separate list elements.
procedure ps (Arg : Union_Id);
pragma Export (Ada, ps);
-- Like pg, but prints generated and original source for the argument (like
-- -gnatds output). Intended only for use from gdb for debugging purposes.
+ -- In the list case, an end of line is output to separate list elements.
end Sprint;
* *
* C Implementation File *
* *
- * Copyright (C) 1992-2011, Free Software Foundation, Inc. *
+ * Copyright (C) 1992-2012, 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- *
/* Reentrant localtime for Windows. */
extern void
-__gnat_localtime_tzoff (const time_t *, long *);
+__gnat_localtime_tzoff (const time_t *, const int *, long *);
static const unsigned long long w32_epoch_offset = 11644473600ULL;
void
-__gnat_localtime_tzoff (const time_t *timer, long *off)
+__gnat_localtime_tzoff (const time_t *timer, const int *is_historic, long *off)
{
- union
- {
- FILETIME ft_time;
- unsigned long long ull_time;
- } utc_time, local_time;
-
- SYSTEMTIME utc_sys_time, local_sys_time;
TIME_ZONE_INFORMATION tzi;
- BOOL status = 1;
+ BOOL rtx_active;
DWORD tzi_status;
- (*Lock_Task) ();
-
#ifdef RTX
+ rtx_active = 1;
+#else
+ rtx_active = 0;
+#endif
+
+ (*Lock_Task) ();
tzi_status = GetTimeZoneInformation (&tzi);
- *off = tzi.Bias;
- if (tzi_status == TIME_ZONE_ID_STANDARD)
- /* The system is operating in the range covered by the StandardDate
- member. */
- *off = *off + tzi.StandardBias;
- else if (tzi_status == TIME_ZONE_ID_DAYLIGHT)
- /* The system is operating in the range covered by the DaylightDate
- member. */
- *off = *off + tzi.DaylightBias;
- *off = *off * -60;
-#else
+ /* Processing for RTX targets or cases where we simply want to extract the
+ offset of the current time zone, regardless of the date. */
- /* First convert unix time_t structure to windows FILETIME format. */
- utc_time.ull_time = ((unsigned long long) *timer + w32_epoch_offset)
- * 10000000ULL;
+ if (rtx_active || !is_historic) {
+ *off = tzi.Bias;
- tzi_status = GetTimeZoneInformation (&tzi);
+ /* The system is operating in the range covered by the StandardDate
+ member. */
+ if (tzi_status == TIME_ZONE_ID_STANDARD) {
+ *off = *off + tzi.StandardBias;
+ }
- /* If GetTimeZoneInformation does not return a value between 0 and 2 then
- it means that we were not able to retrieve timezone informations.
- Note that we cannot use here FileTimeToLocalFileTime as Windows will use
- in always in this case the current timezone setting. As suggested on
- MSDN we use the following three system calls to get the right information.
- Note also that starting with Windows Vista new functions are provided to
- get timezone settings that depend on the year. We cannot use them as we
- still support Windows XP and Windows 2003. */
- status = (tzi_status >= 0 && tzi_status <= 2)
- && FileTimeToSystemTime (&utc_time.ft_time, &utc_sys_time)
- && SystemTimeToTzSpecificLocalTime (&tzi, &utc_sys_time, &local_sys_time)
- && SystemTimeToFileTime (&local_sys_time, &local_time.ft_time);
-
- if (!status)
- /* An error occurs so return invalid_tzoff. */
- *off = __gnat_invalid_tzoff;
- else
- if (local_time.ull_time > utc_time.ull_time)
- *off = (long) ((local_time.ull_time - utc_time.ull_time) / 10000000ULL);
- else
- *off = - (long) ((utc_time.ull_time - local_time.ull_time) / 10000000ULL);
+ /* The system is operating in the range covered by the DaylightDate
+ member. */
+ else if (tzi_status == TIME_ZONE_ID_DAYLIGHT) {
+ *off = *off + tzi.DaylightBias;
+ }
-#endif
+ *off = *off * -60;
+ }
+
+ /* Time zone offset calculations for a historic or future date */
+
+ else {
+ union
+ {
+ FILETIME ft_time;
+ unsigned long long ull_time;
+ } utc_time, local_time;
+
+ SYSTEMTIME utc_sys_time, local_sys_time;
+ BOOL status;
+
+ /* First convert unix time_t structure to windows FILETIME format. */
+ utc_time.ull_time = ((unsigned long long) *timer + w32_epoch_offset)
+ * 10000000ULL;
+
+ /* If GetTimeZoneInformation does not return a value between 0 and 2 then
+ it means that we were not able to retrieve timezone informations. Note
+ that we cannot use here FileTimeToLocalFileTime as Windows will use in
+ always in this case the current timezone setting. As suggested on MSDN
+ we use the following three system calls to get the right information.
+ Note also that starting with Windows Vista new functions are provided
+ to get timezone settings that depend on the year. We cannot use them as
+ we still support Windows XP and Windows 2003. */
+
+ status = (tzi_status >= 0 && tzi_status <= 2)
+ && FileTimeToSystemTime (&utc_time.ft_time, &utc_sys_time)
+ && SystemTimeToTzSpecificLocalTime (&tzi, &utc_sys_time, &local_sys_time)
+ && SystemTimeToFileTime (&local_sys_time, &local_time.ft_time);
+
+ /* An error has occured, return invalid_tzoff */
+
+ if (!status) {
+ *off = __gnat_invalid_tzoff;
+ }
+ else {
+ if (local_time.ull_time > utc_time.ull_time) {
+ *off = (long) ((local_time.ull_time - utc_time.ull_time)
+ / 10000000ULL);
+ }
+ else {
+ *off = - (long) ((utc_time.ull_time - local_time.ull_time)
+ / 10000000ULL);
+ }
+ }
+ }
(*Unlock_Task) ();
}
the Lynx convention when building against the legacy API. */
extern void
-__gnat_localtime_tzoff (const time_t *, long *);
+__gnat_localtime_tzoff (const time_t *, const int *, long *);
void
-__gnat_localtime_tzoff (const time_t *timer, long *off)
+__gnat_localtime_tzoff (const time_t *timer, const int *is_historic, long *off)
{
*off = 0;
}
extern void (*Unlock_Task) (void);
extern void
-__gnat_localtime_tzoff (const time_t *, long *);
+__gnat_localtime_tzoff (const time_t *, const int *, long *);
void
-__gnat_localtime_tzoff (const time_t *timer, long *off)
+__gnat_localtime_tzoff (const time_t *timer, const int *is_historic, long *off)
{
struct tm tp;
projects / gcc.git / commitdiff