add_pkg_config_compile_options Subroutine

public subroutine add_pkg_config_compile_options(this, name, include_flag, libdir, error)

Add pkgconfig compile options to a metapackage Get version Get libraries Get compiler flags

Arguments

Type IntentOptional Attributes Name
class(metapackage_t), intent(inout) :: this
character(len=*), intent(in) :: name
character(len=*), intent(in) :: include_flag
character(len=:), allocatable :: libdir
type(error_t), intent(out), allocatable :: error

Source Code

    subroutine add_pkg_config_compile_options(this, name, include_flag, libdir, error)
        class(metapackage_t), intent(inout) :: this
        character(len=*), intent(in) :: name
        character(len=*), intent(in) :: include_flag
        type(error_t), allocatable, intent(out) :: error

        character(len=:), allocatable :: libdir
        type(string_t) :: log, current_include_dir, current_lib
        type(string_t), allocatable :: libs(:), flags(:)
        integer :: i

        !> Get version
        if (.not. allocated(this%version)) then
            log = pkgcfg_get_version(name, error)
            if (allocated(error)) return
            allocate(this%version)
            call new_version(this%version, log%s, error)
            if (allocated(error)) return
        end if

        !> Get libraries
        libs = pkgcfg_get_libs(name, error)
        if (allocated(error)) return

        libdir = ""
        do i = 1, size(libs)
            if (str_begins_with_str(libs(i)%s, '-l')) then
                current_lib = string_t(libs(i)%s(3:))
                if (len_trim(current_lib%s) == 0) cycle
                this%has_link_libraries = .true.
                this%link_libs = [this%link_libs, current_lib]
            else ! -L and others: concatenate
                this%has_link_flags = .true.
                this%link_flags = string_t(trim(this%link_flags%s)//' '//libs(i)%s)

                ! Also save library dir
                if (str_begins_with_str(libs(i)%s, '-L')) then
                    libdir = libs(i)%s(3:)
                elseif (str_begins_with_str(libs(i)%s, '/LIBPATH')) then
                    libdir = libs(i)%s(9:)
                end if
            end if
        end do

        !> Get compiler flags
        flags = pkgcfg_get_build_flags(name, .true., error)
        if (allocated(error)) return

        do i = 1, size(flags)
            if (str_begins_with_str(flags(i)%s, include_flag)) then
                current_include_dir = string_t(flags(i)%s(len(include_flag)+1:))
                if (len_trim(current_include_dir%s) == 0) cycle
                this%has_include_dirs = .true.
                this%incl_dirs = [this%incl_dirs, current_include_dir]
            else
                this%has_build_flags = .true.
                this%flags = string_t(trim(this%flags%s)//' '//flags(i)%s)
            end if
        end do
    end subroutine add_pkg_config_compile_options