diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index f41ac4a04bd..46e1c21d457 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,25 @@ +2005-11-06 Francois-Xavier Coudert + + * 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 * decl.c, trans-decl.c: Fix comment typos. diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index ec7f6b81828..bf81e9f5150 100644 --- a/gcc/fortran/check.c +++ b/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) { diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index daea7ce30f2..96bd38666ba 100644 --- a/gcc/fortran/gfortran.h +++ b/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, diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 96ba02b2545..eedbaa7c1c1 100644 --- a/gcc/fortran/intrinsic.c +++ b/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); diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h index ab378bf7d8b..70bf866bd3e 100644 --- a/gcc/fortran/intrinsic.h +++ b/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 *); diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi index dae94cc7ab8..81a56f5fb40 100644 --- a/gcc/fortran/intrinsic.texi +++ b/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 diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index 4973eb43e0d..22aeda8eedb 100644 --- a/gcc/fortran/iresolve.c +++ b/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) { diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index b44cd8fbf17..9d71d7143bc 100644 --- a/gcc/fortran/trans-decl.c +++ b/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, diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 8a1fa0c4729..6ce65507e6c 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/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; diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 30731a63714..02fc2759609 100644 --- a/gcc/fortran/trans.h +++ b/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; diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 9905c4f8e8b..bfe60d335c4 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,12 @@ +2005-11-06 Francois-Xavier Coudert + + * 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 * configure.ac: Use AM_FCFLAGS for extra flags, not FCFLAGS. diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am index a786a38d8b3..34c04fa1cf2 100644 --- a/libgfortran/Makefile.am +++ b/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 \ diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in index b8f52d5c4ed..6370f264f1d 100644 --- a/libgfortran/Makefile.in +++ b/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 diff --git a/libgfortran/config.h.in b/libgfortran/config.h.in index 6dc11a1b45c..04cda0c5d8a 100644 --- a/libgfortran/config.h.in +++ b/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 diff --git a/libgfortran/configure b/libgfortran/configure index a332726e668..d46d6084d5b 100755 --- a/libgfortran/configure +++ b/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 diff --git a/libgfortran/configure.ac b/libgfortran/configure.ac index 6ca4565e024..bf2c25dde55 100644 --- a/libgfortran/configure.ac +++ b/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])]) diff --git a/libgfortran/intrinsics/ctime.c b/libgfortran/intrinsics/ctime.c new file mode 100644 index 00000000000..1499fd970e4 --- /dev/null +++ b/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 + +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 +# include +#else +# if HAVE_SYS_TIME_H +# include +# else +# ifdef HAVE_TIME_H +# include +# endif +# endif +#endif + +#include + + +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 +}