Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
class(git_target_t), | intent(in) | :: | self |
Instance of the git target |
||
character(len=*), | intent(in) | :: | local_path |
Local path to checkout in |
||
type(error_t), | intent(out), | allocatable | :: | error |
Error |
Type | Visibility | Attributes | Name | Initial | |||
---|---|---|---|---|---|---|---|
character(len=:), | public, | allocatable | :: | object | |||
integer, | public | :: | stat | ||||
character(len=:), | public, | allocatable | :: | workdir |
subroutine checkout(self, local_path, error)
!> Instance of the git target
class(git_target_t), intent(in) :: self
!> Local path to checkout in
character(*), intent(in) :: local_path
!> Error
type(error_t), allocatable, intent(out) :: error
integer :: stat
character(len=:), allocatable :: object, workdir
if (allocated(self%object)) then
object = self%object
else
object = 'HEAD'
end if
workdir = "--work-tree="//local_path//" --git-dir="//join_path(local_path, ".git")
call execute_command_line("git init "//local_path, exitstat=stat)
if (stat /= 0) then
call fatal_error(error,'Error while initiating git repository for remote dependency')
return
end if
call execute_command_line("git "//workdir//" fetch --depth=1 "// &
self%url//" "//object, exitstat=stat)
if (stat /= 0) then
call fatal_error(error,'Error while fetching git repository for remote dependency')
return
end if
call execute_command_line("git "//workdir//" checkout -qf FETCH_HEAD", exitstat=stat)
if (stat /= 0) then
call fatal_error(error,'Error while checking out git repository for remote dependency')
return
end if
end subroutine checkout