system_rename Function

public function system_rename(input, output) result(ierr)

NAME

  system_rename(3f) - [M_system_FILE_SYSTEM] call rename(3c) to rename
                      a system file
  (LICENSE:PD)

SYNOPSIS

function system_rename(input,output) result(ierr)

character(*),intent(in)    :: input,output
integer                    :: ierr

DESCRIPTION

 Rename a file by calling rename(3c). It is not recommended that the
 rename occur while either filename is being used on a file currently
 OPEN(3f) by the program.

 Both the old and new names must be on the same device.

OPTIONS

 INPUT   system filename of an existing file to rename
 OUTPUT  system filename to be created or overwritten by INPUT file.
         Must be on the same device as the INPUT file.

RETURNS

 IERR    zero (0) if no error occurs. If not zero a call to
         system_errno(3f) or system_perror(3f) is supported
         to diagnose error

EXAMPLE

Sample program:

  program demo_system_rename
  use M_system, only : system_rename
  use M_system, only : system_remove
  use M_system, only : system_perror
  implicit none
  character(len=256) :: string
  integer            :: ios, ierr

  ! try to remove junk files just in case
  ierr=system_remove('_scratch_file_')
  write(*,'(a,i0)') 'should not be zero ',ierr
  call system_perror('*demo_system_rename*')
  ierr=system_remove('_renamed_scratch_file_')
  write(*,'(a,i0)') 'should not be zero ',ierr
  call system_perror('*demo_system_rename*')

  ! create scratch file to rename
  open(unit=10,file='_scratch_file_',status='new')
  write(10,'(a)') &
  & 'Test by renaming "_scratch_file_" to "_renamed_scratch_file_"'
  write(10,'(a)') 'IF YOU SEE THIS ON OUTPUT THE RENAME WORKED'
  close(10)
  ! rename scratch file
  ierr=system_rename('_scratch_file_','_renamed_scratch_file_')
  if(ierr.ne.0)then
     write(*,*)'ERROR RENAMING FILE ',ierr
  endif
  ! read renamed file
  open(unit=11,file='_renamed_scratch_file_',status='old')
  INFINITE: do
     read(11,'(a)',iostat=ios)string
     if(ios.ne.0)exit INFINITE
     write(*,'(a)')trim(string)
  enddo INFINITE
  close(unit=11)

  ! clean up
  ierr=system_remove('_scratch_file_')
  write(*,'(a,i0)') 'should not be zero ',ierr
  ierr=system_remove('_renamed_scratch_file_')
  write(*,'(a,i0)') 'should be zero ',ierr

  end program demo_system_rename

Expected output:

> should not be zero -1
> *demo_system_rename*: No such file or directory
> should not be zero -1
> *demo_system_rename*: No such file or directory
> Test by renaming "_scratch_file_" to "_renamed_scratch_file_"
> IF YOU SEE THIS ON OUTPUT THE RENAME WORKED
> should not be zero -1
> should be zero 0

AUTHOR

John S. Urban

LICENSE

Public Domain

Arguments

Type IntentOptional Attributes Name
character, intent(in) :: input
character, intent(in) :: output

Return Value integer


Contents

Source Code

system_rename

Source Code

function system_rename(input,output) result(ierr)

! ident_17="@(#) M_system system_rename(3f) call rename(3c) to change filename"

character(*),intent(in)    :: input,output
integer                    :: ierr
character(kind=c_char,len=1),allocatable :: temp1(:)
character(kind=c_char,len=1),allocatable :: temp2(:)

interface
   function c_rename(c_input,c_output) bind(c,name="rename") result(c_err)
      import c_char, c_int
      character(kind=c_char),intent(in) :: c_input(*)
      character(kind=c_char),intent(in) :: c_output(*)
      integer(c_int)                    :: c_err
   end function
end interface
!-----------------------------------------------------------------------------------------------------------------------------------
   temp1 = str2_carr(trim(input)) ! kludge for bug in ifort (IFORT) 2021.3.0 20210609
   temp2 = str2_carr(trim(output)) ! kludge for bug in ifort (IFORT) 2021.3.0 20210609
   ierr= c_rename(temp1,temp2)
end function system_rename