]> git.ipfire.org Git - thirdparty/gcc.git/blame - libgfortran/intrinsics/rename.c
minloc1.m4: Update copyright year and ajust headers order.
[thirdparty/gcc.git] / libgfortran / intrinsics / rename.c
CommitLineData
f77b6ca3 1/* Implementation of the RENAME intrinsic.
36ae8a61 2 Copyright (C) 2005, 2007 Free Software Foundation, Inc.
f77b6ca3
FXC
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 2 of the License, or (at your option) any later version.
11
12In addition to the permissions in the GNU General Public License, the
13Free Software Foundation gives you unlimited permission to link the
14compiled version of this file into combinations with other programs,
15and to distribute those combinations without any restriction coming
16from the use of this file. (The General Public License restrictions
17do apply in other respects; for example, they cover modification of
18the file, and distribution when not linked into a combine
19executable.)
20
21Libgfortran is distributed in the hope that it will be useful,
22but WITHOUT ANY WARRANTY; without even the implied warranty of
23MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24GNU General Public License for more details.
25
26You should have received a copy of the GNU General Public
27License along with libgfortran; see the file COPYING. If not,
fe2ae685
KC
28write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
29Boston, MA 02110-1301, USA. */
f77b6ca3 30
f77b6ca3
FXC
31#include "libgfortran.h"
32
33#include <errno.h>
d8955e4b 34#include <string.h>
f77b6ca3 35
f77b6ca3
FXC
36/* SUBROUTINE RENAME(PATH1, PATH2, STATUS)
37 CHARACTER(len=*), INTENT(IN) :: PATH1, PATH2
38 INTEGER, INTENT(OUT), OPTIONAL :: STATUS */
39
40extern void rename_i4_sub (char *, char *, GFC_INTEGER_4 *, gfc_charlen_type,
41 gfc_charlen_type);
42iexport_proto(rename_i4_sub);
43
44void
45rename_i4_sub (char *path1, char *path2, GFC_INTEGER_4 *status,
46 gfc_charlen_type path1_len, gfc_charlen_type path2_len)
47{
48 int val;
49 char *str1, *str2;
50
51 /* Trim trailing spaces from paths. */
52 while (path1_len > 0 && path1[path1_len - 1] == ' ')
53 path1_len--;
54 while (path2_len > 0 && path2[path2_len - 1] == ' ')
55 path2_len--;
56
57 /* Make a null terminated copy of the strings. */
58 str1 = gfc_alloca (path1_len + 1);
59 memcpy (str1, path1, path1_len);
60 str1[path1_len] = '\0';
61
62 str2 = gfc_alloca (path2_len + 1);
63 memcpy (str2, path2, path2_len);
64 str2[path2_len] = '\0';
65
66 val = rename (str1, str2);
67
68 if (status != NULL)
69 *status = (val == 0) ? 0 : errno;
70}
71iexport(rename_i4_sub);
72
73extern void rename_i8_sub (char *, char *, GFC_INTEGER_8 *, gfc_charlen_type,
74 gfc_charlen_type);
75iexport_proto(rename_i8_sub);
76
77void
78rename_i8_sub (char *path1, char *path2, GFC_INTEGER_8 *status,
79 gfc_charlen_type path1_len, gfc_charlen_type path2_len)
80{
81 int val;
82 char *str1, *str2;
83
84 /* Trim trailing spaces from paths. */
85 while (path1_len > 0 && path1[path1_len - 1] == ' ')
86 path1_len--;
87 while (path2_len > 0 && path2[path2_len - 1] == ' ')
88 path2_len--;
89
90 /* Make a null terminated copy of the strings. */
91 str1 = gfc_alloca (path1_len + 1);
92 memcpy (str1, path1, path1_len);
93 str1[path1_len] = '\0';
94
95 str2 = gfc_alloca (path2_len + 1);
96 memcpy (str2, path2, path2_len);
97 str2[path2_len] = '\0';
98
99 val = rename (str1, str2);
100
101 if (status != NULL)
102 *status = (val == 0) ? 0 : errno;
103}
104iexport(rename_i8_sub);
105
106extern GFC_INTEGER_4 rename_i4 (char *, char *, gfc_charlen_type,
107 gfc_charlen_type);
108export_proto(rename_i4);
109
110GFC_INTEGER_4
111rename_i4 (char *path1, char *path2, gfc_charlen_type path1_len,
112 gfc_charlen_type path2_len)
113{
114 GFC_INTEGER_4 val;
115 rename_i4_sub (path1, path2, &val, path1_len, path2_len);
116 return val;
117}
118
119extern GFC_INTEGER_8 rename_i8 (char *, char *, gfc_charlen_type,
120 gfc_charlen_type);
121export_proto(rename_i8);
122
123GFC_INTEGER_8
124rename_i8 (char *path1, char *path2, gfc_charlen_type path1_len,
125 gfc_charlen_type path2_len)
126{
127 GFC_INTEGER_8 val;
128 rename_i8_sub (path1, path2, &val, path1_len, path2_len);
129 return val;
130}