get_project_root Function

public function get_project_root() result(root_dir)

Arguments

None

Return Value character(len=:), allocatable


Source Code

    function get_project_root() result(root_dir)
        character(len=:), allocatable :: root_dir
        character(len=:), allocatable :: current_dir
        character(len=512) :: test_path
        logical :: exists
        integer :: i, last_slash

        ! Get current directory
        current_dir = get_current_directory()

        ! Search upward for project markers (fpm.toml or .git)
        root_dir = current_dir
        do i = 1, 10  ! Limit search depth
            ! Check for fpm.toml
            test_path = trim(root_dir)//'/fpm.toml'
            inquire (file=test_path, exist=exists)
            if (exists) return

            ! Check for .git directory
            test_path = trim(root_dir)//'/.git'
            inquire (file=test_path, exist=exists)
            if (exists) return

            ! Move up one directory
            last_slash = 0
            do last_slash = len_trim(root_dir), 1, -1
                if (get_os_type() == OS_WINDOWS) then
                    if (root_dir(last_slash:last_slash) == '/' .or. &
                        root_dir(last_slash:last_slash) == '\') exit
                else
                    if (root_dir(last_slash:last_slash) == '/') exit
                end if
            end do

            if (last_slash <= 1) then
                ! Reached root directory, use original current directory
                root_dir = current_dir
                return
            end if

            root_dir = root_dir(1:last_slash - 1)
        end do

        ! If not found, use current directory
        root_dir = current_dir

    end function get_project_root