intrinsic.c (add_functions): Add ctime and fdate intrinsics.

* intrinsic.c (add_functions): Add ctime and fdate intrinsics.
	(add_subroutines): Likewise.
	* intrinsic.h: Prototypes for gfc_check_ctime,
	gfc_check_ctime_sub, gfc_check_fdate_sub, gfc_resolve_ctime,
	gfc_resolve_fdate, gfc_resolve_ctime_sub, gfc_resolve_fdate_sub.
	* gfortran.h: Add GFC_ISYM_CTIME and GFC_ISYM_FDATE.
	* iresolve.c (gfc_resolve_ctime, gfc_resolve_fdate,
	gfc_resolve_ctime_sub, gfc_resolve_fdate_sub): New functions.
	* trans-decl.c (gfc_build_intrinsic_function_decls): Add
	gfor_fndecl_fdate and gfor_fndecl_ctime.
	* check.c (gfc_check_ctime, gfc_check_ctime_sub,
	gfc_check_fdate_sub): New functions.
	* trans-intrinsic.c (gfc_conv_intrinsic_ctime,
	gfc_conv_intrinsic_fdate): New functions.
	(gfc_conv_intrinsic_function): Add cases for GFC_ISYM_CTIME
	and GFC_ISYM_FDATE.
	* intrinsic.texi: Documentation for the new CTIME and FDATE
	intrinsics.
	* trans.h: Declarations for gfor_fndecl_ctime and gfor_fndecl_fdate.

	* intrinsics/ctime.c: New file.
	* configure.ac: Add check for ctime.
	* Makefile.am: Add ctime.c
	* configure: Regenerate.
	* config.h.in: Regenerate.
	* Makefile.in: Regenerate.

From-SVN: r106558

gcc/fortran/ChangeLog

@@ -1,3 +1,25 @@
+2005-11-06  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* intrinsic.c (add_functions): Add ctime and fdate intrinsics.
+	(add_subroutines): Likewise.
+	* intrinsic.h: Prototypes for gfc_check_ctime,
+	gfc_check_ctime_sub, gfc_check_fdate_sub, gfc_resolve_ctime,
+	gfc_resolve_fdate, gfc_resolve_ctime_sub, gfc_resolve_fdate_sub.
+	* gfortran.h: Add GFC_ISYM_CTIME and GFC_ISYM_FDATE.
+	* iresolve.c (gfc_resolve_ctime, gfc_resolve_fdate,
+	gfc_resolve_ctime_sub, gfc_resolve_fdate_sub): New functions.
+	* trans-decl.c (gfc_build_intrinsic_function_decls): Add
+	gfor_fndecl_fdate and gfor_fndecl_ctime.
+	* check.c (gfc_check_ctime, gfc_check_ctime_sub,
+	gfc_check_fdate_sub): New functions.
+	* trans-intrinsic.c (gfc_conv_intrinsic_ctime,
+	gfc_conv_intrinsic_fdate): New functions.
+	(gfc_conv_intrinsic_function): Add cases for GFC_ISYM_CTIME
+	and GFC_ISYM_FDATE.
+	* intrinsic.texi: Documentation for the new CTIME and FDATE
+	intrinsics.
+	* trans.h: Declarations for gfor_fndecl_ctime and gfor_fndecl_fdate.
+
 2005-11-05  Kazu Hirata  <kazu@codesourcery.com>
 
 	* decl.c, trans-decl.c: Fix comment typos.

gcc/fortran/check.c

@@ -666,6 +666,19 @@ gfc_check_cshift (gfc_expr * array, gfc_expr * shift, gfc_expr * dim)
 }
 
 
