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

11 files changed, 353 insertions, 4 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a340461..6deaea5 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,19 @@
+2006-07-04  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+	    Daniel Franke  <franke.daniel@gmail.com>
+
+	* 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.
+
+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.
+
+
 2006-07-03  Asher Langton  <langton2@llnl.gov>
 
 	* decl.c (match_old_style_init): Add data attribute to symbol.
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index dfa1c2d..5f536f5 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -3037,6 +3037,28 @@ gfc_check_hostnm_sub (gfc_expr * name, gfc_expr * status)
 
 
 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)
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 082c1b0..3ee0829 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -2241,8 +2241,16 @@ add_subroutines (void)
 
   /* 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,
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index 4028f79..63e0ff0 100644
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -159,6 +159,7 @@ try gfc_check_fgetput_sub (gfc_expr *, gfc_expr *);
 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 (gfc_code *);
 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 *);
diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index 6bc7759..9d8b835 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -100,7 +100,9 @@ and editing.  All contributions and corrections are strongly encouraged.
 * @code{HUGE}:          HUGE,      Largest number of a kind
 * @code{IACHAR}:        IACHAR,    Code in @acronym{ASCII} collating sequence
 * @code{ICHAR}:         ICHAR,     Character-to-integer conversion function
+* @code{IDATE}:         IDATE,     Current local time (day/month/year)
 * @code{IRAND}:         IRAND,     Integer pseudo-random number
+* @code{ITIME}:         ITIME,     Current local time (hour/minutes/seconds)
 * @code{KIND}:          KIND,      Kind of an entity
 * @code{LOC}:           LOC,       Returns the address of a variable
 * @code{LOG}:           LOG,       Logarithm function
@@ -3294,6 +3296,46 @@ end program read_val
 @end smallexample
 @end table
 
+@node IDATE
+@section @code{IDATE} --- Get current local time subroutine (day/month/year) 
+@findex @code{IDATE} intrinsic
+
+@table @asis
+@item @emph{Description}:
+@code{IDATE(TARRAY)} Fills @var{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 @var{TARRAY}, respectively. 
+The year has four significant digits.
+
+@item @emph{Option}:
+gnu
+
+@item @emph{Class}:
+subroutine
+
+@item @emph{Syntax}:
+@code{CALL IDATE(TARRAY)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .80
+@item @var{TARRAY} @tab The type shall be @code{INTEGER, DIMENSION(3)} and
+the kind shall be the default integer kind.
+@end multitable
+
+@item @emph{Return value}:
+Does not return.
+
+@item @emph{Example}:
+@smallexample
+program test_idate
+  integer, dimension(3) :: tarray
+  call idate(tarray)
+  print *, tarray(1)
+  print *, tarray(2)
+  print *, tarray(3)
+end program test_idate
+@end smallexample
+@end table
 
 
 @node IRAND
@@ -3340,6 +3382,47 @@ end program test_irand
 
 @end table
 
+@node ITIME
+@section @code{ITIME} --- Get current local time subroutine (hour/minutes/seconds) 
+@findex @code{ITIME} intrinsic
+
+@table @asis
+@item @emph{Description}:
+@code{IDATE(TARRAY)} Fills @var{TARRAY} with the numerical values at the  
+current local time. The hour (in the range 1-24), minute (in the range 1-60), 
+and seconds (in the range 1-60) appear in elements 1, 2, and 3 of @var{TARRAY}, 
+respectively.
+
+@item @emph{Option}:
+gnu
+
+@item @emph{Class}:
+subroutine
+
+@item @emph{Syntax}:
+@code{CALL ITIME(TARRAY)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .80
+@item @var{TARRAY} @tab The type shall be @code{INTEGER, DIMENSION(3)}
+and the kind shall be the default integer kind.
+@end multitable
+
+@item @emph{Return value}:
+Does not return.
+
+
+@item @emph{Example}:
+@smallexample
+program test_itime
+  integer, dimension(3) :: tarray
+  call itime(tarray)
+  print *, tarray(1)
+  print *, tarray(2)
+  print *, tarray(3)
+end program test_itime
+@end smallexample
+@end table
 
 
 @node KIND
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index b4324b9..3eeebc7 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -2334,6 +2334,26 @@ gfc_resolve_etime_sub (gfc_code * c)
 }
 
 
+/* 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
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index c92ba4d..96a3218 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2006-07-04  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* gfortran.dg/itime_idate_1.f: New test.
+	* gfortran.dg/itime_idate_2.f: New test.
+
 2006-07-03  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR libgfortran/27704
diff --git a/gcc/testsuite/gfortran.dg/itime_idate_1.f b/gcc/testsuite/gfortran.dg/itime_idate_1.f
new file mode 100644
index 0000000..618a83f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/itime_idate_1.f
@@ -0,0 +1,12 @@
+! { dg-do run }
+! Test for ITIME and IDATE intrinsics
+      integer x(3)
+      call itime(x)
+      if (x(1) < 0 .or. x(1) > 23 .or.
+     &    x(2) < 0 .or. x(2) > 59 .or.
+     &    x(3) < 0 .or. x(3) > 61) call abort
+      call idate(x)
+      if (x(1) < 1 .or. x(1) > 31 .or.
+     &    x(2) < 1 .or. x(2) > 12 .or.
+     &    x(3) < 2001 .or. x(3) > 2100) call abort
+      end
diff --git a/gcc/testsuite/gfortran.dg/itime_idate_2.f b/gcc/testsuite/gfortran.dg/itime_idate_2.f
new file mode 100644
index 0000000..11c582d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/itime_idate_2.f
@@ -0,0 +1,13 @@
+! { dg-do run }
+! { dg-options "-fdefault-integer-8" }
+! Test for ITIME and IDATE intrinsics
+      integer x(3)
+      call itime(x)
+      if (x(1) < 0 .or. x(1) > 23 .or.
+     &    x(2) < 0 .or. x(2) > 59 .or.
+     &    x(3) < 0 .or. x(3) > 61) call abort
+      call idate(x)
+      if (x(1) < 1 .or. x(1) > 31 .or.
+     &    x(2) < 1 .or. x(2) > 12 .or.
+     &    x(3) < 2001 .or. x(3) > 2100) call abort
+      end
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 66997a8..a680112 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,8 @@
+2006-07-04  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* intrinsics/date_and_time.c (itime0,idate0,itime_i4,itime_i8,
+	idate_i4,idate_i8): New functions.
+
 2006-07-03  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR libgfortran/27704
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];
+}