tempname Function

private function tempname(self, is_file, prefix, path)

Type Bound

string

Arguments

Type IntentOptional Attributes Name
class(string), intent(in) :: self
logical, intent(in), optional :: is_file
character(len=*), intent(in), optional :: prefix
character(len=*), intent(in), optional :: path

Return Value character(len=:), allocatable


Called by

proc~~tempname~~CalledByGraph proc~tempname string%tempname proc~glob_string string%glob_string proc~glob_string->proc~tempname program~volatile_doctest~1403 volatile_doctest program~volatile_doctest~1403->proc~tempname interface~glob glob program~volatile_doctest~1403->interface~glob program~volatile_doctest~1623 volatile_doctest program~volatile_doctest~1623->proc~tempname none~glob string%glob program~volatile_doctest~1623->none~glob program~volatile_doctest~1765 volatile_doctest program~volatile_doctest~1765->proc~tempname program~volatile_doctest~1765->none~glob program~volatile_doctest~1810 volatile_doctest program~volatile_doctest~1810->proc~tempname program~volatile_doctest~26 volatile_doctest program~volatile_doctest~26->proc~tempname program~volatile_doctest~26->interface~glob program~volatile_doctest~321 volatile_doctest program~volatile_doctest~321->proc~tempname program~volatile_doctest~321->none~glob program~volatile_doctest~464 volatile_doctest program~volatile_doctest~464->proc~tempname program~volatile_doctest~464->none~glob program~volatile_doctest~987 volatile_doctest program~volatile_doctest~987->proc~tempname interface~glob->proc~glob_string proc~glob_character string%glob_character interface~glob->proc~glob_character none~glob->proc~glob_string none~glob->proc~glob_character proc~glob_character->none~glob

Source Code

   function tempname(self, is_file, prefix, path)
   !< Return a safe temporary name suitable for temporary file or directories.
   !<
   !<```fortran
   !< type(string) :: astring
   !< character(len=:), allocatable :: tmpname
   !< logical                       :: test_passed(5)
   !< tmpname = astring%tempname()
   !< inquire(file=tmpname, exist=test_passed(1))
   !< test_passed(1) = .not.test_passed(1)
   !< tmpname = astring%tempname(is_file=.false.)
   !< inquire(file=tmpname, exist=test_passed(2))
   !< test_passed(2) = .not.test_passed(2)
   !< tmpname = astring%tempname(path='./')
   !< inquire(file=tmpname, exist=test_passed(3))
   !< test_passed(3) = .not.test_passed(3)
   !< astring = 'me-'
   !< tmpname = astring%tempname()
   !< inquire(file=tmpname, exist=test_passed(4))
   !< test_passed(4) = .not.test_passed(4)
   !< tmpname = astring%tempname(prefix='you-')
   !< inquire(file=tmpname, exist=test_passed(5))
   !< test_passed(5) = .not.test_passed(5)
   !< print '(L1)', all(test_passed)
   !<```
   !=> T <<<
   class(string), intent(in)           :: self                   !< The string.
   logical,       intent(in), optional :: is_file                !< True if tempname should be used for file (the default).
   character(*),  intent(in), optional :: prefix                 !< Name prefix, otherwise self is used (if allocated).
   character(*),  intent(in), optional :: path                   !< Path where file/directory should be used, default `./`.
   character(len=:), allocatable       :: tempname               !< Safe (unique) temporary name.
   logical                             :: is_file_               !< True if tempname should be used for file (the default).
   character(len=:), allocatable       :: prefix_                !< Name prefix, otherwise self is used (if allocated).
   character(len=:), allocatable       :: path_                  !< Path where file/directory should be used, default `./`.
   logical, save                       :: is_initialized=.false. !< Status of random seed initialization.
   real(R4P)                           :: random_real            !< Random number (real).
   integer(I4P)                        :: random_integer         !< Random number (integer).
   logical                             :: is_hold                !< Flag to check if a safe tempname has been found.

   is_file_ = .true. ; if (present(is_file)) is_file_ = is_file
   path_ = '' ; if (present(path)) path_ = path
   prefix_ = ''
   if (present(prefix)) then
      prefix_ = prefix
   elseif (allocated(self%raw)) then
      prefix_ = self%raw
   endif
   if (.not.is_initialized) then
      call random_seed
      is_initialized = .true.
   endif
   tempname = repeat(' ', len(path_) + len(prefix_) + 10) ! [path_] + [prefix_] + 6 random chars + [.tmp]
   do
      call random_number(random_real)
      random_integer = transfer(random_real, random_integer)
      random_integer = iand(random_integer, 16777215_I4P)
      if (is_file_)  then
         write(tempname, '(A,Z6.6,A)') path_//prefix_, random_integer, '.tmp'
      else
         write(tempname, '(A,Z6.6)') path_//prefix_, random_integer
         tempname = trim(tempname)
      endif
      inquire(file=tempname, exist=is_hold)
      if (.not.is_hold) exit
   enddo
   endfunction tempname