+try
+gfc_check_ctime (gfc_expr * time)
+{
+  if (scalar_check (time, 0) == FAILURE)
+    return FAILURE;
+
+  if (type_check (time, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
 try
 gfc_check_dcmplx (gfc_expr * x, gfc_expr * y)
 {
@@ -2539,6 +2552,21 @@ gfc_check_srand (gfc_expr * x)
   return SUCCESS;
 }
 
+try
+gfc_check_ctime_sub (gfc_expr * time, gfc_expr * result)
+{
+  if (scalar_check (time, 0) == FAILURE)
+    return FAILURE;
+
+  if (type_check (time, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (type_check (result, 1, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
 try
 gfc_check_etime (gfc_expr * x)
 {
@@ -2591,6 +2619,16 @@ gfc_check_etime_sub (gfc_expr * values, gfc_expr * time)
 }
 
 
+try
+gfc_check_fdate_sub (gfc_expr * date)
+{
+  if (type_check (date, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
 try
 gfc_check_gerror (gfc_expr * msg)
 {

gcc/fortran/gfortran.h

@@ -315,6 +315,7 @@ enum gfc_generic_isym_id
   GFC_ISYM_COSH,
   GFC_ISYM_COUNT,
   GFC_ISYM_CSHIFT,
+  GFC_ISYM_CTIME,
   GFC_ISYM_DBLE,
   GFC_ISYM_DIM,
   GFC_ISYM_DOT_PRODUCT,
@@ -325,6 +326,7 @@ enum gfc_generic_isym_id
   GFC_ISYM_ETIME,
   GFC_ISYM_EXP,
   GFC_ISYM_EXPONENT,
+  GFC_ISYM_FDATE,
   GFC_ISYM_FLOOR,
   GFC_ISYM_FNUM,
   GFC_ISYM_FRACTION,

gcc/fortran/intrinsic.c

@@ -872,7 +872,7 @@ add_functions (void)
     *x = "x", *sh = "shift", *stg = "string", *ssg = "substring",
     *y = "y", *sz = "size", *sta = "string_a", *stb = "string_b",
     *z = "z", *ln = "len", *ut = "unit", *han = "handler",
-    *num = "number";
+    *num = "number", *tm = "time";
 
   int di, dr, dd, dl, dc, dz, ii;
 
@@ -1214,6 +1214,12 @@ add_functions (void)
 
   make_generic ("cshift", GFC_ISYM_CSHIFT, GFC_STD_F95);
 
+  add_sym_1 ("ctime", 0, 1, BT_CHARACTER, 0, GFC_STD_GNU,
+              gfc_check_ctime, NULL, gfc_resolve_ctime,
+	      tm, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("ctime", GFC_ISYM_CTIME, GFC_STD_GNU);
+
   add_sym_1 ("dble", 1, 1, BT_REAL, dd, GFC_STD_F77,
 	     gfc_check_dble, gfc_simplify_dble, gfc_resolve_dble,
 	     a, BT_REAL, dr, REQUIRED);
@@ -1329,6 +1335,11 @@ add_functions (void)
 
   make_generic ("exponent", GFC_ISYM_EXPONENT, GFC_STD_F95);
 
+  add_sym_0 ("fdate", 1, 0, BT_CHARACTER, dc, GFC_STD_GNU,
+	     NULL, NULL, gfc_resolve_fdate);
+
+  make_generic ("fdate", GFC_ISYM_FDATE, GFC_STD_GNU);
+
   add_sym_2 ("floor", 1, 1, BT_INTEGER, di, GFC_STD_F95,
 	     gfc_check_a_ikind, gfc_simplify_floor, gfc_resolve_floor,
 	     a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
@@ -2147,7 +2158,7 @@ add_subroutines (void)
     *com = "command", *length = "length", *st = "status",
     *val = "value", *num = "number", *name = "name",
     *trim_name = "trim_name", *ut = "unit", *han = "handler",
-    *sec = "seconds";
+    *sec = "seconds", *res = "result";
 
   int di, dr, dc, dl, ii;
 
@@ -2166,6 +2177,10 @@ add_subroutines (void)
 	      tm, BT_REAL, dr, REQUIRED);
 
   /* 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);
+
   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);
@@ -2188,6 +2203,10 @@ add_subroutines (void)
 	     gfc_check_etime_sub, NULL, gfc_resolve_etime_sub,
 	      vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
 
+  add_sym_1s ("fdate", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
+	     gfc_check_fdate_sub, NULL, gfc_resolve_fdate_sub,
+	     dt, BT_CHARACTER, dc, REQUIRED);
+
   add_sym_1s ("gerror", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
               gfc_check_gerror, NULL, gfc_resolve_gerror, c, BT_CHARACTER,
 	      dc, REQUIRED);

gcc/fortran/intrinsic.h

@@ -44,6 +44,7 @@ try gfc_check_chdir (gfc_expr *);
 try gfc_check_cmplx (gfc_expr *, gfc_expr *, gfc_expr *);
 try gfc_check_count (gfc_expr *, gfc_expr *);
 try gfc_check_cshift (gfc_expr *, gfc_expr *, gfc_expr *);
+try gfc_check_ctime (gfc_expr *);
 try gfc_check_dcmplx (gfc_expr *, gfc_expr *);
 try gfc_check_dble (gfc_expr *);
 try gfc_check_digits (gfc_expr *);
@@ -133,12 +134,14 @@ try gfc_check_x (gfc_expr *);
 try gfc_check_alarm_sub (gfc_expr *, gfc_expr *, gfc_expr *);
 try gfc_check_chdir_sub (gfc_expr *, gfc_expr *);
 try gfc_check_cpu_time (gfc_expr *);
+try gfc_check_ctime_sub (gfc_expr *, gfc_expr *);
 try gfc_check_system_clock (gfc_expr *, gfc_expr *, gfc_expr *);
 try gfc_check_date_and_time (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 try gfc_check_exit (gfc_expr *);
 try gfc_check_flush (gfc_expr *);
 try gfc_check_free (gfc_expr *);
 try gfc_check_fstat_sub (gfc_expr *, gfc_expr *, gfc_expr *);
+try gfc_check_fdate_sub (gfc_expr *);
 try gfc_check_gerror (gfc_expr *);
 try gfc_check_getlog (gfc_expr *);
 try gfc_check_mvbits (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
@@ -298,6 +301,7 @@ void gfc_resolve_cos (gfc_expr *, gfc_expr *);
 void gfc_resolve_cosh (gfc_expr *, gfc_expr *);
 void gfc_resolve_count (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_cshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_ctime (gfc_expr *, gfc_expr *);
 void gfc_resolve_dble (gfc_expr *, gfc_expr *);
 void gfc_resolve_dim (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_dot_product (gfc_expr *, gfc_expr *, gfc_expr *);
@@ -307,6 +311,7 @@ void gfc_resolve_eoshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
 void gfc_resolve_etime_sub (gfc_code *);
 void gfc_resolve_exp (gfc_expr *, gfc_expr *);
 void gfc_resolve_exponent (gfc_expr *, gfc_expr *);
+void gfc_resolve_fdate (gfc_expr *);
 void gfc_resolve_floor (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_fnum (gfc_expr *, gfc_expr *);
 void gfc_resolve_fraction (gfc_expr *, gfc_expr *);
@@ -399,10 +404,12 @@ void gfc_resolve_verify (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_alarm_sub (gfc_code *);
 void gfc_resolve_chdir_sub (gfc_code *);
 void gfc_resolve_cpu_time (gfc_code *);
+void gfc_resolve_ctime_sub (gfc_code *);
 void gfc_resolve_exit (gfc_code *);
 void gfc_resolve_flush (gfc_code *);
 void gfc_resolve_free (gfc_code *);
 void gfc_resolve_fstat_sub (gfc_code *);
+void gfc_resolve_fdate_sub (gfc_code *);
 void gfc_resolve_gerror (gfc_code *);
 void gfc_resolve_getarg (gfc_code *);
 void gfc_resolve_getcwd_sub (gfc_code *);

gcc/fortran/intrinsic.texi

@@ -68,6 +68,7 @@ and editing.  All contributions and corrections are strongly encouraged.
 * @code{COUNT}:         COUNT,     Count occurrences of .TRUE. in an array
 * @code{CPU_TIME}:      CPU_TIME,  CPU time subroutine
 * @code{CSHIFT}:        CSHIFT,    Circular array shift function
+* @code{CTIME}:         CTIME,     Subroutine (or function) to convert a time into a string
 * @code{DATE_AND_TIME}: DATE_AND_TIME, Date and time subroutine
 * @code{DBLE}:          DBLE,      Double precision conversion function
 * @code{DCMPLX}:        DCMPLX,    Double complex conversion function
@@ -86,6 +87,7 @@ and editing.  All contributions and corrections are strongly encouraged.
 * @code{EXIT}:          EXIT,      Exit the program with status.
 * @code{EXP}:           EXP,       Exponential function
 * @code{EXPONENT}:      EXPONENT,  Exponent function
+* @code{FDATE}:         FDATE,     Subroutine (or function) to get the current time as a string
 * @code{FLOOR}:         FLOOR,     Integer floor function
 * @code{FNUM}:          FNUM,      File number function
 * @code{FREE}:          FREE,      Memory de-allocation subroutine
@@ -1833,6 +1835,58 @@ end program test_cshift
 @end table
 
 
+@node CTIME
+@section @code{CTIME} --- Convert a time into a string
+@findex @code{CTIME} intrinsic
+@cindex ctime subroutine 
+
+@table @asis
+@item @emph{Description}:
+@code{CTIME(T,S)} converts @var{T}, a system time value, such as returned
+by @code{TIME8()}, to a string of the form @samp{Sat Aug 19 18:13:14
+1995}, and returns that string into @var{S}.
+
+If @code{CTIME} is invoked as a function, it can not be invoked as a
+subroutine, and vice versa.
+
+@var{T} is an @code{INTENT(IN)} @code{INTEGER(KIND=8)} variable.
+@var{S} is an @code{INTENT(OUT)} @code{CHARACTER} variable.
+
+@item @emph{Option}:
+gnu
+
+@item @emph{Class}:
+subroutine
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{CALL CTIME(T,S)}.
+@item @code{S = CTIME(T)}, (not recommended).
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .80
+@item @var{S}@tab The type shall be of type @code{CHARACTER}.
+@item @var{T}@tab The type shall be of type @code{INTEGER(KIND=8)}.
+@end multitable
+
+@item @emph{Return value}:
+The converted date and time as a string.
+
+@item @emph{Example}:
+@smallexample
+program test_ctime
+    integer(8) :: i
+    character(len=30) :: date
+    i = time8()
+
+    ! Do something, main part of the program
+    
+    call ctime(i,date)
+    print *, 'Program was started on ', date
+end program test_ctime
+@end smallexample
+@end table
 
 @node DATE_AND_TIME
 @section @code{DATE_AND_TIME} --- Date and time subroutine
@@ -2736,6 +2790,59 @@ See @code{MALLOC} for an example.
 @end table
 
 
+@node FDATE
+@section @code{FDATE} --- Get the current time as a string
+@findex @code{FDATE} intrinsic
+@cindex fdate subroutine 
+
+@table @asis
+@item @emph{Description}:
+@code{FDATE(DATE)} returns the current date (using the same format as
+@code{CTIME}) in @var{DATE}. It is equivalent to @code{CALL CTIME(DATE,
+TIME8())}.
+
+If @code{FDATE} is invoked as a function, it can not be invoked as a
+subroutine, and vice versa.
+
+@var{DATE} is an @code{INTENT(OUT)} @code{CHARACTER} variable.
+
+@item @emph{Option}:
+gnu
+
+@item @emph{Class}:
+subroutine
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{CALL FDATE(DATE)}.
+@item @code{DATE = FDATE()}, (not recommended).
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .80
+@item @var{DATE}@tab The type shall be of type @code{CHARACTER}.
+@end multitable
+
+@item @emph{Return value}:
+The current date and time as a string.
+
+@item @emph{Example}:
+@smallexample
+program test_fdate
+    integer(8) :: i, j
+    character(len=30) :: date
+    call fdate(date)
+    print *, 'Program started on ', date
+    do i = 1, 100000000 ! Just a delay
+        j = i * i - i
+    end do
+    call fdate(date)
+    print *, 'Program ended on ', date
+end program test_fdate
+@end smallexample
+@end table
+
+
 @node FLOOR
 @section @code{FLOOR} --- Integer floor function
 @findex @code{FLOOR} intrinsic

gcc/fortran/iresolve.c

@@ -440,6 +440,28 @@ gfc_resolve_cshift (gfc_expr * f, gfc_expr * array,
 }
 
 
+void
+gfc_resolve_ctime (gfc_expr * f, gfc_expr * time)
+{
+  gfc_typespec ts;
+  
+  f->ts.type = BT_CHARACTER;
+  f->ts.kind = gfc_default_character_kind;
+
+  /* ctime TIME argument is a INTEGER(KIND=8), says the doc */
+  if (time->ts.kind != 8)
+    {
+      ts.type = BT_INTEGER;
+      ts.kind = 8;
+      ts.derived = NULL;
+      ts.cl = NULL;
+      gfc_convert_type (time, &ts, 2);
+    }
+
+  f->value.function.name = gfc_get_string (PREFIX("ctime"));
+}
+
+
 void
 gfc_resolve_dble (gfc_expr * f, gfc_expr * a)
 {
@@ -560,6 +582,15 @@ gfc_resolve_exponent (gfc_expr * f, gfc_expr * x)
 }
 
 
+void
+gfc_resolve_fdate (gfc_expr * f)
+{
+  f->ts.type = BT_CHARACTER;
+  f->ts.kind = gfc_default_character_kind;
+  f->value.function.name = gfc_get_string (PREFIX("fdate"));
+}
+
+
 void
 gfc_resolve_floor (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
 {
@@ -2144,6 +2175,32 @@ gfc_resolve_free (gfc_code * c)
 }
 
 
+void
+gfc_resolve_ctime_sub (gfc_code * c)
+{
+  gfc_typespec ts;
+  
+  /* ctime TIME argument is a INTEGER(KIND=8), says the doc */
+  if (c->ext.actual->expr->ts.kind != 8)
+    {
+      ts.type = BT_INTEGER;
+      ts.kind = 8;
+      ts.derived = NULL;
+      ts.cl = NULL;
+      gfc_convert_type (c->ext.actual->expr, &ts, 2);
+    }
+
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX("ctime_sub"));
+}
+
+
+void
+gfc_resolve_fdate_sub (gfc_code * c)
+{
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("fdate_sub"));
+}
+
+
 void
 gfc_resolve_gerror (gfc_code * c)
 {

gcc/fortran/trans-decl.c

@@ -87,6 +87,8 @@ tree gfor_fndecl_select_string;
 tree gfor_fndecl_runtime_error;
 tree gfor_fndecl_set_fpe;
 tree gfor_fndecl_set_std;
+tree gfor_fndecl_ctime;
+tree gfor_fndecl_fdate;
 tree gfor_fndecl_ttynam;
 tree gfor_fndecl_in_pack;
 tree gfor_fndecl_in_unpack;
@@ -1859,6 +1861,21 @@ gfc_build_intrinsic_function_decls (void)
                                      gfc_charlen_type_node,
                                      gfc_c_int_type_node);
 
+  gfor_fndecl_fdate =
+    gfc_build_library_function_decl (get_identifier (PREFIX("fdate")),
+                                     void_type_node,
+                                     2,
+                                     pchar_type_node,
+                                     gfc_charlen_type_node);
+
+  gfor_fndecl_ctime =
+    gfc_build_library_function_decl (get_identifier (PREFIX("ctime")),
+                                     void_type_node,
+                                     3,
+                                     pchar_type_node,
+                                     gfc_charlen_type_node,
+                                     gfc_int8_type_node);
+
   gfor_fndecl_adjustl =
     gfc_build_library_function_decl (get_identifier (PREFIX("adjustl")),
 				     void_type_node,

gcc/fortran/trans-intrinsic.c

@@ -1037,6 +1037,78 @@ gfc_conv_intrinsic_char (gfc_se * se, gfc_expr * expr)
 }
 
 
+static void
+gfc_conv_intrinsic_ctime (gfc_se * se, gfc_expr * expr)
+{
+  tree var;
+  tree len;
+  tree tmp;
+  tree arglist;
+  tree type;
+  tree cond;
+  tree gfc_int8_type_node = gfc_get_int_type (8);
+
+  type = build_pointer_type (gfc_character1_type_node);
+  var = gfc_create_var (type, "pstr");
+  len = gfc_create_var (gfc_int8_type_node, "len");
+
+  tmp = gfc_conv_intrinsic_function_args (se, expr);
+  arglist = gfc_chainon_list (NULL_TREE, gfc_build_addr_expr (NULL, var));
+  arglist = gfc_chainon_list (arglist, gfc_build_addr_expr (NULL, len));
+  arglist = chainon (arglist, tmp);
+
+  tmp = gfc_build_function_call (gfor_fndecl_ctime, arglist);
+  gfc_add_expr_to_block (&se->pre, tmp);
+
+  /* Free the temporary afterwards, if necessary.  */
+  cond = build2 (GT_EXPR, boolean_type_node, len,
+		 build_int_cst (TREE_TYPE (len), 0));
+  arglist = gfc_chainon_list (NULL_TREE, var);
+  tmp = gfc_build_function_call (gfor_fndecl_internal_free, arglist);
+  tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
+  gfc_add_expr_to_block (&se->post, tmp);
+
+  se->expr = var;
+  se->string_length = len;
+}
+
+
+static void
+gfc_conv_intrinsic_fdate (gfc_se * se, gfc_expr * expr)
+{
+  tree var;
+  tree len;
+  tree tmp;
+  tree arglist;
+  tree type;
+  tree cond;
+  tree gfc_int4_type_node = gfc_get_int_type (4);
+
+  type = build_pointer_type (gfc_character1_type_node);
+  var = gfc_create_var (type, "pstr");
+  len = gfc_create_var (gfc_int4_type_node, "len");
+
+  tmp = gfc_conv_intrinsic_function_args (se, expr);
+  arglist = gfc_chainon_list (NULL_TREE, gfc_build_addr_expr (NULL, var));
+  arglist = gfc_chainon_list (arglist, gfc_build_addr_expr (NULL, len));
+  arglist = chainon (arglist, tmp);
+
+  tmp = gfc_build_function_call (gfor_fndecl_fdate, arglist);
+  gfc_add_expr_to_block (&se->pre, tmp);
+
+  /* Free the temporary afterwards, if necessary.  */
+  cond = build2 (GT_EXPR, boolean_type_node, len,
+		 build_int_cst (TREE_TYPE (len), 0));
+  arglist = gfc_chainon_list (NULL_TREE, var);
+  tmp = gfc_build_function_call (gfor_fndecl_internal_free, arglist);
+  tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
+  gfc_add_expr_to_block (&se->post, tmp);
+
+  se->expr = var;
+  se->string_length = len;
+}
+
+
 /* Return a character string containing the tty name.  */
 
 static void
@@ -2973,6 +3045,10 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       gfc_conv_intrinsic_count (se, expr);
       break;
 
+    case GFC_ISYM_CTIME:
+      gfc_conv_intrinsic_ctime (se, expr);
+      break;
+
     case GFC_ISYM_DIM:
       gfc_conv_intrinsic_dim (se, expr);
       break;
@@ -2981,6 +3057,10 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       gfc_conv_intrinsic_dprod (se, expr);
       break;
 
+    case GFC_ISYM_FDATE:
+      gfc_conv_intrinsic_fdate (se, expr);
+      break;
+
     case GFC_ISYM_IAND:
       gfc_conv_intrinsic_bitop (se, expr, BIT_AND_EXPR);
       break;

gcc/fortran/trans.h

@@ -458,6 +458,8 @@ extern GTY(()) tree gfor_fndecl_runtime_error;
 extern GTY(()) tree gfor_fndecl_set_fpe;
 extern GTY(()) tree gfor_fndecl_set_std;
 extern GTY(()) tree gfor_fndecl_ttynam;
+extern GTY(()) tree gfor_fndecl_ctime;
+extern GTY(()) tree gfor_fndecl_fdate;
 extern GTY(()) tree gfor_fndecl_in_pack;
 extern GTY(()) tree gfor_fndecl_in_unpack;
 extern GTY(()) tree gfor_fndecl_associated;

libgfortran/ChangeLog

@@ -1,3 +1,12 @@
+2005-11-06  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* intrinsics/ctime.c: New file.
+	* configure.ac: Add check for ctime.
+	* Makefile.am: Add ctime.c
+	* configure: Regenerate.
+	* config.h.in: Regenerate.
+	* Makefile.in: Regenerate.
+
 2005-11-05  Richard Guenther  <rguenther@suse.de>
 
 	* configure.ac: Use AM_FCFLAGS for extra flags, not FCFLAGS.

libgfortran/Makefile.am

@@ -44,6 +44,7 @@ intrinsics/c99_functions.c \
 intrinsics/chdir.c \
 intrinsics/cpu_time.c \
 intrinsics/cshift0.c \
+intrinsics/ctime.c \
 intrinsics/date_and_time.c \
 intrinsics/env.c \
 intrinsics/erf.c \

libgfortran/Makefile.in

@@ -165,7 +165,7 @@ am__objects_32 = close.lo file_pos.lo format.lo inquire.lo \
 	list_read.lo lock.lo open.lo read.lo transfer.lo unit.lo \
 	unix.lo write.lo
 am__objects_33 = associated.lo abort.lo args.lo bessel.lo \
-	c99_functions.lo chdir.lo cpu_time.lo cshift0.lo \
+	c99_functions.lo chdir.lo cpu_time.lo cshift0.lo ctime.lo \
 	date_and_time.lo env.lo erf.lo eoshift0.lo eoshift2.lo \
 	etime.lo exit.lo flush.lo fnum.lo gerror.lo getcwd.lo \
 	getlog.lo getXid.lo hyper.lo hostnm.lo kill.lo ierrno.lo \
@@ -385,6 +385,7 @@ intrinsics/c99_functions.c \
 intrinsics/chdir.c \
 intrinsics/cpu_time.c \
 intrinsics/cshift0.c \
+intrinsics/ctime.c \
 intrinsics/date_and_time.c \
 intrinsics/env.c \
 intrinsics/erf.c \
@@ -2235,6 +2236,9 @@ cpu_time.lo: intrinsics/cpu_time.c
 cshift0.lo: intrinsics/cshift0.c
 	$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cshift0.lo `test -f 'intrinsics/cshift0.c' || echo '$(srcdir)/'`intrinsics/cshift0.c
 
+ctime.lo: intrinsics/ctime.c
+	$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o ctime.lo `test -f 'intrinsics/ctime.c' || echo '$(srcdir)/'`intrinsics/ctime.c
+
 date_and_time.lo: intrinsics/date_and_time.c
 	$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o date_and_time.lo `test -f 'intrinsics/date_and_time.c' || echo '$(srcdir)/'`intrinsics/date_and_time.c
 

libgfortran/config.h.in

@@ -252,6 +252,9 @@
 /* libm includes ctanl */
 #undef HAVE_CTANL
 
+/* Define to 1 if you have the `ctime' function. */
+#undef HAVE_CTIME
+
 /* libm includes erf */
 #undef HAVE_ERF
 

libgfortran/configure

@@ -7519,7 +7519,8 @@ done
 
 
 
-for ac_func in sleep time ttyname signal alarm
+
+for ac_func in sleep time ttyname signal alarm ctime
 do
 as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
 echo "$as_me:$LINENO: checking for $ac_func" >&5

libgfortran/configure.ac

@@ -167,7 +167,7 @@ AC_CHECK_MEMBERS([struct stat.st_rdev])
 # Check for library functions.
 AC_CHECK_FUNCS(getrusage times mkstemp strtof strtold snprintf ftruncate chsize)
 AC_CHECK_FUNCS(chdir strerror getlogin gethostname kill link symlink perror)
-AC_CHECK_FUNCS(sleep time ttyname signal alarm)
+AC_CHECK_FUNCS(sleep time ttyname signal alarm ctime)
 
 # Check libc for getgid, getpid, getuid
 AC_CHECK_LIB([c],[getgid],[AC_DEFINE([HAVE_GETGID],[1],[libc includes getgid])])

libgfortran/intrinsics/ctime.c

@@ -0,0 +1,160 @@
+/* Implementation of the CTIME and FDATE g77 intrinsics.
+   Copyright (C) 2005 Free Software Foundation, Inc.
+   Contributed by François-Xavier Coudert <coudert@clipper.ens.fr>
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file.  (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING.  If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include "libgfortran.h"
+
+#ifdef TIME_WITH_SYS_TIME
+#  include <sys/time.h>
+#  include <time.h>
+#else
+#  if HAVE_SYS_TIME_H
+#    include <sys/time.h>
+#  else
+#    ifdef HAVE_TIME_H
+#      include <time.h>
+#    endif
+#  endif
+#endif
+
+#include <string.h>
+
+
+extern void fdate (char **, gfc_charlen_type *);
+export_proto(fdate);
+
+void
+fdate (char ** date, gfc_charlen_type * date_len)
+{
+#if defined(HAVE_TIME) && defined(HAVE_CTIME)
+  int i;
+  time_t now = time(NULL);
+  *date = ctime (&now);
+  if (*date != NULL)
+    {
+      *date = strdup (*date);
+      *date_len = strlen (*date);
+
+      i = 0;
+      while ((*date)[i])
+       {
+         if ((*date)[i] == '\n')
+           (*date)[i] = ' ';
+         i++;
+       }
+      return;
+    }
+#endif
+
+  *date = NULL;
+  *date_len = 0;
+}
+
+
+extern void fdate_sub (char *, gfc_charlen_type);
+export_proto(fdate_sub);
+
+void
+fdate_sub (char * date, gfc_charlen_type date_len)
+{
+#if defined(HAVE_TIME) && defined(HAVE_CTIME)
+  int i;
+  char *d;
+  time_t now = time(NULL);
+#endif
+  
+  memset (date, ' ', date_len);
+#if defined(HAVE_TIME) && defined(HAVE_CTIME)
+  d = ctime (&now);
+  if (d != NULL)
+    {
+      i = 0;
+      while (*d && *d != '\n' && i < date_len)
+       date[i++] = *(d++);
+    }
+#endif
+}
+
+
+
+extern void PREFIX(ctime) (char **, gfc_charlen_type *, GFC_INTEGER_8);
+export_proto_np(PREFIX(ctime));
+
+void
+PREFIX(ctime) (char ** date, gfc_charlen_type * date_len, GFC_INTEGER_8 t)
+{
+#if defined(HAVE_CTIME)
+  time_t now = t;
+  int i;
+  *date = ctime (&now);
+  if (*date != NULL)
+    {
+      *date = strdup (*date);
+      *date_len = strlen (*date);
+
+      i = 0;
+      while ((*date)[i])
+       {
+         if ((*date)[i] == '\n')
+           (*date)[i] = ' ';
+         i++;
+       }
+      return;
+    }
+#endif
+
+  *date = NULL;
+  *date_len = 0;
+}
+
+
+extern void ctime_sub (GFC_INTEGER_8 *, char *, gfc_charlen_type);
+export_proto(ctime_sub);
+
+void
+ctime_sub (GFC_INTEGER_8 * t, char * date, gfc_charlen_type date_len)
+{
+#if defined(HAVE_CTIME)
+  int i;
+  char *d;
+  time_t now = *t;
+#endif
+  
+  memset (date, ' ', date_len);
+#if defined(HAVE_CTIME)
+  d = ctime (&now);
+  if (d != NULL)
+    {
+      i = 0;
+      while (*d && *d != '\n' && i < date_len)
+       date[i++] = *(d++);
+    }
+#endif
+}