symlnk.c revision 1.1.1.2 
1/* Implementation of the SYMLNK 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 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 SYMLNK(PATH1, PATH2, STATUS)
35   CHARACTER(len=*), INTENT(IN) :: PATH1, PATH2
36   INTEGER, INTENT(OUT), OPTIONAL :: STATUS  */
37
38#ifdef HAVE_SYMLINK
39static int
40symlnk_internal (char *path1, char *path2, gfc_charlen_type path1_len,
41		 gfc_charlen_type path2_len)
42{
43  char *str1 = fc_strdup (path1, path1_len);
44  char *str2 = fc_strdup (path2, path2_len);
45  int val = symlink (str1, str2);
46  free (str1);
47  free (str2);
48  return ((val == 0) ? 0 : errno);
49}
50
51extern void symlnk_i4_sub (char *, char *, GFC_INTEGER_4 *, gfc_charlen_type,
52	                 gfc_charlen_type);
53iexport_proto(symlnk_i4_sub);
54
55void
56symlnk_i4_sub (char *path1, char *path2, GFC_INTEGER_4 *status,
57             gfc_charlen_type path1_len, gfc_charlen_type path2_len)
58{
59  int val = symlnk_internal (path1, path2, path1_len, path2_len);
60  if (status != NULL)
61    *status = val;
62}
63iexport(symlnk_i4_sub);
64
65extern void symlnk_i8_sub (char *, char *, GFC_INTEGER_8 *, gfc_charlen_type,
66	                 gfc_charlen_type);
67iexport_proto(symlnk_i8_sub);
68
69void
70symlnk_i8_sub (char *path1, char *path2, GFC_INTEGER_8 *status,
71             gfc_charlen_type path1_len, gfc_charlen_type path2_len)
72{
73  int val = symlnk_internal (path1, path2, path1_len, path2_len);
74  if (status != NULL)
75    *status = val;
76}
77iexport(symlnk_i8_sub);
78
79extern GFC_INTEGER_4 symlnk_i4 (char *, char *, gfc_charlen_type,
80	                      gfc_charlen_type);
81export_proto(symlnk_i4);
82
83GFC_INTEGER_4
84symlnk_i4 (char *path1, char *path2, gfc_charlen_type path1_len,
85         gfc_charlen_type path2_len)
86{
87  return symlnk_internal (path1, path2, path1_len, path2_len);
88}
89
90extern GFC_INTEGER_8 symlnk_i8 (char *, char *, gfc_charlen_type,
91	                      gfc_charlen_type);
92export_proto(symlnk_i8);
93
94GFC_INTEGER_8
95symlnk_i8 (char *path1, char *path2, gfc_charlen_type path1_len,
96	 gfc_charlen_type path2_len)
97{
98  return symlnk_internal (path1, path2, path1_len, path2_len);
99}
100#endif
101