mkdir Subroutine

public subroutine mkdir(dir_path)

Safe mkdir that creates parent directories and doesn't terminate on failure (unlike FPM's mkdir)

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: dir_path

Source Code

    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