diff options
Diffstat (limited to 'libgfortran')
-rw-r--r-- | libgfortran/ChangeLog | 12 | ||||
-rw-r--r-- | libgfortran/Makefile.am | 1 | ||||
-rw-r--r-- | libgfortran/Makefile.in | 14 | ||||
-rw-r--r-- | libgfortran/config.h.in | 3 | ||||
-rwxr-xr-x | libgfortran/configure | 3 | ||||
-rw-r--r-- | libgfortran/configure.ac | 2 | ||||
-rw-r--r-- | libgfortran/intrinsics/clock.c | 78 | ||||
-rw-r--r-- | libgfortran/intrinsics/stat.c | 113 |
8 files changed, 208 insertions, 18 deletions
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 28923a20113..bc86448feb1 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,15 @@ +2006-07-26 Francois-Xavier Coudert <coudert@clipper.ens.fr> + + * configure.ac: Check for function clock. + * Makefile.am: Compile new file intrinsics/clock.c. + * intrinsics/clock.c: New file. + * Makefile.in: Regenerate. + * configure: Regenerate. + * config.h.in: Regenerate. + * intrinsics/stat.c: Rename the old stat_i?_sub functions to + helper functions stat_i?_sub_0, and use them for both STAT and + LSTAT. + 2006-07-25 Jerry DeLisle <jvdelisle@gcc.gnu.org> PR libgfortran/28335 diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am index f7482b74fad..ff1211a7d85 100644 --- a/libgfortran/Makefile.am +++ b/libgfortran/Makefile.am @@ -45,6 +45,7 @@ intrinsics/args.c \ intrinsics/bessel.c \ intrinsics/c99_functions.c \ intrinsics/chdir.c \ +intrinsics/clock.c \ intrinsics/cpu_time.c \ intrinsics/cshift0.c \ intrinsics/ctime.c \ diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in index 761e048e3f8..ba3c3b0e2a6 100644 --- a/libgfortran/Makefile.in +++ b/libgfortran/Makefile.in @@ -162,11 +162,11 @@ am__objects_29 = close.lo file_pos.lo format.lo inquire.lo \ list_read.lo lock.lo open.lo read.lo size_from_kind.lo \ transfer.lo unit.lo unix.lo write.lo am__objects_30 = associated.lo abort.lo args.lo bessel.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 fget.lo flush.lo fnum.lo ftell.lo gerror.lo \ - getcwd.lo getlog.lo getXid.lo hyper.lo hostnm.lo kill.lo \ - ierrno.lo ishftc.lo link.lo malloc.lo mvbits.lo \ + c99_functions.lo chdir.lo clock.lo cpu_time.lo cshift0.lo \ + ctime.lo date_and_time.lo env.lo erf.lo eoshift0.lo \ + eoshift2.lo etime.lo exit.lo fget.lo flush.lo fnum.lo ftell.lo \ + gerror.lo getcwd.lo getlog.lo getXid.lo hyper.lo hostnm.lo \ + kill.lo ierrno.lo ishftc.lo link.lo malloc.lo mvbits.lo \ pack_generic.lo perror.lo signal.lo size.lo sleep.lo \ spread_generic.lo string_intrinsics.lo system.lo rand.lo \ random.lo rename.lo reshape_generic.lo reshape_packed.lo \ @@ -389,6 +389,7 @@ intrinsics/args.c \ intrinsics/bessel.c \ intrinsics/c99_functions.c \ intrinsics/chdir.c \ +intrinsics/clock.c \ intrinsics/cpu_time.c \ intrinsics/cshift0.c \ intrinsics/ctime.c \ @@ -2215,6 +2216,9 @@ c99_functions.lo: intrinsics/c99_functions.c chdir.lo: intrinsics/chdir.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o chdir.lo `test -f 'intrinsics/chdir.c' || echo '$(srcdir)/'`intrinsics/chdir.c +clock.lo: intrinsics/clock.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o clock.lo `test -f 'intrinsics/clock.c' || echo '$(srcdir)/'`intrinsics/clock.c + cpu_time.lo: intrinsics/cpu_time.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o cpu_time.lo `test -f 'intrinsics/cpu_time.c' || echo '$(srcdir)/'`intrinsics/cpu_time.c diff --git a/libgfortran/config.h.in b/libgfortran/config.h.in index 29faefdd1ac..573c0938f07 100644 --- a/libgfortran/config.h.in +++ b/libgfortran/config.h.in @@ -150,6 +150,9 @@ /* Define to 1 if you have the `chsize' function. */ #undef HAVE_CHSIZE +/* Define to 1 if you have the `clock' function. */ +#undef HAVE_CLOCK + /* libm includes clog */ #undef HAVE_CLOG diff --git a/libgfortran/configure b/libgfortran/configure index ee018ad732a..6cb118b88e2 100755 --- a/libgfortran/configure +++ b/libgfortran/configure @@ -9975,7 +9975,8 @@ done -for ac_func in sleep time ttyname signal alarm ctime + +for ac_func in sleep time ttyname signal alarm ctime clock 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 4742882815f..51756597d03 100644 --- a/libgfortran/configure.ac +++ b/libgfortran/configure.ac @@ -171,7 +171,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 ctime) +AC_CHECK_FUNCS(sleep time ttyname signal alarm ctime clock) # Check libc for getgid, getpid, getuid AC_CHECK_LIB([c],[getgid],[AC_DEFINE([HAVE_GETGID],[1],[libc includes getgid])]) diff --git a/libgfortran/intrinsics/clock.c b/libgfortran/intrinsics/clock.c new file mode 100644 index 00000000000..73e50634e36 --- /dev/null +++ b/libgfortran/intrinsics/clock.c @@ -0,0 +1,78 @@ +/* Implementation of the MCLOCK and MCLOCK8 g77 intrinsics. + Copyright (C) 2006 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 + + +/* INTEGER(KIND=4) FUNCTION MCLOCK() */ + +extern GFC_INTEGER_4 mclock (void); +export_proto(mclock); + +GFC_INTEGER_4 +mclock (void) +{ +#ifdef HAVE_CLOCK + return (GFC_INTEGER_4) clock (); +#else + return (GFC_INTEGER_4) -1; +#endif +} + + +/* INTEGER(KIND=8) FUNCTION MCLOCK8() */ + +extern GFC_INTEGER_8 mclock8 (void); +export_proto(mclock8); + +GFC_INTEGER_8 +mclock8 (void) +{ +#ifdef HAVE_CLOCK + return (GFC_INTEGER_8) clock (); +#else + return (GFC_INTEGER_8) -1; +#endif +} + diff --git a/libgfortran/intrinsics/stat.c b/libgfortran/intrinsics/stat.c index 98511640f56..150387dad5b 100644 --- a/libgfortran/intrinsics/stat.c +++ b/libgfortran/intrinsics/stat.c @@ -59,13 +59,13 @@ Boston, MA 02110-1301, USA. */ CHARACTER(len=*), INTENT(IN) :: FILE INTEGER, INTENT(OUT), :: SARRAY(13) */ -extern void stat_i4_sub (char *, gfc_array_i4 *, GFC_INTEGER_4 *, - gfc_charlen_type); -iexport_proto(stat_i4_sub); +/*extern void stat_i4_sub_0 (char *, gfc_array_i4 *, GFC_INTEGER_4 *, + gfc_charlen_type, int); +internal_proto(stat_i4_sub_0);*/ -void -stat_i4_sub (char *name, gfc_array_i4 *sarray, GFC_INTEGER_4 *status, - gfc_charlen_type name_len) +static void +stat_i4_sub_0 (char *name, gfc_array_i4 *sarray, GFC_INTEGER_4 *status, + gfc_charlen_type name_len, int is_lstat) { int val; char *str; @@ -88,7 +88,10 @@ stat_i4_sub (char *name, gfc_array_i4 *sarray, GFC_INTEGER_4 *status, memcpy (str, name, name_len); str[name_len] = '\0'; - val = stat(str, &sb); + if (is_lstat) + val = lstat(str, &sb); + else + val = stat(str, &sb); if (val == 0) { @@ -147,16 +150,39 @@ stat_i4_sub (char *name, gfc_array_i4 *sarray, GFC_INTEGER_4 *status, if (status != NULL) *status = (val == 0) ? 0 : errno; } + + +extern void stat_i4_sub (char *, gfc_array_i4 *, GFC_INTEGER_4 *, + gfc_charlen_type); +iexport_proto(stat_i4_sub); + +void +stat_i4_sub (char *name, gfc_array_i4 *sarray, GFC_INTEGER_4 *status, + gfc_charlen_type name_len) +{ + stat_i4_sub_0 (name, sarray, status, name_len, 0); +} iexport(stat_i4_sub); -extern void stat_i8_sub (char *, gfc_array_i8 *, GFC_INTEGER_8 *, + +extern void lstat_i4_sub (char *, gfc_array_i4 *, GFC_INTEGER_4 *, gfc_charlen_type); -iexport_proto(stat_i8_sub); +iexport_proto(lstat_i4_sub); void -stat_i8_sub (char *name, gfc_array_i8 *sarray, GFC_INTEGER_8 *status, +lstat_i4_sub (char *name, gfc_array_i4 *sarray, GFC_INTEGER_4 *status, gfc_charlen_type name_len) { + stat_i4_sub_0 (name, sarray, status, name_len, 1); +} +iexport(lstat_i4_sub); + + + +static void +stat_i8_sub_0 (char *name, gfc_array_i8 *sarray, GFC_INTEGER_8 *status, + gfc_charlen_type name_len, int is_lstat) +{ int val; char *str; struct stat sb; @@ -178,7 +204,10 @@ stat_i8_sub (char *name, gfc_array_i8 *sarray, GFC_INTEGER_8 *status, memcpy (str, name, name_len); str[name_len] = '\0'; - val = stat(str, &sb); + if (is_lstat) + val = lstat(str, &sb); + else + val = stat(str, &sb); if (val == 0) { @@ -237,8 +266,36 @@ stat_i8_sub (char *name, gfc_array_i8 *sarray, GFC_INTEGER_8 *status, if (status != NULL) *status = (val == 0) ? 0 : errno; } + + +extern void stat_i8_sub (char *, gfc_array_i8 *, GFC_INTEGER_8 *, + gfc_charlen_type); +iexport_proto(stat_i8_sub); + +void +stat_i8_sub (char *name, gfc_array_i8 *sarray, GFC_INTEGER_8 *status, + gfc_charlen_type name_len) +{ + stat_i8_sub_0 (name, sarray, status, name_len, 0); +} + iexport(stat_i8_sub); + +extern void lstat_i8_sub (char *, gfc_array_i8 *, GFC_INTEGER_8 *, + gfc_charlen_type); +iexport_proto(lstat_i8_sub); + +void +lstat_i8_sub (char *name, gfc_array_i8 *sarray, GFC_INTEGER_8 *status, + gfc_charlen_type name_len) +{ + stat_i8_sub_0 (name, sarray, status, name_len, 1); +} + +iexport(lstat_i8_sub); + + extern GFC_INTEGER_4 stat_i4 (char *, gfc_array_i4 *, gfc_charlen_type); export_proto(stat_i4); @@ -262,6 +319,40 @@ stat_i8 (char *name, gfc_array_i8 *sarray, gfc_charlen_type name_len) } +/* SUBROUTINE STAT(FILE, SARRAY, STATUS) + CHARACTER(len=*), INTENT(IN) :: FILE + INTEGER, INTENT(OUT), :: SARRAY(13) + INTEGER, INTENT(OUT), OPTIONAL :: STATUS + + FUNCTION STAT(FILE, SARRAY) + INTEGER STAT + CHARACTER(len=*), INTENT(IN) :: FILE + INTEGER, INTENT(OUT), :: SARRAY(13) */ + +extern GFC_INTEGER_4 lstat_i4 (char *, gfc_array_i4 *, gfc_charlen_type); +export_proto(lstat_i4); + +GFC_INTEGER_4 +lstat_i4 (char *name, gfc_array_i4 *sarray, gfc_charlen_type name_len) +{ + GFC_INTEGER_4 val; + lstat_i4_sub (name, sarray, &val, name_len); + return val; +} + +extern GFC_INTEGER_8 lstat_i8 (char *, gfc_array_i8 *, gfc_charlen_type); +export_proto(lstat_i8); + +GFC_INTEGER_8 +lstat_i8 (char *name, gfc_array_i8 *sarray, gfc_charlen_type name_len) +{ + GFC_INTEGER_8 val; + lstat_i8_sub (name, sarray, &val, name_len); + return val; +} + + + /* SUBROUTINE FSTAT(UNIT, SARRAY, STATUS) INTEGER, INTENT(IN) :: UNIT INTEGER, INTENT(OUT) :: SARRAY(13) |