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