1/* Implementation of the GETCWD intrinsic.
2   Copyright (C) 2004-2020 Free Software Foundation, Inc.
3   Contributed by Steven G. Kargl <kargls@comcast.net>.
4
5This file is part of the GNU Fortran runtime library (libgfortran).
6
7Libgfortran is free software; you can redistribute it and/or
8modify it under the terms of the GNU General Public
9License as published by the Free Software Foundation; either
10version 3 of the License, or (at your option) any later version.
11
12Libgfortran is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15GNU General Public License for more details.
16
17Under Section 7 of GPL version 3, you are granted additional
18permissions described in the GCC Runtime Library Exception, version
193.1, as published by the Free Software Foundation.
20
21You should have received a copy of the GNU General Public License and
22a copy of the GCC Runtime Library Exception along with this program;
23see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
24<http://www.gnu.org/licenses/>.  */
25
26#include "libgfortran.h"
27
28#include <string.h>
29#include <errno.h>
30
31#ifdef HAVE_UNISTD_H
32#include <unistd.h>
33#endif
34
35#ifdef HAVE_GETCWD
36
37extern void getcwd_i4_sub (char *, GFC_INTEGER_4 *, gfc_charlen_type);
38iexport_proto(getcwd_i4_sub);
39
40void
41getcwd_i4_sub (char *cwd, GFC_INTEGER_4 *status, gfc_charlen_type cwd_len)
42{
43  int err;
44
45  if (getcwd (cwd, cwd_len))
46    {
47      size_t len = strlen (cwd);
48      memset (cwd + len, ' ', cwd_len - len);
49      err = 0;
50    }
51  else if (errno == ERANGE)
52    {
53      /* There is a possibility that the previous attempt failed due
54	 to not enough space for the terminating null byte. Try again
55	 with a buffer one char longer.  */
56      char *buf = xmalloc (cwd_len + 1);
57      if (getcwd (buf, cwd_len + 1))
58	{
59	  memcpy (cwd, buf, cwd_len);
60	  err = 0;
61	}
62      else
63	err = errno;
64      free (buf);
65    }
66  else
67    err = errno;
68  if (err)
69    memset (cwd, ' ', cwd_len);
70  if (status != NULL)
71    *status = err;
72}
73iexport(getcwd_i4_sub);
74
75extern void getcwd_i8_sub (char *, GFC_INTEGER_8 *, gfc_charlen_type);
76export_proto(getcwd_i8_sub);
77
78void
79getcwd_i8_sub (char *cwd, GFC_INTEGER_8 *status, gfc_charlen_type cwd_len)
80{
81  GFC_INTEGER_4 status4;
82  getcwd_i4_sub (cwd, &status4, cwd_len);
83  if (status)
84    *status = status4;
85}
86
87extern GFC_INTEGER_4 PREFIX(getcwd) (char *, gfc_charlen_type);
88export_proto_np(PREFIX(getcwd));
89
90GFC_INTEGER_4
91PREFIX(getcwd) (char *cwd, gfc_charlen_type cwd_len)
92{
93  GFC_INTEGER_4 status;
94  getcwd_i4_sub (cwd, &status, cwd_len);
95  return status;
96}
97
98#endif
99