1627f7eb2Smrg /* Implementation of the ACCESS intrinsic.
2*4c3eb207Smrg Copyright (C) 2006-2020 Free Software Foundation, Inc.
3627f7eb2Smrg Contributed by François-Xavier Coudert <coudert@clipper.ens.fr>
4627f7eb2Smrg
5627f7eb2Smrg This file is part of the GNU Fortran runtime library (libgfortran).
6627f7eb2Smrg
7627f7eb2Smrg Libgfortran is free software; you can redistribute it and/or
8627f7eb2Smrg modify it under the terms of the GNU General Public
9627f7eb2Smrg License as published by the Free Software Foundation; either
10627f7eb2Smrg version 3 of the License, or (at your option) any later version.
11627f7eb2Smrg
12627f7eb2Smrg Libgfortran is distributed in the hope that it will be useful,
13627f7eb2Smrg but WITHOUT ANY WARRANTY; without even the implied warranty of
14627f7eb2Smrg MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15627f7eb2Smrg GNU General Public License for more details.
16627f7eb2Smrg
17627f7eb2Smrg Under Section 7 of GPL version 3, you are granted additional
18627f7eb2Smrg permissions described in the GCC Runtime Library Exception, version
19627f7eb2Smrg 3.1, as published by the Free Software Foundation.
20627f7eb2Smrg
21627f7eb2Smrg You should have received a copy of the GNU General Public License and
22627f7eb2Smrg a copy of the GCC Runtime Library Exception along with this program;
23627f7eb2Smrg see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
24627f7eb2Smrg <http://www.gnu.org/licenses/>. */
25627f7eb2Smrg
26627f7eb2Smrg #include "libgfortran.h"
27627f7eb2Smrg
28627f7eb2Smrg #include <errno.h>
29627f7eb2Smrg
30627f7eb2Smrg #ifdef HAVE_UNISTD_H
31627f7eb2Smrg #include <unistd.h>
32627f7eb2Smrg #endif
33627f7eb2Smrg
34627f7eb2Smrg /* INTEGER FUNCTION ACCESS(NAME, MODE)
35627f7eb2Smrg CHARACTER(len=*), INTENT(IN) :: NAME, MODE */
36627f7eb2Smrg
37627f7eb2Smrg #ifdef HAVE_ACCESS
38627f7eb2Smrg extern int access_func (char *, char *, gfc_charlen_type, gfc_charlen_type);
39627f7eb2Smrg export_proto(access_func);
40627f7eb2Smrg
41627f7eb2Smrg int
access_func(char * name,char * mode,gfc_charlen_type name_len,gfc_charlen_type mode_len)42627f7eb2Smrg access_func (char *name, char *mode, gfc_charlen_type name_len,
43627f7eb2Smrg gfc_charlen_type mode_len)
44627f7eb2Smrg {
45627f7eb2Smrg gfc_charlen_type i;
46627f7eb2Smrg int m;
47627f7eb2Smrg
48627f7eb2Smrg /* Parse the MODE string. */
49627f7eb2Smrg m = F_OK;
50627f7eb2Smrg for (i = 0; i < mode_len && mode[i]; i++)
51627f7eb2Smrg switch (mode[i])
52627f7eb2Smrg {
53627f7eb2Smrg case ' ':
54627f7eb2Smrg break;
55627f7eb2Smrg
56627f7eb2Smrg case 'r':
57627f7eb2Smrg case 'R':
58627f7eb2Smrg m |= R_OK;
59627f7eb2Smrg break;
60627f7eb2Smrg
61627f7eb2Smrg case 'w':
62627f7eb2Smrg case 'W':
63627f7eb2Smrg m |= W_OK;
64627f7eb2Smrg break;
65627f7eb2Smrg
66627f7eb2Smrg case 'x':
67627f7eb2Smrg case 'X':
68627f7eb2Smrg m |= X_OK;
69627f7eb2Smrg break;
70627f7eb2Smrg
71627f7eb2Smrg default:
72627f7eb2Smrg return -1;
73627f7eb2Smrg break;
74627f7eb2Smrg }
75627f7eb2Smrg
76627f7eb2Smrg char *path = fc_strdup (name, name_len);
77627f7eb2Smrg
78627f7eb2Smrg /* And make the call to access(). */
79627f7eb2Smrg int res = (access (path, m) == 0 ? 0 : errno);
80627f7eb2Smrg
81627f7eb2Smrg free (path);
82627f7eb2Smrg return res;
83627f7eb2Smrg }
84627f7eb2Smrg #endif
85