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

9 files changed, 184 insertions, 2 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