libgfortran/intrinsics/date_and_time.c

   1 /* Implementation of the DATE_AND_TIME intrinsic.
   2    Copyright (C) 2003, 2004, 2005 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
 110       -HUGE(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 #define DATE_LEN 8
 133 #define TIME_LEN 10
 134 #define ZONE_LEN 5
 135 #define VALUES_SIZE 8
 136
 137 extern void date_and_time (char *, char *, char *, gfc_array_i4 *,
 138                            GFC_INTEGER_4, GFC_INTEGER_4, GFC_INTEGER_4);
 139 export_proto(date_and_time);
 140
 141 void
 142 date_and_time (char *__date, char *__time, char *__zone,
 143                gfc_array_i4 *__values, GFC_INTEGER_4 __date_len,
 144                GFC_INTEGER_4 __time_len, GFC_INTEGER_4 __zone_len)
 145 {
 146   int i;
 147   char date[DATE_LEN + 1];
 148   char timec[TIME_LEN + 1];
 149   char zone[ZONE_LEN + 1];
 150   GFC_INTEGER_4 values[VALUES_SIZE];
 151
 152 #ifndef HAVE_NO_DATE_TIME
 153   time_t lt;
 154   struct tm local_time;
 155   struct tm UTC_time;
 156
 157   lt = time (NULL);
 158
 159   if (lt != (time_t) -1)
 160     {
 161       local_time = *localtime (&lt);
 162       UTC_time = *gmtime (&lt);
 163
 164       /* All arguments can be derived from VALUES.  */
 165       values[0] = 1900 + local_time.tm_year;
 166       values[1] = 1 + local_time.tm_mon;
 167       values[2] = local_time.tm_mday;
 168       values[3] = (local_time.tm_min - UTC_time.tm_min +
 169                    60 * (local_time.tm_hour - UTC_time.tm_hour +
 170                      24 * (local_time.tm_yday - UTC_time.tm_yday)));
 171       values[4] = local_time.tm_hour;
 172       values[5] = local_time.tm_min;
 173       values[6] = local_time.tm_sec;
 174       values[7] = 0;
 175
 176 #if HAVE_GETTIMEOFDAY
 177       {
 178         struct timeval tp;
 179 #  if GETTIMEOFDAY_ONE_ARGUMENT
 180         if (!gettimeofday (&tp))
 181 #  else
 182 #    if HAVE_STRUCT_TIMEZONE
 183         struct timezone tzp;
 184
 185       /* Some systems such as HP-UX, do have struct timezone, but
 186          gettimeofday takes void* as the 2nd arg.  However, the
 187          effect of passing anything other than a null pointer is
 188          unspecified on HP-UX.  Configure checks if gettimeofday
 189          actually fails with a non-NULL arg and pretends that
 190          struct timezone is missing if it does fail.  */
 191         if (!gettimeofday (&tp, &tzp))
 192 #    else
 193         if (!gettimeofday (&tp, (void *) 0))
 194 #    endif /* HAVE_STRUCT_TIMEZONE  */
 195 #  endif /* GETTIMEOFDAY_ONE_ARGUMENT  */
 196         values[7] = tp.tv_usec / 1000;
 197       }
 198 #endif /* HAVE_GETTIMEOFDAY */
 199
 200 #if HAVE_SNPRINTF
 201       if (__date)
 202         snprintf (date, DATE_LEN + 1, "%04d%02d%02d",
 203                   values[0], values[1], values[2]);
 204       if (__time)
 205         snprintf (timec, TIME_LEN + 1, "%02d%02d%02d.%03d",
 206                   values[4], values[5], values[6], values[7]);
 207
 208       if (__zone)
 209         snprintf (zone, ZONE_LEN + 1, "%+03d%02d",
 210                   values[3] / 60, abs (values[3] % 60));
 211 #else
 212       if (__date)
 213         sprintf (date, "%04d%02d%02d", values[0], values[1], values[2]);
 214
 215       if (__time)
 216         sprintf (timec, "%02d%02d%02d.%03d",
 217                  values[4], values[5], values[6], values[7]);
 218
 219       if (__zone)
 220         sprintf (zone, "%+03d%02d",
 221                  values[3] / 60, abs (values[3] % 60));
 222 #endif
 223     }
 224   else
 225     {
 226       memset (date, ' ', DATE_LEN);
 227       date[DATE_LEN] = '\0';
 228
 229       memset (timec, ' ', TIME_LEN);
 230       timec[TIME_LEN] = '\0';
 231
 232       memset (zone, ' ', ZONE_LEN);
 233       zone[ZONE_LEN] = '\0';
 234
 235       for (i = 0; i < VALUES_SIZE; i++)
 236         values[i] = - GFC_INTEGER_4_HUGE;
 237     }
 238 #else /* if defined HAVE_NO_DATE_TIME  */
 239   /* We really have *nothing* to return, so return blanks and HUGE(0).  */
 240
 241   memset (date, ' ', DATE_LEN);
 242   date[DATE_LEN] = '\0';
 243
 244   memset (timec, ' ', TIME_LEN);
 245   timec[TIME_LEN] = '\0';
 246
 247   memset (zone, ' ', ZONE_LEN);
 248   zone[ZONE_LEN] = '\0';
 249
 250   for (i = 0; i < VALUES_SIZE; i++)
 251     values[i] = - GFC_INTEGER_4_HUGE;
 252 #endif  /* HAVE_NO_DATE_TIME  */
 253
 254   /* Copy the values into the arguments.  */
 255   if (__values)
 256     {
 257       size_t len, delta, elt_size;
 258
 259       elt_size = GFC_DESCRIPTOR_SIZE (__values);
 260       len = __values->dim[0].ubound + 1 - __values->dim[0].lbound;
 261       delta = __values->dim[0].stride;
 262       if (delta == 0)
 263         delta = 1;
 264
 265       assert (len >= VALUES_SIZE);
 266       /* Cope with different type kinds.  */
 267       if (elt_size == 4)
 268         {
 269           GFC_INTEGER_4 *vptr4 = __values->data;
 270
 271           for (i = 0; i < VALUES_SIZE; i++, vptr4 += delta)
 272             *vptr4 = values[i];
 273         }
 274       else if (elt_size == 8)
 275         {
 276           GFC_INTEGER_8 *vptr8 = (GFC_INTEGER_8 *)__values->data;
 277
 278           for (i = 0; i < VALUES_SIZE; i++, vptr8 += delta)
 279             {
 280               if (values[i] == - GFC_INTEGER_4_HUGE)
 281                 *vptr8 = - GFC_INTEGER_8_HUGE;
 282               else
 283                 *vptr8 = values[i];
 284             }
 285         }
 286       else
 287         abort ();
 288     }
 289
 290   if (__zone)
 291     {
 292       assert (__zone_len >= ZONE_LEN);
 293       fstrcpy (__zone, ZONE_LEN, zone, ZONE_LEN);
 294     }
 295
 296   if (__time)
 297     {
 298       assert (__time_len >= TIME_LEN);
 299       fstrcpy (__time, TIME_LEN, timec, TIME_LEN);
 300     }
 301
 302   if (__date)
 303     {
 304       assert (__date_len >= DATE_LEN);
 305       fstrcpy (__date, DATE_LEN, date, DATE_LEN);
 306     }
 307 }