This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[gfortran] patch to add CTIME and FDATE intrinsics
- From: FX Coudert <fxcoudert at gmail dot com>
- To: patch <gcc-patches at gcc dot gnu dot org>, gfortran <fortran at gcc dot gnu dot org>
- Date: Sat, 05 Nov 2005 15:08:08 +0100
- Subject: [gfortran] patch to add CTIME and FDATE intrinsics
:ADDPATCH fortran:
Attached patch adds the CTIME and FDATE intrinsics (and documentation),
subroutines as well as function versions. Tested on i686-linux.
OK for mainline and 4.0?
FX
2005-11-05 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 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.
Index: gcc/fortran/intrinsic.c
===================================================================
--- gcc/fortran/intrinsic.c (revision 106522)
+++ gcc/fortran/intrinsic.c (working copy)
@@ -872,7 +872,7 @@
*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 @@
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 @@
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 @@
*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 @@
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 @@
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);
Index: gcc/fortran/intrinsic.h
===================================================================
--- gcc/fortran/intrinsic.h (revision 106522)
+++ gcc/fortran/intrinsic.h (working copy)
@@ -44,6 +44,7 @@
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_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_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_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_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 *);
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h (revision 106522)
+++ gcc/fortran/gfortran.h (working copy)
@@ -315,6 +315,7 @@
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 @@
GFC_ISYM_ETIME,
GFC_ISYM_EXP,
GFC_ISYM_EXPONENT,
+ GFC_ISYM_FDATE,
GFC_ISYM_FLOOR,
GFC_ISYM_FNUM,
GFC_ISYM_FRACTION,
Index: gcc/fortran/iresolve.c
===================================================================
--- gcc/fortran/iresolve.c (revision 106522)
+++ gcc/fortran/iresolve.c (working copy)
@@ -441,6 +441,28 @@
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)
{
f->ts.type = BT_REAL;
@@ -561,6 +583,15 @@
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)
{
f->ts.type = BT_INTEGER;
@@ -2145,6 +2176,32 @@
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)
{
c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("gerror"));
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c (revision 106522)
+++ gcc/fortran/trans-decl.c (working copy)
@@ -87,6 +87,8 @@
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_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,
Index: gcc/fortran/check.c
===================================================================
--- gcc/fortran/check.c (revision 106522)
+++ gcc/fortran/check.c (working copy)
@@ -667,6 +667,19 @@
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)
{
if (numeric_check (x, 0) == FAILURE)
@@ -2540,6 +2553,21 @@
}
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)
{
if (array_check (x, 0) == FAILURE)
@@ -2592,6 +2620,16 @@
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)
{
if (type_check (msg, 0, BT_CHARACTER) == FAILURE)
Index: gcc/fortran/trans-intrinsic.c
===================================================================
--- gcc/fortran/trans-intrinsic.c (revision 106522)
+++ gcc/fortran/trans-intrinsic.c (working copy)
@@ -1037,6 +1037,78 @@
}
+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_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_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;
Index: gcc/fortran/intrinsic.texi
===================================================================
--- gcc/fortran/intrinsic.texi (revision 106521)
+++ gcc/fortran/intrinsic.texi (working copy)
@@ -68,6 +68,7 @@
* @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 @@
* @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,7 +1835,59 @@
@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
@findex @code{DATE_AND_TIME} intrinsic
@@ -2736,6 +2790,59 @@
@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
Index: gcc/fortran/trans.h
===================================================================
--- gcc/fortran/trans.h (revision 106522)
+++ gcc/fortran/trans.h (working copy)
@@ -458,6 +458,8 @@
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;
Index: libgfortran/intrinsics/ctime.c
===================================================================
--- libgfortran/intrinsics/ctime.c (revision 0)
+++ libgfortran/intrinsics/ctime.c (revision 0)
@@ -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
+}
Index: libgfortran/configure.ac
===================================================================
--- libgfortran/configure.ac (revision 106521)
+++ libgfortran/configure.ac (working copy)
@@ -169,7 +169,7 @@
# 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])])
Index: libgfortran/Makefile.am
===================================================================
--- libgfortran/Makefile.am (revision 106521)
+++ libgfortran/Makefile.am (working copy)
@@ -44,6 +44,7 @@
intrinsics/chdir.c \
intrinsics/cpu_time.c \
intrinsics/cshift0.c \
+intrinsics/ctime.c \
intrinsics/date_and_time.c \
intrinsics/env.c \
intrinsics/erf.c \