libgfortran/intrinsics/date_and_time.c

   1 /* Implementation of the DATE_AND_TIME intrinsic.
   2    Copyright (C) 2003, 2004 Free Software Foundation, Inc.
   3    Contributed by Steven Bosscher.
   4
   5 This file is part of the GNU Fortran 95 runtime library (libgfortran).
   6
   7 Libgfortran is free software; you can redistribute it and/or
   8 modify it under the terms of the GNU General Public
   9 License as published by the Free Software Foundation; either
  10 version 2 of the License, or (at your option) any later version.
  11
  12 In addition to the permissions in the GNU General Public License, the
  13 Free Software Foundation gives you unlimited permission to link the
  14 compiled version of this file into combinations with other programs,
  15 and to distribute those combinations without any restriction coming
  16 from the use of this file.  (The General Public License restrictions
  17 do apply in other respects; for example, they cover modification of
  18 the file, and distribution when not linked into a combine
  19 executable.)
  20
  21 Libgfortran is distributed in the hope that it will be useful,
  22 but WITHOUT ANY WARRANTY; without even the implied warranty of
  23 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24 GNU General Public License for more details.
  25
  26 You should have received a copy of the GNU General Public
  27 License along with libgfortran; see the file COPYING.  If not,
  28 write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  29 Boston, MA 02111-1307, USA.  */
  30
  31 #include "config.h"
  32 #include <sys/types.h>
  33 #include <string.h>
  34 #include <assert.h>
  35 #include <stdio.h>
  36 #include <stdlib.h>
  37 #include "libgfortran.h"
  38
  39 #undef HAVE_NO_DATE_TIME
  40 #if TIME_WITH_SYS_TIME
  41 #  include <sys/time.h>
  42 #  include <time.h>
  43 #else
  44 #  if HAVE_SYS_TIME_H
  45 #    include <sys/time.h>
  46 #  else
  47 #    ifdef HAVE_TIME_H
  48 #      include <time.h>
  49 #    else
  50 #      define HAVE_NO_DATE_TIME
  51 #    endif  /* HAVE_TIME_H  */
  52 #  endif  /* HAVE_SYS_TIME_H  */
  53 #endif  /* TIME_WITH_SYS_TIME  */
  54
  55 #ifndef abs
  56 #define abs(x) ((x)>=0 ? (x) : -(x))
  57 #endif
  58
  59 /* DATE_AND_TIME ([DATE, TIME, ZONE, VALUES])
  60
  61    Description: Returns data on the real-time clock and date in a form
  62    compatible with the representations defined in ISO 8601:1988.
  63
  64    Class: Non-elemental subroutine.
  65
  66    Arguments:
  67
  68    DATE (optional) shall be scalar and of type default character, and
  69    shall be of length at least 8 in order to contain the complete
  70    value. It is an INTENT (OUT) argument. Its leftmost 8 characters
  71    are assigned a value of the form CCYYMMDD, where CC is the century,
  72    YY the year within the century, MM the month within the year, and
  73    DD the day within the month. If there is no date available, they
  74    are assigned blanks.
  75
  76    TIME (optional) shall be scalar and of type default character, and
  77    shall be of length at least 10 in order to contain the complete
  78    value. It is an INTENT (OUT) argument. Its leftmost 10 characters
  79    are assigned a value of the form hhmmss.sss, where hh is the hour
  80    of the day, mm is the minutes of the hour, and ss.sss is the
  81    seconds and milliseconds of the minute. If there is no clock
  82    available, they are assigned blanks.
  83
  84    ZONE (optional) shall be scalar and of type default character, and
  85    shall be of length at least 5 in order to contain the complete
  86    value. It is an INTENT (OUT) argument. Its leftmost 5 characters
  87    are assigned a value of the form ±hhmm, where hh and mm are the
  88    time difference with respect to Coordinated Universal Time (UTC) in
  89    hours and parts of an hour expressed in minutes, respectively. If
  90    there is no clock available, they are assigned blanks.
  91
  92    VALUES (optional) shall be of type default integer and of rank
  93    one. It is an INTENT (OUT) argument. Its size shall be at least
  94    8. The values returned in VALUES are as follows:
  95
  96       VALUES (1) the year (for example, 2003), or HUGE (0) if there is
  97       no date available;
  98
  99       VALUES (2) the month of the year, or HUGE (0) if there
 100       is no date available;
 101
 102       VALUES (3) the day of the month, or HUGE (0) if there is no date
 103       available;
 104
 105       VALUES (4) the time difference with respect to Coordinated
 106       Universal Time (UTC) in minutes, or HUGE (0) if this information
 107       is not available;
 108
 109       VALUES (5) the hour of the day, in the range of 0 to 23, or HUGE
 110       (0) if there is no clock;
 111
 112       VALUES (6) the minutes of the hour, in the range 0 to 59, or
 113       HUGE (0) if there is no clock;
 114
 115       VALUES (7) the seconds of the minute, in the range 0 to 60, or
 116       HUGE (0) if there is no clock;
 117
 118       VALUES (8) the milliseconds of the second, in the range 0 to
 119       999, or HUGE (0) if there is no clock.
 120
 121    NULL pointer represent missing OPTIONAL arguments.  All arguments
 122    have INTENT(OUT).  Because of the -i8 option, we must implement
 123    VALUES for INTEGER(kind=4) and INTEGER(kind=8).
 124
 125    Based on libU77's date_time_.c.
 126
 127    TODO :
 128    - Check year boundaries.
 129    - There is no STDC/POSIX way to get VALUES(8).  A GNUish way may
 130      be to use ftime.
 131 */
 132
 133 extern void date_and_time (char *, char *, char *, gfc_array_i4 *,
 134                            GFC_INTEGER_4, GFC_INTEGER_4, GFC_INTEGER_4);
 135 export_proto(date_and_time);
 136
 137 void
 138 date_and_time (char *__date,
 139                char *__time,
 140                char *__zone,
 141                gfc_array_i4 *__values,
 142                GFC_INTEGER_4 __date_len,
 143                GFC_INTEGER_4 __time_len,
 144                GFC_INTEGER_4 __zone_len)
 145 {
 146 #define DATE_LEN 8
 147 #define TIME_LEN 10
 148 #define ZONE_LEN 5
 149 #define VALUES_SIZE 8
 150   char date[DATE_LEN + 1];
 151   char timec[TIME_LEN + 1];
 152   char zone[ZONE_LEN + 1];
 153   GFC_INTEGER_4 values[VALUES_SIZE];
 154
 155 #ifndef HAVE_NO_DATE_TIME
 156   time_t lt = time (NULL);
 157   struct tm local_time = *localtime (&lt);
 158   struct tm UTC_time = *gmtime (&lt);
 159
 160   /* All arguments can be derived from VALUES.  */
 161   values[0] = 1900 + local_time.tm_year;
 162   values[1] = 1 + local_time.tm_mon;
 163   values[2] = local_time.tm_mday;
 164   values[3] = (local_time.tm_min - UTC_time.tm_min +
 165                60 * (local_time.tm_hour - UTC_time.tm_hour +
 166                      24 * (local_time.tm_yday - UTC_time.tm_yday)));
 167   values[4] = local_time.tm_hour;
 168   values[5] = local_time.tm_min;
 169   values[6] = local_time.tm_sec;
 170 #if HAVE_GETTIMEOFDAY
 171     {
 172       struct timeval tp;
 173 #  if GETTIMEOFDAY_ONE_ARGUMENT
 174       if (!gettimeofday (&tp))
 175 #  else
 176 #    if HAVE_STRUCT_TIMEZONE
 177       struct timezone tzp;
 178
 179       /* Some systems such as HP-UX, do have struct timezone, but
 180          gettimeofday takes void* as the 2nd arg.  However, the
 181          effect of passing anything other than a null pointer is
 182          unspecified on HPUX.  Configure checks if gettimeofday
 183          actually fails with a non-NULL arg and pretends that
 184          struct timezone is missing if it does fail.  */
 185       if (!gettimeofday (&tp, &tzp))
 186 #    else
 187       if (!gettimeofday (&tp, (void *) 0))
 188 #    endif /* HAVE_STRUCT_TIMEZONE  */
 189 #  endif /* GETTIMEOFDAY_ONE_ARGUMENT  */
 190         values[7] = tp.tv_usec / 1000;
 191     }
 192 #else
 193    values[7] = GFC_INTEGER_4_HUGE;
 194 #endif /* HAVE_GETTIMEOFDAY */
 195
 196   if (__date)
 197     {
 198 #if HAVE_SNPRINTF
 199       snprintf (date, DATE_LEN + 1, "%04d%02d%02d",
 200                 values[0], values[1], values[2]);
 201 #else
 202       sprintf (date, "%04d%02d%02d",
 203                values[0], values[1], values[2]);
 204 #endif
 205     }
 206
 207   if (__time)
 208     {
 209 #if HAVE_SNPRINTF
 210       snprintf (timec, TIME_LEN + 1, "%02d%02d%02d.%03d",
 211                 values[4], values[5], values[6], values[7]);
 212 #else
 213       sprintf (timec, "%02d%02d%02d.%03d",
 214                values[4], values[5], values[6], values[7]);
 215 #endif
 216     }
 217
 218   if (__zone)
 219     {
 220 #if HAVE_SNPRINTF
 221       snprintf (zone, ZONE_LEN + 1, "%+03d%02d",
 222                 values[3] / 60, abs (values[3] % 60));
 223 #else
 224       sprintf (zone, "%+03d%02d",
 225                values[3] / 60, abs (values[3] % 60));
 226 #endif
 227     }
 228 #else /* if defined HAVE_NO_DATE_TIME  */
 229   /* We really have *nothing* to return, so return blanks and HUGE(0).  */
 230     {
 231       int i;
 232
 233       memset (date, ' ', DATE_LEN);
 234       date[DATE_LEN] = '\0';
 235
 236       memset (timec, ' ', TIME_LEN);
 237       time[TIME_LEN] = '\0';
 238
 239       memset (zone, ' ', ZONE_LEN);
 240       zone[ZONE_LEN] = '\0';
 241
 242       for (i = 0; i < VALUES_SIZE; i++)
 243         values[i] = GFC_INTEGER_4_HUGE;
 244     }
 245 #endif  /* HAVE_NO_DATE_TIME  */
 246
 247   /* Copy the values into the arguments.  */
 248   if (__values)
 249     {
 250       int i;
 251       size_t len, delta, elt_size;
 252
 253       elt_size = GFC_DESCRIPTOR_SIZE (__values);
 254       len = __values->dim[0].ubound + 1 - __values->dim[0].lbound;
 255       delta = __values->dim[0].stride;
 256       if (delta == 0)
 257         delta = 1;
 258
 259       assert (len >= VALUES_SIZE);
 260       /* Cope with different type kinds.  */
 261       if (elt_size == 4)
 262         {
 263           GFC_INTEGER_4 *vptr4 = __values->data;
 264
 265           for (i = 0; i < VALUES_SIZE; i++, vptr4 += delta)
 266             {
 267               *vptr4 = values[i];
 268             }
 269         }
 270       else if (elt_size == 8)
 271         {
 272           GFC_INTEGER_8 *vptr8 = (GFC_INTEGER_8 *)__values->data;
 273
 274           for (i = 0; i < VALUES_SIZE; i++, vptr8 += delta)
 275             {
 276               if (values[i] == GFC_INTEGER_4_HUGE)
 277                 *vptr8 = GFC_INTEGER_8_HUGE;
 278               else
 279                 *vptr8 = values[i];
 280             }
 281         }
 282       else
 283         abort ();
 284     }
 285
 286   if (__zone)
 287     {
 288       assert (__zone_len >= ZONE_LEN);
 289       fstrcpy (__zone, ZONE_LEN, zone, ZONE_LEN);
 290     }
 291
 292   if (__time)
 293     {
 294       assert (__time_len >= TIME_LEN);
 295       fstrcpy (__time, TIME_LEN, timec, TIME_LEN);
 296     }
 297
 298   if (__date)
 299     {
 300       assert (__date_len >= DATE_LEN);
 301       fstrcpy (__date, DATE_LEN, date, DATE_LEN);
 302     }
 303 #undef DATE_LEN
 304 #undef TIME_LEN
 305 #undef ZONE_LEN
 306 #undef VALUES_SIZE
 307 }