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