intrinsic.c (add_subroutines): Add ITIME and IDATE.

	* intrinsic.c (add_subroutines): Add ITIME and IDATE.
	* intrinsic.h (gfc_check_itime_idate,gfc_resolve_idate,
	fc_resolve_itime): New protos.
	* iresolve.c (gfc_resolve_itime, gfc_resolve_idate): New functions.
	* check.c (gfc_check_itime_idate): New function.
	* intrinsic.texi: Document the new intrinsics.

	* intrinsics/date_and_time.c (itime0,idate0,itime_i4,itime_i8,
	idate_i4,idate_i8): New functions.

	* gfortran.dg/itime_idate_1.f: New test.
	* gfortran.dg/itime_idate_2.f: New test.

Co-Authored-By: Daniel Franke <franke.daniel@gmail.com>

From-SVN: r115173

1 files changed, 164 insertions, 2 deletions

diff --git a/libgfortran/intrinsics/date_and_time.c b/libgfortran/intrinsics/date_and_time.c
index c52ccfe..68c8cef 100644
--- a/libgfortran/intrinsics/date_and_time.c
+++ b/libgfortran/intrinsics/date_and_time.c
@@ -1,5 +1,5 @@
 /* Implementation of the DATE_AND_TIME intrinsic.
-   Copyright (C) 2003, 2004, 2005 Free Software Foundation, Inc.
+   Copyright (C) 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
    Contributed by Steven Bosscher.
 
 This file is part of the GNU Fortran 95 runtime library (libgfortran).
@@ -84,7 +84,7 @@ Boston, MA 02110-1301, USA.  */
    ZONE (optional) shall be scalar and of type default character, and
    shall be of length at least 5 in order to contain the complete
    value. It is an INTENT(OUT) argument. Its leftmost 5 characters
-   are assigned a value of the form ±hhmm, where hh and mm are the
+   are assigned a value of the form [+-]hhmm, where hh and mm are the
    time difference with respect to Coordinated Universal Time (UTC) in
    hours and parts of an hour expressed in minutes, respectively. If
    there is no clock available, they are assigned blanks.
@@ -359,3 +359,165 @@ secnds (GFC_REAL_4 *x)
   temp2 = (temp1 - temp2 > 0.0) ? temp2 : (temp2 - 86400.0);
   return temp1 - temp2;
 }
+
+
+
+/* ITIME(X) - Non-standard
+
+   Description: Returns the current local time hour, minutes, and seconds
+   in elements 1, 2, and 3 of X, respectively.  */
+
+static void
+itime0 (int x[3])
+{
+#ifndef HAVE_NO_DATE_TIME
+  time_t lt;
+  struct tm local_time;
+
+  lt = time (NULL);
+
+  if (lt != (time_t) -1)
+    {
+      local_time = *localtime (&lt);
+
+      x[0] = local_time.tm_hour;
+      x[1] = local_time.tm_min;
+      x[2] = local_time.tm_sec;
+    }
+#else
+  x[0] = x[1] = x[2] = -1;
+#endif
+}
+
+extern void itime_i4 (gfc_array_i4 *);
+export_proto(itime_i4);
+
+void
+itime_i4 (gfc_array_i4 *__values)
+{
+  int x[3], i;
+  size_t len, delta;
+  GFC_INTEGER_4 *vptr;
+  
+  /* Call helper function.  */
+  itime0(x);
+
+  /* Copy the value into the array.  */
+  len = __values->dim[0].ubound + 1 - __values->dim[0].lbound;
+  assert (len >= 3);
+  delta = __values->dim[0].stride;
+  if (delta == 0)
+    delta = 1;
+
+  vptr = __values->data;
+  for (i = 0; i < 3; i++, vptr += delta)
+    *vptr = x[i];
+}
+
+
+extern void itime_i8 (gfc_array_i8 *);
+export_proto(itime_i8);
+
+void
+itime_i8 (gfc_array_i8 *__values)
+{
+  int x[3], i;
+  size_t len, delta;
+  GFC_INTEGER_8 *vptr;
+  
+  /* Call helper function.  */
+  itime0(x);
+
+  /* Copy the value into the array.  */
+  len = __values->dim[0].ubound + 1 - __values->dim[0].lbound;
+  assert (len >= 3);
+  delta = __values->dim[0].stride;
+  if (delta == 0)
+    delta = 1;
+
+  vptr = __values->data;
+  for (i = 0; i < 3; i++, vptr += delta)
+    *vptr = x[i];
+}
+
+
+
+/* IDATE(X) - Non-standard
+
+   Description: Fills TArray with the numerical values at the current
+   local time. The day (in the range 1-31), month (in the range 1-12),
+   and year appear in elements 1, 2, and 3 of X, respectively.
+   The year has four significant digits.  */
+
+static void
+idate0 (int x[3])
+{
+#ifndef HAVE_NO_DATE_TIME
+  time_t lt;
+  struct tm local_time;
+
+  lt = time (NULL);
+
+  if (lt != (time_t) -1)
+    {
+      local_time = *localtime (&lt);
+
+      x[0] = local_time.tm_mday;
+      x[1] = 1 + local_time.tm_mon;
+      x[2] = 1900 + local_time.tm_year;
+    }
+#else
+  x[0] = x[1] = x[2] = -1;
+#endif
+}
+
+extern void idate_i4 (gfc_array_i4 *);
+export_proto(idate_i4);
+
+void
+idate_i4 (gfc_array_i4 *__values)
+{
+  int x[3], i;
+  size_t len, delta;
+  GFC_INTEGER_4 *vptr;
+  
+  /* Call helper function.  */
+  idate0(x);
+
+  /* Copy the value into the array.  */
+  len = __values->dim[0].ubound + 1 - __values->dim[0].lbound;
+  assert (len >= 3);
+  delta = __values->dim[0].stride;
+  if (delta == 0)
+    delta = 1;
+
+  vptr = __values->data;
+  for (i = 0; i < 3; i++, vptr += delta)
+    *vptr = x[i];
+}
+
+
+extern void idate_i8 (gfc_array_i8 *);
+export_proto(idate_i8);
+
+void
+idate_i8 (gfc_array_i8 *__values)
+{
+  int x[3], i;
+  size_t len, delta;
+  GFC_INTEGER_8 *vptr;
+  
+  /* Call helper function.  */
+  idate0(x);
+
+  /* Copy the value into the array.  */
+  len = __values->dim[0].ubound + 1 - __values->dim[0].lbound;
+  assert (len >= 3);
+  delta = __values->dim[0].stride;
+  if (delta == 0)
+    delta = 1;
+
+  vptr = __values->data;
+  for (i = 0; i < 3; i++, vptr += delta)
+    *vptr = x[i];
+}