Create new archiver instance
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(archiver_t), | intent(out) | :: | self |
New instance of the archiver |
||
character(len=*), | intent(in) | :: | ar |
User provided archiver command |
||
logical, | intent(in) | :: | echo |
Echo compiler command |
||
logical, | intent(in) | :: | verbose |
Verbose mode: dump compiler output |
Type | Visibility | Attributes | Name | Initial | |||
---|---|---|---|---|---|---|---|
character(len=*), | public, | parameter | :: | arflags | = | " -rs " | |
integer, | public | :: | estat | ||||
character(len=*), | public, | parameter | :: | libflags | = | " /OUT:" | |
integer, | public | :: | os_type |
subroutine new_archiver(self, ar, echo, verbose)
!> New instance of the archiver
type(archiver_t), intent(out) :: self
!> User provided archiver command
character(len=*), intent(in) :: ar
!> Echo compiler command
logical, intent(in) :: echo
!> Verbose mode: dump compiler output
logical, intent(in) :: verbose
integer :: estat, os_type
character(len=*), parameter :: arflags = " -rs ", libflags = " /OUT:"
if (len_trim(ar) > 0) then
! Check first for ar-like commands
if (check_compiler(ar, "ar")) then
self%ar = ar//arflags
end if
! Check for lib-like commands
if (check_compiler(ar, "lib")) then
self%ar = ar//libflags
end if
! Fallback and assume ar-like behaviour
self%ar = ar//arflags
else
os_type = get_os_type()
if (os_type /= OS_WINDOWS .and. os_type /= OS_UNKNOWN) then
self%ar = "ar"//arflags
else
call execute_command_line("ar --version > "//get_temp_filename()//" 2>&1", &
& exitstat=estat)
if (estat /= 0) then
self%ar = "lib"//libflags
else
self%ar = "ar"//arflags
end if
end if
end if
self%use_response_file = os_type == OS_WINDOWS
self%echo = echo
self%verbose = verbose
end subroutine new_archiver