[gfortran,patch] Add ITIME and IDATE intrinsics

[FX Coudert <fxcoudert at gmail dot com>]

Hi all,

Attached patch adds support for g77 ITIME and IDATE intrinsics. It is 
pretty straightforward, it is currently regtesting on i686-linux and 
will be commited along with a testcase.

OK for mainline? Do we commit it to 4.1?

FX
2006-07-03  Francois-Xavier Coudert  <coudert@clipper.ens.fr>

	* 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.


2006-07-03  Francois-Xavier Coudert  <coudert@clipper.ens.fr>

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

Index: gcc/fortran/intrinsic.c
===================================================================
--- gcc/fortran/intrinsic.c	(revision 114972)
+++ gcc/fortran/intrinsic.c	(working copy)
@@ -2241,9 +2241,17 @@
 
   /* More G77 compatibility garbage.  */
   add_sym_2s ("ctime", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
-	     gfc_check_ctime_sub, NULL, gfc_resolve_ctime_sub,
-	     tm, BT_INTEGER, di, REQUIRED, res, BT_CHARACTER, dc, REQUIRED);
+	      gfc_check_ctime_sub, NULL, gfc_resolve_ctime_sub,
+	      tm, BT_INTEGER, di, REQUIRED, res, BT_CHARACTER, dc, REQUIRED);
 
+  add_sym_1s ("idate", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
+	      gfc_check_itime_idate, NULL, gfc_resolve_idate,
+	      vl, BT_INTEGER, 4, REQUIRED);
+
+  add_sym_1s ("itime", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
+	      gfc_check_itime_idate, NULL, gfc_resolve_itime,
+	      vl, BT_INTEGER, 4, REQUIRED);
+
   add_sym_1s ("second", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
 	      gfc_check_second_sub, NULL, gfc_resolve_second_sub,
 	      tm, BT_REAL, dr, REQUIRED);
Index: gcc/fortran/intrinsic.h
===================================================================
--- gcc/fortran/intrinsic.h	(revision 114972)
+++ gcc/fortran/intrinsic.h	(working copy)
@@ -159,6 +159,7 @@
 try gfc_check_ftell_sub (gfc_expr *, gfc_expr *);
 try gfc_check_getcwd_sub (gfc_expr *, gfc_expr *);
 try gfc_check_hostnm_sub (gfc_expr *, gfc_expr *);
+try gfc_check_itime_idate (gfc_expr *);
 try gfc_check_kill_sub (gfc_expr *, gfc_expr *, gfc_expr *);
 try gfc_check_perror (gfc_expr *);
 try gfc_check_rename_sub (gfc_expr *, gfc_expr *, gfc_expr *);
@@ -445,6 +446,8 @@
 void gfc_resolve_get_command_argument (gfc_code *);
 void gfc_resolve_get_environment_variable (gfc_code *);
 void gfc_resolve_hostnm_sub (gfc_code *);
+void gfc_resolve_idate (gfc_code *);
+void gfc_resolve_itime (gfc_code *);
 void gfc_resolve_kill_sub (gfc_code *);
 void gfc_resolve_mvbits (gfc_code *);
 void gfc_resolve_perror (gfc_code *);
Index: gcc/fortran/iresolve.c
===================================================================
--- gcc/fortran/iresolve.c	(revision 115152)
+++ gcc/fortran/iresolve.c	(working copy)
@@ -2334,6 +2334,26 @@
 }
 
 
+/* G77 compatibility subroutines itime() and idate().  */
+
+void
+gfc_resolve_itime (gfc_code * c)
+{
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol
+		      (gfc_get_string (PREFIX("itime_i%d"),
+				       gfc_default_integer_kind));
+}
+
+
+void
+gfc_resolve_idate (gfc_code * c)
+{
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol
+		      (gfc_get_string (PREFIX("idate_i%d"),
+				       gfc_default_integer_kind));
+}
+
+
 /* G77 compatibility subroutine second().  */
 
 void
Index: gcc/fortran/check.c
===================================================================
--- gcc/fortran/check.c	(revision 114972)
+++ gcc/fortran/check.c	(working copy)
@@ -3037,6 +3037,28 @@
 
 
 try
+gfc_check_itime_idate (gfc_expr * values)
+{
+  if (array_check (values, 0) == FAILURE)
+    return FAILURE;
+
+  if (rank_check (values, 0, 1) == FAILURE)
+    return FAILURE;
+
+  if (variable_check (values, 0) == FAILURE)
+    return FAILURE;
+
+  if (type_check (values, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (kind_value_check(values, 0, gfc_default_integer_kind) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+try
 gfc_check_ttynam_sub (gfc_expr * unit, gfc_expr * name)
 {
   if (scalar_check (unit, 0) == FAILURE)
Index: libgfortran/intrinsics/date_and_time.c
===================================================================
--- libgfortran/intrinsics/date_and_time.c	(revision 114972)
+++ libgfortran/intrinsics/date_and_time.c	(working copy)
@@ -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 @@
    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 @@
   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];
+}