[gcc.git] / libgfortran / intrinsics / rename.c

/* Implementation of the RENAME intrinsic.
   Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc.
   Contributed by François-Xavier Coudert <coudert@clipper.ens.fr>

This file is part of the GNU Fortran 95 runtime library (libgfortran).

Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.

Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

Under Section 7 of GPL version 3, you are granted additional
permissions described in the GCC Runtime Library Exception, version
3.1, as published by the Free Software Foundation.

You should have received a copy of the GNU General Public License and
a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
<http://www.gnu.org/licenses/>.  */

#include "libgfortran.h"

#include <errno.h>
#include <string.h>

/* SUBROUTINE RENAME(PATH1, PATH2, STATUS)
   CHARACTER(len=*), INTENT(IN) :: PATH1, PATH2
   INTEGER, INTENT(OUT), OPTIONAL :: STATUS  */

extern void rename_i4_sub (char *, char *, GFC_INTEGER_4 *, gfc_charlen_type,
	                   gfc_charlen_type);
iexport_proto(rename_i4_sub);

void
rename_i4_sub (char *path1, char *path2, GFC_INTEGER_4 *status,
	       gfc_charlen_type path1_len, gfc_charlen_type path2_len)
{
  int val;
  char *str1, *str2;

  /* Trim trailing spaces from paths.  */
  while (path1_len > 0 && path1[path1_len - 1] == ' ')
    path1_len--;
  while (path2_len > 0 && path2[path2_len - 1] == ' ')
    path2_len--;

  /* Make a null terminated copy of the strings.  */
  str1 = gfc_alloca (path1_len + 1);
  memcpy (str1, path1, path1_len);
  str1[path1_len] = '\0'; 

  str2 = gfc_alloca (path2_len + 1);
  memcpy (str2, path2, path2_len);
  str2[path2_len] = '\0'; 

  val = rename (str1, str2);

  if (status != NULL) 
    *status = (val == 0) ? 0 : errno;
}
iexport(rename_i4_sub);

extern void rename_i8_sub (char *, char *, GFC_INTEGER_8 *, gfc_charlen_type,
	                   gfc_charlen_type);
iexport_proto(rename_i8_sub);

void
rename_i8_sub (char *path1, char *path2, GFC_INTEGER_8 *status,
	       gfc_charlen_type path1_len, gfc_charlen_type path2_len)
{
  int val;
  char *str1, *str2;

  /* Trim trailing spaces from paths.  */
  while (path1_len > 0 && path1[path1_len - 1] == ' ')
    path1_len--;
  while (path2_len > 0 && path2[path2_len - 1] == ' ')
    path2_len--;

  /* Make a null terminated copy of the strings.  */
  str1 = gfc_alloca (path1_len + 1);
  memcpy (str1, path1, path1_len);
  str1[path1_len] = '\0'; 

  str2 = gfc_alloca (path2_len + 1);
  memcpy (str2, path2, path2_len);
  str2[path2_len] = '\0'; 

  val = rename (str1, str2);

  if (status != NULL) 
    *status = (val == 0) ? 0 : errno;
}
iexport(rename_i8_sub);

extern GFC_INTEGER_4 rename_i4 (char *, char *, gfc_charlen_type,
	                        gfc_charlen_type);
export_proto(rename_i4);

GFC_INTEGER_4
rename_i4 (char *path1, char *path2, gfc_charlen_type path1_len,
	   gfc_charlen_type path2_len)
{
  GFC_INTEGER_4 val;
  rename_i4_sub (path1, path2, &val, path1_len, path2_len);
  return val;
}

extern GFC_INTEGER_8 rename_i8 (char *, char *, gfc_charlen_type,
	                        gfc_charlen_type);
export_proto(rename_i8);

GFC_INTEGER_8
rename_i8 (char *path1, char *path2, gfc_charlen_type path1_len,
	   gfc_charlen_type path2_len)
{
  GFC_INTEGER_8 val;
  rename_i8_sub (path1, path2, &val, path1_len, path2_len);
  return val;
}
Commit	Line	Data
f77b6ca3	1	/* Implementation of the RENAME intrinsic.
748086b7	2	Copyright (C) 2005, 2007, 2009 Free Software Foundation, Inc.
f77b6ca3 FXC	3	Contributed by François-Xavier Coudert <coudert@clipper.ens.fr>
	4
	5	This file is part of the GNU Fortran 95 runtime library (libgfortran).
	6
	7	Libgfortran is free software; you can redistribute it and/or
	8	modify it under the terms of the GNU General Public
	9	License as published by the Free Software Foundation; either
748086b7	10	version 3 of the License, or (at your option) any later version.
f77b6ca3 FXC	11
	12	Libgfortran is distributed in the hope that it will be useful,
	13	but WITHOUT ANY WARRANTY; without even the implied warranty of
	14	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	15	GNU General Public License for more details.
	16
748086b7 JJ	17	Under Section 7 of GPL version 3, you are granted additional
	18	permissions described in the GCC Runtime Library Exception, version
	19	3.1, as published by the Free Software Foundation.
	20
	21	You should have received a copy of the GNU General Public License and
	22	a copy of the GCC Runtime Library Exception along with this program;
	23	see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
	24	<http://www.gnu.org/licenses/>. */
