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