diff options
author | fxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4> | 2006-07-30 20:48:00 +0000 |
---|---|---|
committer | fxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4> | 2006-07-30 20:48:00 +0000 |
commit | d2fc5bb1c109c1afbe52c970650c2cc250b95459 (patch) | |
tree | 42900f38bd309eacda612a5027a33176a6f75fb0 /libgfortran | |
parent | 5d87d34c2adc7950a04fda3147e59ab7ff527639 (diff) | |
download | gcc-d2fc5bb1c109c1afbe52c970650c2cc250b95459.tar.gz |
* intrinsic.c (add_functions): Add ACCESS, CHMOD, RSHIFT, LSHIFT.
(add_subroutines): Add LTIME, GMTIME and CHMOD.
* intrinsic.h (gfc_check_access_func, gfc_check_chmod,
gfc_check_chmod_sub, gfc_check_ltime_gmtime, gfc_simplify_rshift,
gfc_simplify_lshift, gfc_resolve_access, gfc_resolve_chmod,
gfc_resolve_rshift, gfc_resolve_lshift, gfc_resolve_chmod_sub,
gfc_resolve_gmtime, gfc_resolve_ltime): Add prototypes.
* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_ACCESS,
GFC_ISYM_CHMOD, GFC_ISYM_LSHIFT, GFC_ISYM_RSHIFT.
* iresolve.c (gfc_resolve_access, gfc_resolve_chmod,
gfc_resolve_rshift, gfc_resolve_lshift, gfc_resolve_chmod_sub,
gfc_resolve_gmtime, gfc_resolve_ltime): New functions.
* check.c (gfc_check_access_func, gfc_check_chmod,
gfc_check_chmod_sub, gfc_check_ltime_gmtime): New functions.
* trans-intrinsic.c (gfc_conv_intrinsic_rlshift): New function.
(gfc_conv_intrinsic_function): Add cases for the new GFC_ISYM_*.
* intrinsics/date_and_time.c: Add functions for GMTIME and LTIME.
* intrinsics/access.c: New file.
* intrinsics/chmod.c: New file.
* configure.ac: Add checks for <sys/wait.h>, access, fork,execl
and wait.
* Makefile.am: Add new files intrinsics/access.c and
intrinsics/chmod.c.
* configure: Regenerate.
* config.h.in: Regenerate.
* Makefile.in: Regenerate.
* gcc/testsuite/gfortran.dg/chmod_3.f90: New test.
* gcc/testsuite/gfortran.dg/ltime_gmtime_1.f90: New test.
* gcc/testsuite/gfortran.dg/ltime_gmtime_2.f90: New test.
* gcc/testsuite/gfortran.dg/lrshift_1.f90: New test.
* gcc/testsuite/gfortran.dg/chmod_1.f90: New test.
* gcc/testsuite/gfortran.dg/chmod_2.f90: New test.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@115825 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'libgfortran')
-rw-r--r-- | libgfortran/Makefile.am | 2 | ||||
-rw-r--r-- | libgfortran/Makefile.in | 14 | ||||
-rw-r--r-- | libgfortran/config.h.in | 15 | ||||
-rwxr-xr-x | libgfortran/configure | 183 | ||||
-rw-r--r-- | libgfortran/configure.ac | 5 | ||||
-rw-r--r-- | libgfortran/intrinsics/access.c | 99 | ||||
-rw-r--r-- | libgfortran/intrinsics/chmod.c | 131 | ||||
-rw-r--r-- | libgfortran/intrinsics/date_and_time.c | 185 |
8 files changed, 568 insertions, 66 deletions
diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am index ff1211a7d85..cae0f8a50b1 100644 --- a/libgfortran/Makefile.am +++ b/libgfortran/Makefile.am @@ -41,10 +41,12 @@ io/io.h gfor_helper_src= \ intrinsics/associated.c \ intrinsics/abort.c \ +intrinsics/access.c \ intrinsics/args.c \ intrinsics/bessel.c \ intrinsics/c99_functions.c \ intrinsics/chdir.c \ +intrinsics/chmod.c \ intrinsics/clock.c \ intrinsics/cpu_time.c \ intrinsics/cshift0.c \ diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in index ba3c3b0e2a6..1a0665e0ee4 100644 --- a/libgfortran/Makefile.in +++ b/libgfortran/Makefile.in @@ -161,9 +161,9 @@ am__objects_28 = $(am__objects_2) $(am__objects_3) $(am__objects_4) \ 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 clock.lo cpu_time.lo cshift0.lo \ - ctime.lo date_and_time.lo env.lo erf.lo eoshift0.lo \ +am__objects_30 = associated.lo abort.lo access.lo args.lo bessel.lo \ + c99_functions.lo chdir.lo chmod.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 \ @@ -385,10 +385,12 @@ io/io.h gfor_helper_src = \ intrinsics/associated.c \ intrinsics/abort.c \ +intrinsics/access.c \ intrinsics/args.c \ intrinsics/bessel.c \ intrinsics/c99_functions.c \ intrinsics/chdir.c \ +intrinsics/chmod.c \ intrinsics/clock.c \ intrinsics/cpu_time.c \ intrinsics/cshift0.c \ @@ -2204,6 +2206,9 @@ associated.lo: intrinsics/associated.c abort.lo: intrinsics/abort.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o abort.lo `test -f 'intrinsics/abort.c' || echo '$(srcdir)/'`intrinsics/abort.c +access.lo: intrinsics/access.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o access.lo `test -f 'intrinsics/access.c' || echo '$(srcdir)/'`intrinsics/access.c + args.lo: intrinsics/args.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o args.lo `test -f 'intrinsics/args.c' || echo '$(srcdir)/'`intrinsics/args.c @@ -2216,6 +2221,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 +chmod.lo: intrinsics/chmod.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o chmod.lo `test -f 'intrinsics/chmod.c' || echo '$(srcdir)/'`intrinsics/chmod.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 diff --git a/libgfortran/config.h.in b/libgfortran/config.h.in index 573c0938f07..11f8e72e1bc 100644 --- a/libgfortran/config.h.in +++ b/libgfortran/config.h.in @@ -6,6 +6,9 @@ /* Define to 0 if the target shouldn't use #pragma weak */ #undef GTHREAD_USE_WEAK +/* Define to 1 if you have the `access' function. */ +#undef HAVE_ACCESS + /* libm includes acos */ #undef HAVE_ACOS @@ -279,6 +282,9 @@ /* libm includes erfl */ #undef HAVE_ERFL +/* Define to 1 if you have the `execl' function. */ +#undef HAVE_EXECL + /* libm includes exp */ #undef HAVE_EXP @@ -321,6 +327,9 @@ /* libm includes floorl */ #undef HAVE_FLOORL +/* Define to 1 if you have the `fork' function. */ +#undef HAVE_FORK + /* Define if you have fpsetmask. */ #undef HAVE_FPSETMASK @@ -582,6 +591,9 @@ /* Define to 1 if you have the <sys/types.h> header file. */ #undef HAVE_SYS_TYPES_H +/* Define to 1 if you have the <sys/wait.h> header file. */ +#undef HAVE_SYS_WAIT_H + /* libm includes tan */ #undef HAVE_TAN @@ -630,6 +642,9 @@ /* Define if target can unlink open files. */ #undef HAVE_UNLINK_OPEN_FILE +/* Define to 1 if you have the `wait' function. */ +#undef HAVE_WAIT + /* Define if target has a reliable stat. */ #undef HAVE_WORKING_STAT diff --git a/libgfortran/configure b/libgfortran/configure index 6cb118b88e2..7af0b3209e1 100755 --- a/libgfortran/configure +++ b/libgfortran/configure @@ -6114,7 +6114,8 @@ done -for ac_header in sys/types.h sys/stat.h floatingpoint.h ieeefp.h + +for ac_header in sys/types.h sys/stat.h sys/wait.h floatingpoint.h ieeefp.h do as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh` if eval "test \"\${$as_ac_Header+set}\" = set"; then @@ -6897,9 +6898,8 @@ fi break done if test "$acx_cv_header_stdint" = stddef.h; then - acx_cv_header_stdint_kind="(lacks uintmax_t)" + acx_cv_header_stdint_kind="(lacks uintptr_t)" for i in stdint.h $inttype_headers; do - unset ac_cv_type_uintptr_t unset ac_cv_type_uint32_t unset ac_cv_type_uint64_t echo $ECHO_N "looking for an incomplete stdint.h in $i, $ECHO_C" >&6 @@ -7025,65 +7025,11 @@ rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_type_uint64_t" >&5 echo "${ECHO_T}$ac_cv_type_uint64_t" >&6 - - echo "$as_me:$LINENO: checking for uintptr_t" >&5 -echo $ECHO_N "checking for uintptr_t... $ECHO_C" >&6 -if test "${ac_cv_type_uintptr_t+set}" = set; then - echo $ECHO_N "(cached) $ECHO_C" >&6 -else - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ -#include <sys/types.h> -#include <$i> - -int -main () -{ -if ((uintptr_t *) 0) - return 0; -if (sizeof (uintptr_t)) - return 0; - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 2>conftest.er1 - ac_status=$? - grep -v '^ *+' conftest.er1 >conftest.err - rm -f conftest.er1 - cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" - || test ! -s conftest.err' - { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 - (eval $ac_try) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); }; } && - { ac_try='test -s conftest.$ac_objext' - { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 - (eval $ac_try) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); }; }; then - ac_cv_type_uintptr_t=yes +if test $ac_cv_type_uint64_t = yes; then + : else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -ac_cv_type_uintptr_t=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext + acx_cv_header_stdint_kind="(lacks uintptr_t and uint64_t)" fi -echo "$as_me:$LINENO: result: $ac_cv_type_uintptr_t" >&5 -echo "${ECHO_T}$ac_cv_type_uintptr_t" >&6 break done @@ -7216,6 +7162,11 @@ rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_type_u_int64_t" >&5 echo "${ECHO_T}$ac_cv_type_u_int64_t" >&6 +if test $ac_cv_type_u_int64_t = yes; then + : +else + acx_cv_header_stdint_kind="(u_intXX_t style, lacks u_int64_t)" +fi break done @@ -9976,7 +9927,117 @@ done -for ac_func in sleep time ttyname signal alarm ctime clock + + + +for ac_func in sleep time ttyname signal alarm ctime clock access fork execl +do +as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` +echo "$as_me:$LINENO: checking for $ac_func" >&5 +echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 +if eval "test \"\${$as_ac_var+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + if test x$gcc_no_link = xyes; then + { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5 +echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;} + { (exit 1); exit 1; }; } +fi +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func. + For example, HP-UX 11i <limits.h> declares gettimeofday. */ +#define $ac_func innocuous_$ac_func + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char $ac_func (); below. + Prefer <limits.h> to <assert.h> if __STDC__ is defined, since + <limits.h> exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include <limits.h> +#else +# include <assert.h> +#endif + +#undef $ac_func + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char $ac_func (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_$ac_func) || defined (__stub___$ac_func) +choke me +#else +char (*f) () = $ac_func; +#endif +#ifdef __cplusplus +} +#endif + +int +main () +{ +return f != $ac_func; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + eval "$as_ac_var=yes" +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +eval "$as_ac_var=no" +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 +if test `eval echo '${'$as_ac_var'}'` = yes; then + cat >>confdefs.h <<_ACEOF +#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + + +for ac_func in wait 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 51756597d03..5e8efd49b35 100644 --- a/libgfortran/configure.ac +++ b/libgfortran/configure.ac @@ -159,7 +159,7 @@ AC_TYPE_OFF_T AC_STDC_HEADERS AC_HAVE_HEADERS(stdlib.h stdio.h string.h stddef.h math.h unistd.h signal.h) AC_CHECK_HEADERS(time.h sys/params.h sys/time.h sys/times.h sys/resource.h) -AC_CHECK_HEADERS(sys/types.h sys/stat.h floatingpoint.h ieeefp.h) +AC_CHECK_HEADERS(sys/types.h sys/stat.h sys/wait.h floatingpoint.h ieeefp.h) AC_CHECK_HEADERS(fenv.h fptrap.h float.h) AC_CHECK_HEADER([complex.h],[AC_DEFINE([HAVE_COMPLEX_H], [1], [complex.h exists])]) GCC_HEADER_STDINT(gstdint.h) @@ -171,7 +171,8 @@ 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 clock) +AC_CHECK_FUNCS(sleep time ttyname signal alarm ctime clock access fork execl) +AC_CHECK_FUNCS(wait) # Check libc for getgid, getpid, getuid AC_CHECK_LIB([c],[getgid],[AC_DEFINE([HAVE_GETGID],[1],[libc includes getgid])]) diff --git a/libgfortran/intrinsics/access.c b/libgfortran/intrinsics/access.c new file mode 100644 index 00000000000..b0af0475f62 --- /dev/null +++ b/libgfortran/intrinsics/access.c @@ -0,0 +1,99 @@ +/* Implementation of the ACCESS intrinsic. + 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" + +#include <errno.h> + +#ifdef HAVE_STRING_H +#include <string.h> +#endif +#ifdef HAVE_UNISTD_H +#include <unistd.h> +#endif + +/* INTEGER FUNCTION ACCESS(NAME, MODE) + CHARACTER(len=*), INTENT(IN) :: NAME, MODE */ + +#ifdef HAVE_ACCESS +extern int access_func (char *, char *, gfc_charlen_type, gfc_charlen_type); +export_proto(access_func); + +int +access_func (char *name, char *mode, gfc_charlen_type name_len, + gfc_charlen_type mode_len) +{ + char * file; + gfc_charlen_type i; + int m; + + /* Parse the MODE string. */ + m = F_OK; + for (i = 0; i < mode_len && mode[i]; i++) + switch (mode[i]) + { + case ' ': + break; + + case 'r': + case 'R': + m |= R_OK; + break; + + case 'w': + case 'W': + m |= W_OK; + break; + + case 'x': + case 'X': + m |= X_OK; + break; + + default: + return -1; + break; + } + + /* Trim trailing spaces from NAME argument. */ + while (name_len > 0 && name[name_len - 1] == ' ') + name_len--; + + /* Make a null terminated copy of the string. */ + file = gfc_alloca (name_len + 1); + memcpy (file, name, name_len); + file[name_len] = '\0'; + + /* And make the call to access(). */ + return (access (file, m) == 0 ? 0 : errno); +} +export(access_func); +#endif diff --git a/libgfortran/intrinsics/chmod.c b/libgfortran/intrinsics/chmod.c new file mode 100644 index 00000000000..abc5b99a1a2 --- /dev/null +++ b/libgfortran/intrinsics/chmod.c @@ -0,0 +1,131 @@ +/* Implementation of the CHMOD intrinsic. + 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" + +#include <errno.h> + +#ifdef HAVE_STRING_H +#include <string.h> +#endif +#ifdef HAVE_UNISTD_H +#include <unistd.h> +#endif +#ifdef HAVE_SYS_TYPES_H +#include <sys/types.h> +#endif +#ifdef HAVE_SYS_WAIT_H +#include <sys/wait.h> +#endif + +/* INTEGER FUNCTION ACCESS(NAME, MODE) + CHARACTER(len=*), INTENT(IN) :: NAME, MODE */ + +#if defined(HAVE_FORK) && defined(HAVE_EXECL) && defined(HAVE_WAIT) + +extern int chmod_func (char *, char *, gfc_charlen_type, gfc_charlen_type); +export_proto(chmod_func); + +int +chmod_func (char *name, char *mode, gfc_charlen_type name_len, + gfc_charlen_type mode_len) +{ + char * file, * m; + pid_t pid; + int status; + + /* Trim trailing spaces. */ + while (name_len > 0 && name[name_len - 1] == ' ') + name_len--; + while (mode_len > 0 && mode[mode_len - 1] == ' ') + mode_len--; + + /* Make a null terminated copy of the strings. */ + file = gfc_alloca (name_len + 1); + memcpy (file, name, name_len); + file[name_len] = '\0'; + + m = gfc_alloca (mode_len + 1); + memcpy (m, mode, mode_len); + m[mode_len]= '\0'; + + /* Execute /bin/chmod. */ + if ((pid = fork()) < 0) + return errno; + if (pid == 0) + { + /* Child process. */ + execl ("/bin/chmod", "chmod", m, file, (char *) NULL); + return errno; + } + else + wait (&status); + + if (WIFEXITED(status)) + return WEXITSTATUS(status); + else + return -1; +} + + + +extern void chmod_i4_sub (char *, char *, GFC_INTEGER_4 *, + gfc_charlen_type, gfc_charlen_type); +export_proto(chmod_i4_sub); + +void +chmod_i4_sub (char *name, char *mode, GFC_INTEGER_4 * status, + gfc_charlen_type name_len, gfc_charlen_type mode_len) +{ + int val; + + val = chmod_func (name, mode, name_len, mode_len); + if (status) + *status = val; +} + + +extern void chmod_i8_sub (char *, char *, GFC_INTEGER_8 *, + gfc_charlen_type, gfc_charlen_type); +export_proto(chmod_i8_sub); + +void +chmod_i8_sub (char *name, char *mode, GFC_INTEGER_8 * status, + gfc_charlen_type name_len, gfc_charlen_type mode_len) +{ + int val; + + val = chmod_func (name, mode, name_len, mode_len); + if (status) + *status = val; +} + +#endif diff --git a/libgfortran/intrinsics/date_and_time.c b/libgfortran/intrinsics/date_and_time.c index 68c8cef107a..6a4131f7ddc 100644 --- a/libgfortran/intrinsics/date_and_time.c +++ b/libgfortran/intrinsics/date_and_time.c @@ -521,3 +521,188 @@ idate_i8 (gfc_array_i8 *__values) for (i = 0; i < 3; i++, vptr += delta) *vptr = x[i]; } + + + +/* GMTIME(STIME, TARRAY) - Non-standard + + Description: Given a system time value STime, fills TArray with values + extracted from it appropriate to the GMT time zone using gmtime(3). + + The array elements are as follows: + + 1. Seconds after the minute, range 0-59 or 0-61 to allow for leap seconds + 2. Minutes after the hour, range 0-59 + 3. Hours past midnight, range 0-23 + 4. Day of month, range 0-31 + 5. Number of months since January, range 0-11 + 6. Years since 1900 + 7. Number of days since Sunday, range 0-6 + 8. Days since January 1 + 9. Daylight savings indicator: positive if daylight savings is in effect, + zero if not, and negative if the information isn't available. */ + +static void +gmtime_0 (const time_t * t, int x[9]) +{ + struct tm lt; + + lt = *gmtime (t); + x[0] = lt.tm_sec; + x[1] = lt.tm_min; + x[2] = lt.tm_hour; + x[3] = lt.tm_mday; + x[4] = lt.tm_mon; + x[5] = lt.tm_year; + x[6] = lt.tm_wday; + x[7] = lt.tm_yday; + x[8] = lt.tm_isdst; +} + +extern void gmtime_i4 (GFC_INTEGER_4 *, gfc_array_i4 *); +export_proto(gmtime_i4); + +void +gmtime_i4 (GFC_INTEGER_4 * t, gfc_array_i4 * tarray) +{ + int x[9], i; + size_t len, delta; + GFC_INTEGER_4 *vptr; + time_t tt; + + /* Call helper function. */ + tt = (time_t) *t; + gmtime_0(&tt, x); + + /* Copy the values into the array. */ + len = tarray->dim[0].ubound + 1 - tarray->dim[0].lbound; + assert (len >= 9); + delta = tarray->dim[0].stride; + if (delta == 0) + delta = 1; + + vptr = tarray->data; + for (i = 0; i < 9; i++, vptr += delta) + *vptr = x[i]; +} + +extern void gmtime_i8 (GFC_INTEGER_8 *, gfc_array_i8 *); +export_proto(gmtime_i8); + +void +gmtime_i8 (GFC_INTEGER_8 * t, gfc_array_i8 * tarray) +{ + int x[9], i; + size_t len, delta; + GFC_INTEGER_8 *vptr; + time_t tt; + + /* Call helper function. */ + tt = (time_t) *t; + gmtime_0(&tt, x); + + /* Copy the values into the array. */ + len = tarray->dim[0].ubound + 1 - tarray->dim[0].lbound; + assert (len >= 9); + delta = tarray->dim[0].stride; + if (delta == 0) + delta = 1; + + vptr = tarray->data; + for (i = 0; i < 9; i++, vptr += delta) + *vptr = x[i]; +} + + + + +/* LTIME(STIME, TARRAY) - Non-standard + + Description: Given a system time value STime, fills TArray with values + extracted from it appropriate to the local time zone using localtime(3). + + The array elements are as follows: + + 1. Seconds after the minute, range 0-59 or 0-61 to allow for leap seconds + 2. Minutes after the hour, range 0-59 + 3. Hours past midnight, range 0-23 + 4. Day of month, range 0-31 + 5. Number of months since January, range 0-11 + 6. Years since 1900 + 7. Number of days since Sunday, range 0-6 + 8. Days since January 1 + 9. Daylight savings indicator: positive if daylight savings is in effect, + zero if not, and negative if the information isn't available. */ + +static void +ltime_0 (const time_t * t, int x[9]) +{ + struct tm lt; + + lt = *localtime (t); + x[0] = lt.tm_sec; + x[1] = lt.tm_min; + x[2] = lt.tm_hour; + x[3] = lt.tm_mday; + x[4] = lt.tm_mon; + x[5] = lt.tm_year; + x[6] = lt.tm_wday; + x[7] = lt.tm_yday; + x[8] = lt.tm_isdst; +} + +extern void ltime_i4 (GFC_INTEGER_4 *, gfc_array_i4 *); +export_proto(ltime_i4); + +void +ltime_i4 (GFC_INTEGER_4 * t, gfc_array_i4 * tarray) +{ + int x[9], i; + size_t len, delta; + GFC_INTEGER_4 *vptr; + time_t tt; + + /* Call helper function. */ + tt = (time_t) *t; + ltime_0(&tt, x); + + /* Copy the values into the array. */ + len = tarray->dim[0].ubound + 1 - tarray->dim[0].lbound; + assert (len >= 9); + delta = tarray->dim[0].stride; + if (delta == 0) + delta = 1; + + vptr = tarray->data; + for (i = 0; i < 9; i++, vptr += delta) + *vptr = x[i]; +} + +extern void ltime_i8 (GFC_INTEGER_8 *, gfc_array_i8 *); +export_proto(ltime_i8); + +void +ltime_i8 (GFC_INTEGER_8 * t, gfc_array_i8 * tarray) +{ + int x[9], i; + size_t len, delta; + GFC_INTEGER_8 *vptr; + time_t tt; + + /* Call helper function. */ + tt = (time_t) * t; + ltime_0(&tt, x); + + /* Copy the values into the array. */ + len = tarray->dim[0].ubound + 1 - tarray->dim[0].lbound; + assert (len >= 9); + delta = tarray->dim[0].stride; + if (delta == 0) + delta = 1; + + vptr = tarray->data; + for (i = 0; i < 9; i++, vptr += delta) + *vptr = x[i]; +} + + |