f77b6ca3	25
f77b6ca3 FXC	26	#include "libgfortran.h"
	27
	28	#include <errno.h>
d8955e4b	29	#include <string.h>
f77b6ca3	30
f77b6ca3 FXC	31	/* SUBROUTINE RENAME(PATH1, PATH2, STATUS)
	32	CHARACTER(len=*), INTENT(IN) :: PATH1, PATH2
	33	INTEGER, INTENT(OUT), OPTIONAL :: STATUS */
	34
	35	extern void rename_i4_sub (char , char , GFC_INTEGER_4 *, gfc_charlen_type,
	36	gfc_charlen_type);
	37	iexport_proto(rename_i4_sub);
	38
	39	void
	40	rename_i4_sub (char path1, char path2, GFC_INTEGER_4 *status,
	41	gfc_charlen_type path1_len, gfc_charlen_type path2_len)
	42	{
	43	int val;
	44	char str1, str2;
	45
	46	/* Trim trailing spaces from paths. */
	47	while (path1_len > 0 && path1[path1_len - 1] == ' ')
	48	path1_len--;
	49	while (path2_len > 0 && path2[path2_len - 1] == ' ')
	50	path2_len--;
	51
	52	/* Make a null terminated copy of the strings. */
	53	str1 = gfc_alloca (path1_len + 1);
	54	memcpy (str1, path1, path1_len);
	55	str1[path1_len] = '\0';
	56
	57	str2 = gfc_alloca (path2_len + 1);
	58	memcpy (str2, path2, path2_len);
	59	str2[path2_len] = '\0';
	60
	61	val = rename (str1, str2);
	62
	63	if (status != NULL)
	64	*status = (val == 0) ? 0 : errno;
	65	}
	66	iexport(rename_i4_sub);
	67
	68	extern void rename_i8_sub (char , char , GFC_INTEGER_8 *, gfc_charlen_type,
	69	gfc_charlen_type);
	70	iexport_proto(rename_i8_sub);
	71
	72	void
	73	rename_i8_sub (char path1, char path2, GFC_INTEGER_8 *status,
	74	gfc_charlen_type path1_len, gfc_charlen_type path2_len)
	75	{
	76	int val;
	77	char str1, str2;
	78
	79	/* Trim trailing spaces from paths. */
	80	while (path1_len > 0 && path1[path1_len - 1] == ' ')
	81	path1_len--;
	82	while (path2_len > 0 && path2[path2_len - 1] == ' ')
	83	path2_len--;
	84
	85	/* Make a null terminated copy of the strings. */
	86	str1 = gfc_alloca (path1_len + 1);
	87	memcpy (str1, path1, path1_len);
	88	str1[path1_len] = '\0';
	89
	90	str2 = gfc_alloca (path2_len + 1);
	91	memcpy (str2, path2, path2_len);
	92	str2[path2_len] = '\0';
	93
	94	val = rename (str1, str2);
95
96	if (status != NULL)
97	*status = (val == 0) ? 0 : errno;
98	}
99	iexport(rename_i8_sub);
100
101	extern GFC_INTEGER_4 rename_i4 (char , char , gfc_charlen_type,
102	gfc_charlen_type);
103	export_proto(rename_i4);
104
105	GFC_INTEGER_4
106	rename_i4 (char path1, char path2, gfc_charlen_type path1_len,
107	gfc_charlen_type path2_len)
108	{
109	GFC_INTEGER_4 val;
110	rename_i4_sub (path1, path2, &val, path1_len, path2_len);
111	return val;
112	}
113
114	extern GFC_INTEGER_8 rename_i8 (char , char , gfc_charlen_type,
115	gfc_charlen_type);
116	export_proto(rename_i8);
117
118	GFC_INTEGER_8
119	rename_i8 (char path1, char path2, gfc_charlen_type path1_len,
120	gfc_charlen_type path2_len)
121	{
122	GFC_INTEGER_8 val;
123	rename_i8_sub (path1, path2, &val, path1_len, path2_len);
124	return val;
125	}