mirrors/gcc
1
0
Fork 0
mirror of https://gcc.gnu.org/git/gcc.git synced 2024-11-25 11:54:01 +08:00
Code Issues Actions Packages Projects Releases Wiki Activity

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

Browse Source 
* 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
This commit is contained in:
Francois-Xavier Coudert 2005-11-06 11:17:04 +01:00 committed by François-Xavier Coudert
parent 1f2a3c8f5e
commit 3505981152
17 changed files with 534 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
gcc/fortran/ChangeLog
View File

@ -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.

38
gcc/fortran/check.c
View File

@ -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)
{

2
gcc/fortran/gfortran.h
View File

@ -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,

23
gcc/fortran/intrinsic.c
View File

@ -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);

7
gcc/fortran/intrinsic.h
View File

@ -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 *);

107
gcc/fortran/intrinsic.texi
View File

@ -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

57
gcc/fortran/iresolve.c
View File

@ -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)
{

17
gcc/fortran/trans-decl.c
View File

@ -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,

80
gcc/fortran/trans-intrinsic.c
View File

@ -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;

2
gcc/fortran/trans.h
View File

@ -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;

9
libgfortran/ChangeLog
View File

@ -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.

1
libgfortran/Makefile.am
View File

@ -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 \

6
libgfortran/Makefile.in
View File

@ -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

3
libgfortran/config.h.in
View File

@ -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

3
libgfortran/configure vendored
View File

@ -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

2
libgfortran/configure.ac
View File

@ -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])])

160
libgfortran/intrinsics/ctime.c Normal file
View File

@ -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
}