Safe mkdir that creates parent directories and doesn't terminate on failure (unlike FPM's mkdir)
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | dir_path |
subroutine mkdir(dir_path) character(len=*), intent(in) :: dir_path character(len=512) :: command integer :: exitstat, cmdstat ! Skip if directory already exists if (exists(dir_path)) then ! Check if it's actually a directory or a file block logical :: is_dir, path_exists integer :: ios ! Use inquire with directory attribute for reliable detection inquire (file=trim(dir_path), exist=path_exists, iostat=ios) if (ios == 0 .and. path_exists) then ! Check if it's a directory by trying to list it if (get_os_type() == OS_WINDOWS) then call execute_command_line('dir "'//trim(escape_quotes(dir_path))//'" >nul 2>&1', exitstat=ios) else call execute_command_line('test -d "'//trim(escape_quotes(dir_path))//'"', exitstat=ios) end if is_dir = (ios == 0) if (.not. is_dir) then print '(a,a,a)', 'ERROR: Path exists as file, not directory: ', trim(dir_path) ! Try to remove the file and create directory if (get_os_type() == OS_WINDOWS) then ! Use attrib to remove any attributes that might prevent deletion call execute_command_line('attrib -R -H -S "'//trim(escape_quotes(dir_path))//'" 2>nul', exitstat=ios) call execute_command_line('del /f /q "'//trim(escape_quotes(dir_path))//'" 2>nul', exitstat=ios) else call execute_command_line('rm -f "'//trim(escape_quotes(dir_path))//'" 2>/dev/null', exitstat=ios) end if if (ios == 0) then print *, 'Removed file, will create directory instead' ! Don't return - continue to create directory below else print *, 'Failed to remove file, cannot create directory' return end if else ! It's already a directory, nothing to do return end if end if end block ! If we removed the file, continue to create directory end if ! Skip invalid paths that would cause problems if (len_trim(dir_path) == 0) return if (index(dir_path, '/dev/null') > 0) return ! Use runtime OS detection instead of preprocessor if (get_os_type() == OS_WINDOWS) then ! For Windows, handle parent directories explicitly ! First check if parent path exists, if not create it recursively block integer :: last_sep character(len=:), allocatable :: parent_path ! Find last separator last_sep = 0 do last_sep = len_trim(dir_path), 1, -1 if (dir_path(last_sep:last_sep) == '\' .or. dir_path(last_sep:last_sep) == '/') exit end do if (last_sep > 1) then parent_path = dir_path(1:last_sep - 1) ! Skip drive letters like C: or network paths like \\server if (.not. (len_trim(parent_path) == 2 .and. parent_path(2:2) == ':') .and. & .not. (len_trim(parent_path) >= 2 .and. parent_path(1:2) == '\\')) then if (.not. exists(parent_path)) then ! Recursively create parent call mkdir(parent_path) end if end if end if end block ! Force removal of any existing file at this path first call execute_command_line('if exist "'//trim(escape_quotes(dir_path))//'" attrib -R -H -S "'// & trim(escape_quotes(dir_path))//'" 2>nul', exitstat=exitstat) call execute_command_line('if exist "'//trim(escape_quotes(dir_path))//'" del /f /q "'// & trim(escape_quotes(dir_path))//'" 2>nul', exitstat=exitstat) ! Now create directory command = 'cmd /c mkdir "'//trim(escape_quotes(dir_path))//'" 2>nul' else command = 'mkdir -p "'//trim(escape_quotes(dir_path))//'" 2>/dev/null' end if call execute_command_line(command, exitstat=exitstat, cmdstat=cmdstat) end subroutine mkdir