make_archive Subroutine

subroutine make_archive(self, output, args, log_file, stat, dry_run)
    !> Instance of the archiver object
    class(archiver_t), intent(in) :: self
    !> Name of the archive to generate
    character(len=*), intent(in) :: output
    !> Object files to include into the archive
    type(string_t), intent(in) :: args(:)
    !> Compiler output log file
    character(len=*), intent(in) :: log_file
    !> Status flag
    integer, intent(out) :: stat
    !> Optional mocking
    logical, optional, intent(in) :: dry_run

    character(len=:), allocatable :: command
    type(string_t), allocatable :: argv(:)
    logical :: mock, tokenized
    integer :: i

    ! Initialize intent(out) status so the mock path returns a defined value.
    stat = 0

    ! Check if we're actually linking
    mock = .false.
    if (present(dry_run)) mock = dry_run

    if (mock) return

    ! Always start from an empty archive: `ar -rs` updates an existing one in place,
    ! and would keep members of objects no longer listed (e.g. from a moved source)
    call delete_file_safe(output, stat)
    if (stat /= 0) then
        write(stderr, '(a)') '<ERROR> Cannot remove outdated archive '//output
        return
    end if

    ! Build the argv token list: archiver + flags, the archive name, then the
    ! object files (already individual tokens). argv spawn is safe from several
    ! OpenMP threads, and it has no shell command-length ceiling.
    tokenized = .true.
    call split_append(argv, self%ar, .false., tokenized)
    if (tokenized) then
        ! Reproduce `self%ar // output`. self%ar is concatenated directly with
        ! output, so when it ends without a separator (MSVC `lib /OUT:`) the
        ! name glues onto the last flag token; GNU `ar -rs ` ends in a space and
        ! takes output as its own token.
        if (size(argv) > 0 .and. .not.ends_with_blank(self%ar)) then
            argv(size(argv))%s = argv(size(argv))%s // output
        else
            call add_strings(argv, string_t(output))
        end if
    end if

    if (self%use_response_file) then
        call write_response_file(output//".resp" , args)
        command = self%ar // output // " @" // output//".resp"
        if (tokenized) call add_strings(argv, string_t("@"//output//".resp"))
    else
        ! Archives are made in parallel: see run_argv
        !$omp critical (fpm_string_result)
        command = self%ar // output // " " // string_cat(args, " ")
        !$omp end critical (fpm_string_result)
        if (tokenized) then
            do i = 1, size(args)
                call add_strings(argv, args(i))
            end do
        end if
    end if

    ! On Windows, MinGW ar runs that write archives into one folder at once can fail to
    ! create their temporary file there ("could not create temporary file whilst writing
    ! archive: Permission denied"): make archives one at a time
    if (get_os_type() == OS_WINDOWS) then
        !$omp critical (fpm_archive)
        call run_tool(command, argv, tokenized, self%echo, self%verbose, log_file, stat)
        !$omp end critical (fpm_archive)
    else
        call run_tool(command, argv, tokenized, self%echo, self%verbose, log_file, stat)
    end if

    if (self%use_response_file) call delete_file_safe(output//".resp")

    contains
        subroutine delete_file_safe(file, stat)
            use, intrinsic :: iso_c_binding, only: c_char, c_int, c_null_char
            character(len=*), intent(in) :: file
            integer, optional, intent(out) :: stat
            interface
                ! Not `close(status='delete')`: LLVM Flang silently keeps the file on Windows
                integer(c_int) function c_remove(path) bind(C, name="remove")
                    import :: c_char, c_int
                    character(kind=c_char), intent(in) :: path(*)
                end function c_remove
            end interface
            logical :: exist
            integer :: iostat
            iostat = 0
            inquire(file=file, exist=exist)
            if (exist) iostat = c_remove(file//c_null_char)
            if (present(stat)) stat = iostat
        end subroutine delete_file_safe
end subroutine make_archive