1 1.1 mrg /* Implementation of the LINK intrinsic. 2 1.1.1.4 mrg Copyright (C) 2005-2024 Free Software Foundation, Inc. 3 1.1 mrg Contributed by Franois-Xavier Coudert <coudert (at) clipper.ens.fr> 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 <errno.h> 29 1.1 mrg 30 1.1 mrg #ifdef HAVE_UNISTD_H 31 1.1 mrg #include <unistd.h> 32 1.1 mrg #endif 33 1.1 mrg 34 1.1 mrg /* SUBROUTINE LINK(PATH1, PATH2, STATUS) 35 1.1 mrg CHARACTER(len=*), INTENT(IN) :: PATH1, PATH2 36 1.1 mrg INTEGER, INTENT(OUT), OPTIONAL :: STATUS */ 37 1.1 mrg 38 1.1 mrg #ifdef HAVE_LINK 39 1.1 mrg 40 1.1 mrg static int 41 1.1 mrg link_internal (char *path1, char *path2, gfc_charlen_type path1_len, 42 1.1 mrg gfc_charlen_type path2_len) 43 1.1 mrg { 44 1.1 mrg int val; 45 1.1 mrg char *str1, *str2; 46 1.1 mrg 47 1.1 mrg /* Make a null terminated copy of the strings. */ 48 1.1 mrg str1 = fc_strdup (path1, path1_len); 49 1.1 mrg str2 = fc_strdup (path2, path2_len); 50 1.1 mrg 51 1.1 mrg val = link (str1, str2); 52 1.1 mrg 53 1.1 mrg free (str1); 54 1.1 mrg free (str2); 55 1.1 mrg 56 1.1 mrg return ((val == 0) ? 0 : errno); 57 1.1 mrg } 58 1.1 mrg 59 1.1 mrg 60 1.1 mrg extern void link_i4_sub (char *, char *, GFC_INTEGER_4 *, gfc_charlen_type, 61 1.1 mrg gfc_charlen_type); 62 1.1 mrg iexport_proto(link_i4_sub); 63 1.1 mrg 64 1.1 mrg void 65 1.1 mrg link_i4_sub (char *path1, char *path2, GFC_INTEGER_4 *status, 66 1.1 mrg gfc_charlen_type path1_len, gfc_charlen_type path2_len) 67 1.1 mrg { 68 1.1 mrg int val = link_internal (path1, path2, path1_len, path2_len); 69 1.1 mrg 70 1.1 mrg if (status != NULL) 71 1.1 mrg *status = val; 72 1.1 mrg } 73 1.1 mrg iexport(link_i4_sub); 74 1.1 mrg 75 1.1 mrg extern void link_i8_sub (char *, char *, GFC_INTEGER_8 *, gfc_charlen_type, 76 1.1 mrg gfc_charlen_type); 77 1.1 mrg iexport_proto(link_i8_sub); 78 1.1 mrg 79 1.1 mrg void 80 1.1 mrg link_i8_sub (char *path1, char *path2, GFC_INTEGER_8 *status, 81 1.1 mrg gfc_charlen_type path1_len, gfc_charlen_type path2_len) 82 1.1 mrg { 83 1.1 mrg int val = link_internal (path1, path2, path1_len, path2_len); 84 1.1 mrg 85 1.1 mrg if (status != NULL) 86 1.1 mrg *status = val; 87 1.1 mrg } 88 1.1 mrg iexport(link_i8_sub); 89 1.1 mrg 90 1.1 mrg extern GFC_INTEGER_4 link_i4 (char *, char *, gfc_charlen_type, 91 1.1 mrg gfc_charlen_type); 92 1.1 mrg export_proto(link_i4); 93 1.1 mrg 94 1.1 mrg GFC_INTEGER_4 95 1.1 mrg link_i4 (char *path1, char *path2, gfc_charlen_type path1_len, 96 1.1 mrg gfc_charlen_type path2_len) 97 1.1 mrg { 98 1.1 mrg return link_internal (path1, path2, path1_len, path2_len); 99 1.1 mrg } 100 1.1 mrg 101 1.1 mrg extern GFC_INTEGER_8 link_i8 (char *, char *, gfc_charlen_type, 102 1.1 mrg gfc_charlen_type); 103 1.1 mrg export_proto(link_i8); 104 1.1 mrg 105 1.1 mrg GFC_INTEGER_8 106 1.1 mrg link_i8 (char *path1, char *path2, gfc_charlen_type path1_len, 107 1.1 mrg gfc_charlen_type path2_len) 108 1.1 mrg { 109 1.1 mrg return link_internal (path1, path2, path1_len, path2_len); 110 1.1 mrg } 111 1.1 mrg #endif 112
Indexes created Thu Sep 17 00:24:55 UTC 2026