1/* Implementation of the CHDIR intrinsic. 2 Copyright (C) 2005-2020 Free Software Foundation, Inc. 3 Contributed by Fran��ois-Xavier Coudert <coudert@clipper.ens.fr> 4 5This file is part of the GNU Fortran 95 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 <errno.h> 29 30#ifdef HAVE_UNISTD_H 31#include <unistd.h> 32#endif 33 34/* SUBROUTINE CHDIR(DIR, STATUS) 35 CHARACTER(len=*), INTENT(IN) :: DIR 36 INTEGER, INTENT(OUT), OPTIONAL :: STATUS */ 37 38#ifdef HAVE_CHDIR 39extern void chdir_i4_sub (char *, GFC_INTEGER_4 *, gfc_charlen_type); 40iexport_proto(chdir_i4_sub); 41 42void 43chdir_i4_sub (char *dir, GFC_INTEGER_4 *status, gfc_charlen_type dir_len) 44{ 45 int val; 46 char *str = fc_strdup (dir, dir_len); 47 48 val = chdir (str); 49 free (str); 50 51 if (status != NULL) 52 *status = (val == 0) ? 0 : errno; 53} 54iexport(chdir_i4_sub); 55 56extern void chdir_i8_sub (char *, GFC_INTEGER_8 *, gfc_charlen_type); 57iexport_proto(chdir_i8_sub); 58 59void 60chdir_i8_sub (char *dir, GFC_INTEGER_8 *status, gfc_charlen_type dir_len) 61{ 62 int val; 63 char *str = fc_strdup (dir, dir_len); 64 65 val = chdir (str); 66 free (str); 67 68 if (status != NULL) 69 *status = (val == 0) ? 0 : errno; 70} 71iexport(chdir_i8_sub); 72 73extern GFC_INTEGER_4 chdir_i4 (char *, gfc_charlen_type); 74export_proto(chdir_i4); 75 76GFC_INTEGER_4 77chdir_i4 (char *dir, gfc_charlen_type dir_len) 78{ 79 GFC_INTEGER_4 val; 80 chdir_i4_sub (dir, &val, dir_len); 81 return val; 82} 83 84extern GFC_INTEGER_8 chdir_i8 (char *, gfc_charlen_type); 85export_proto(chdir_i8); 86 87GFC_INTEGER_8 88chdir_i8 (char *dir, gfc_charlen_type dir_len) 89{ 90 GFC_INTEGER_8 val; 91 chdir_i8_sub (dir, &val, dir_len); 92 return val; 93} 94#endif 95