1139823Simp/* Implementation of the LINK intrinsic. 211819Sjulian Copyright (C) 2005-2022 Free Software Foundation, Inc. 311819Sjulian Contributed by Fran��ois-Xavier Coudert <coudert@clipper.ens.fr> 411819Sjulian 511819SjulianThis file is part of the GNU Fortran runtime library (libgfortran). 611819Sjulian 711819SjulianLibgfortran is free software; you can redistribute it and/or 811819Sjulianmodify it under the terms of the GNU General Public 911819SjulianLicense as published by the Free Software Foundation; either 1011819Sjulianversion 3 of the License, or (at your option) any later version. 1111819Sjulian 1211819SjulianLibgfortran is distributed in the hope that it will be useful, 13165899Srwatsonbut WITHOUT ANY WARRANTY; without even the implied warranty of 14165899SrwatsonMERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15165899SrwatsonGNU General Public License for more details. 16165899Srwatson 17165899SrwatsonUnder Section 7 of GPL version 3, you are granted additional 18165899Srwatsonpermissions described in the GCC Runtime Library Exception, version 19165899Srwatson3.1, as published by the Free Software Foundation. 20165899Srwatson 21165899SrwatsonYou should have received a copy of the GNU General Public License and 22165899Srwatsona copy of the GCC Runtime Library Exception along with this program; 23165899Srwatsonsee the files COPYING3 and COPYING.RUNTIME respectively. If not, see 24165899Srwatson<http://www.gnu.org/licenses/>. */ 25165899Srwatson 26165899Srwatson#include "libgfortran.h" 27165899Srwatson 28165899Srwatson#include <errno.h> 29165899Srwatson 30165899Srwatson#ifdef HAVE_UNISTD_H 31165899Srwatson#include <unistd.h> 32165899Srwatson#endif 33165899Srwatson 34165899Srwatson/* SUBROUTINE LINK(PATH1, PATH2, STATUS) 35165899Srwatson CHARACTER(len=*), INTENT(IN) :: PATH1, PATH2 36165899Srwatson INTEGER, INTENT(OUT), OPTIONAL :: STATUS */ 37165899Srwatson 38165899Srwatson#ifdef HAVE_LINK 3911819Sjulian 4011819Sjulianstatic int 4111819Sjulianlink_internal (char *path1, char *path2, gfc_charlen_type path1_len, 4211819Sjulian gfc_charlen_type path2_len) 4311819Sjulian{ 4411819Sjulian int val; 4511819Sjulian char *str1, *str2; 4611819Sjulian 4711819Sjulian /* Make a null terminated copy of the strings. */ 4811819Sjulian str1 = fc_strdup (path1, path1_len); 4911819Sjulian str2 = fc_strdup (path2, path2_len); 5011819Sjulian 5111819Sjulian val = link (str1, str2); 5211819Sjulian 5311819Sjulian free (str1); 5411819Sjulian free (str2); 5511819Sjulian 5611819Sjulian return ((val == 0) ? 0 : errno); 5711819Sjulian} 5811819Sjulian 5912057Sjulian 6011819Sjulianextern void link_i4_sub (char *, char *, GFC_INTEGER_4 *, gfc_charlen_type, 6111819Sjulian gfc_charlen_type); 62116189Sobrieniexport_proto(link_i4_sub); 63116189Sobrien 64116189Sobrienvoid 6532350Seivindlink_i4_sub (char *path1, char *path2, GFC_INTEGER_4 *status, 6630806Sbde gfc_charlen_type path1_len, gfc_charlen_type path2_len) 6730806Sbde{ 6811819Sjulian int val = link_internal (path1, path2, path1_len, path2_len); 6911819Sjulian 7011819Sjulian if (status != NULL) 7111819Sjulian *status = val; 72171656Sdes} 73171656Sdesiexport(link_i4_sub); 7411819Sjulian 7511819Sjulianextern void link_i8_sub (char *, char *, GFC_INTEGER_8 *, gfc_charlen_type, 7611819Sjulian gfc_charlen_type); 7711819Sjulianiexport_proto(link_i8_sub); 7830806Sbde 7911819Sjulianvoid 8011819Sjulianlink_i8_sub (char *path1, char *path2, GFC_INTEGER_8 *status, 8111819Sjulian gfc_charlen_type path1_len, gfc_charlen_type path2_len) 8211819Sjulian{ 8311819Sjulian int val = link_internal (path1, path2, path1_len, path2_len); 8411819Sjulian 85193892Sbz if (status != NULL) 8615239Sbde *status = val; 8725652Sjhay} 8825652Sjhayiexport(link_i8_sub); 8925652Sjhay 9015239Sbdeextern GFC_INTEGER_4 link_i4 (char *, char *, gfc_charlen_type, 91193892Sbz gfc_charlen_type); 9215239Sbdeexport_proto(link_i4); 9311819Sjulian 9411819SjulianGFC_INTEGER_4 9511819Sjulianlink_i4 (char *path1, char *path2, gfc_charlen_type path1_len, 9611819Sjulian gfc_charlen_type path2_len) 97169463Srwatson{ 98169463Srwatson return link_internal (path1, path2, path1_len, path2_len); 9911819Sjulian} 10011819Sjulian 10111819Sjulianextern GFC_INTEGER_8 link_i8 (char *, char *, gfc_charlen_type, 10211819Sjulian gfc_charlen_type); 10311819Sjulianexport_proto(link_i8); 10411819Sjulian 10511819SjulianGFC_INTEGER_8 10611819Sjulianlink_i8 (char *path1, char *path2, gfc_charlen_type path1_len, 10711819Sjulian gfc_charlen_type path2_len) 10811819Sjulian{ 10911819Sjulian return link_internal (path1, path2, path1_len, path2_len); 11011819Sjulian} 11111819Sjulian#endif 11225652Sjhay