diff options
author | steven <steven@138bc75d-0d04-0410-961f-82ee72b054a4> | 2004-11-20 01:44:49 +0000 |
---|---|---|
committer | steven <steven@138bc75d-0d04-0410-961f-82ee72b054a4> | 2004-11-20 01:44:49 +0000 |
commit | ab5619bc02bf3cd848c2d8162656e22184e20bc4 (patch) | |
tree | b1ef78f610bfdcc13867c75b1e08219b8aa591c5 /libgfortran/intrinsics/unlink.c | |
parent | ff8365c7a0369c879e6b69256d5c3b34cbaeb9e1 (diff) | |
download | gcc-ab5619bc02bf3cd848c2d8162656e22184e20bc4.tar.gz |
* 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
Diffstat (limited to 'libgfortran/intrinsics/unlink.c')
-rw-r--r-- | libgfortran/intrinsics/unlink.c | 85 |
1 files changed, 85 insertions, 0 deletions
diff --git a/libgfortran/intrinsics/unlink.c b/libgfortran/intrinsics/unlink.c new file mode 100644 index 00000000000..11c35099a90 --- /dev/null +++ b/libgfortran/intrinsics/unlink.c @@ -0,0 +1,85 @@ +/* Implementation of the UNLINK intrinsic. + Copyright (C) 2004 Free Software Foundation, Inc. + Contributed by Steven G. Kargl <kargls@comcast.net>. + +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_UNISTD_H +#include <unistd.h> +#endif +#ifdef HAVE_STRING_H +#include <string.h> +#endif + +#include <errno.h> + +/* SUBROUTINE UNLINK(NAME, STATUS) + CHARACTER(LEN= ), INTENT(IN) :: NAME + INTEGER, INTENT(OUT), OPTIONAL :: STATUS) */ + +void +prefix(unlink_i4_sub) (char * name, GFC_INTEGER_4 * status, + gfc_charlen_type name_len) +{ + + char *str, *s; + GFC_INTEGER_4 stat; + + /* Trim trailing spaces from name. */ + while (name_len > 0 && name[name_len - 1] == ' ') + name_len--; + + /* Make a null terminated copy of the string. */ + str = gfc_alloca (name_len + 1); + memcpy (str, name, name_len); + str[name_len] = '\0'; + + stat = unlink (str); + + if (status != NULL) + *status = (stat == 0) ? stat : errno; +} + + +void +prefix(unlink_i8_sub) (char * name, GFC_INTEGER_8 * status, + gfc_charlen_type name_len) +{ + + GFC_INTEGER_4 status4; + + prefix (unlink_i4_sub) (name, &status4, name_len); + if (status) + *status = status4; +} + + +/* INTEGER FUNCTION UNLINK(NAME) + CHARACTER(LEN= ), INTENT(IN) :: NAME */ + +GFC_INTEGER_4 +prefix(unlink) (char * name, gfc_charlen_type name_len) +{ + GFC_INTEGER_4 status; + prefix(unlink_i4_sub) (name, &status, name_len); + return status; +} + |