From ab5619bc02bf3cd848c2d8162656e22184e20bc4 Mon Sep 17 00:00:00 2001 From: steven Date: Sat, 20 Nov 2004 01:44:49 +0000 Subject: * check.c (gfc_check_getcwd_sub): Fix seg fault. * check.c (gfc_check_exit,gfc_check_umask,gfc_check_umask_sub, gfc_check_unlink,gfc_check_unlink_sub): New functions * gfortran.h (GFC_ISYM_UMASK,GFC_ISYM_UNLINK): New symbols * intrinsic.c (add_functions,add_subroutines): Add umask, unlink, exit to intrinsics symbol tables. * intrinsic.h (gfc_check_umask,gfc_check_unlink,gfc_check_exit, gfc_check_umask_sub,gfc_check_unlink_sub,gfc_resolve_umask, gfc_resolve_unlink,gfc_resolve_exit,gfc_resolve_umask_sub, gfc_resolve_unlink_sub): Add and sort prototypes. * iresolve.c (gfc_resolve_umask,gfc_resolve_unlink,gfc_resolve_exit, gfc_resolve_umask_sub,gfc_resolve_unlink_sub): New functions * trans-intrinsic.c (gfc_conv_intrinsic_function): Use symbols libgfortran/ * Makefile.am: Add intrinsics/{umask.c,unlink.c,exit.c} * Makefile.in: Regenerated * intrinsics/umask.c: New file * intrinsics/unlink.c: ditto * intrinsics/exit.c: ditto git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@90949 138bc75d-0d04-0410-961f-82ee72b054a4 --- libgfortran/intrinsics/umask.c | 75 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 75 insertions(+) create mode 100644 libgfortran/intrinsics/umask.c (limited to 'libgfortran/intrinsics/umask.c') diff --git a/libgfortran/intrinsics/umask.c b/libgfortran/intrinsics/umask.c new file mode 100644 index 00000000000..cf41451e31a --- /dev/null +++ b/libgfortran/intrinsics/umask.c @@ -0,0 +1,75 @@ +/* Implementation of the UMASK intrinsic. + Copyright (C) 2004 Free Software Foundation, Inc. + Contributed by Steven G. Kargl . + +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 Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +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 Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + + +#include "config.h" +#include "libgfortran.h" + +#ifdef HAVE_STDLIB_H +#include +#endif + +#ifdef HAVE_SYS_STAT_H +#include +#endif + +/* SUBROUTINE UMASK(MASK, OLD) + INTEGER, INTENT(IN) :: MASK + INTEGER, INTENT(OUT), OPTIONAL :: OLD */ + +void +prefix(umask_i4_sub) (GFC_INTEGER_4 * mask, GFC_INTEGER_4 * old) +{ + mode_t val; + + val = umask((mode_t) *mask); + if (old != NULL) + *old = (GFC_INTEGER_4) val; +} + +void +prefix(umask_i8_sub) (GFC_INTEGER_8 * mask, GFC_INTEGER_8 * old) +{ + mode_t val; + + val = umask((mode_t) *mask); + if (old != NULL) + *old = (GFC_INTEGER_8) val; +} + +/* INTEGER FUNCTION UMASK(MASK) + INTEGER, INTENT(IN) :: MASK */ + +GFC_INTEGER_4 +prefix(umask) (GFC_INTEGER_4 * mask) +{ + GFC_INTEGER_4 old; + prefix(umask_i4_sub) (mask, &old); + return old; +} + +GFC_INTEGER_8 +prefix(umask_i8) (GFC_INTEGER_8 * mask) +{ + GFC_INTEGER_8 old; + prefix(umask_i8_sub) (mask, &old); + return old; +} -- cgit v1.2.1