diff options
26 files changed, 650 insertions, 219 deletions
diff --git a/.github/workflows/docs.yml b/.github/workflows/docs.yml new file mode 100644 index 0000000..0bb9d4b --- /dev/null +++ b/.github/workflows/docs.yml @@ -0,0 +1,24 @@ +name: docs + +on: [push, pull_request] + +jobs: + build-and-deploy: + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v2 + - uses: actions/setup-python@v1 + with: + python-version: '3.x' + - name: Install dependencies + run: pip install ford + - name: Build Documentation + run: ford docs.md + - uses: JamesIves/github-pages-deploy-action@3.6.1 + if: github.event_name == 'push' && github.repository == 'fortran-lang/fpm' && ( startsWith( github.ref, 'refs/tags/' ) || github.ref == 'refs/heads/master' ) + with: + GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} + BRANCH: gh-pages + FOLDER: fpm-doc + CLEAN: true + diff --git a/ci/run_tests.bat b/ci/run_tests.bat index 0c0339c..44f6e5c 100755 --- a/ci/run_tests.bat +++ b/ci/run_tests.bat @@ -132,3 +132,13 @@ if errorlevel 1 exit 1 .\build\gfortran_debug\app\Program_with_module if errorlevel 1 exit 1 + + +cd ..\link_executable +if errorlevel 1 exit 1 + +%fpm_path% build +if errorlevel 1 exit 1 + +.\build\gfortran_debug\app\gomp_test +if errorlevel 1 exit 1 diff --git a/ci/run_tests.sh b/ci/run_tests.sh index 625f37b..894b1f0 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -69,3 +69,11 @@ cd ../submodules cd ../program_with_module "${f_fpm_path}" build ./build/gfortran_debug/app/Program_with_module + +cd ../link_external +"${f_fpm_path}" build +./build/gfortran_debug/app/link_external + +cd ../link_executable +"${f_fpm_path}" build +./build/gfortran_debug/app/gomp_test diff --git a/example_packages/README.md b/example_packages/README.md index 65f4109..0eb0653 100644 --- a/example_packages/README.md +++ b/example_packages/README.md @@ -16,5 +16,7 @@ the features demonstrated in each package and which versions of fpm are supporte | makefile_complex | External build command (makefile); local path dependency | Y | N | | program_with_module | App-only; module+program in single source file | Y | Y | | submodules | Lib-only; submodules (3 levels) | N | Y | +| link_external | Link external library | N | Y | +| link_executable | Link external library to a single executable | N | Y | | with_c | Compile with `c` source files | N | Y | -| with_makefile | External build command (makefile) | Y | N |
\ No newline at end of file +| with_makefile | External build command (makefile) | Y | N | diff --git a/example_packages/link_executable/.gitignore b/example_packages/link_executable/.gitignore new file mode 100644 index 0000000..a007fea --- /dev/null +++ b/example_packages/link_executable/.gitignore @@ -0,0 +1 @@ +build/* diff --git a/example_packages/link_executable/app/main.f90 b/example_packages/link_executable/app/main.f90 new file mode 100644 index 0000000..b1df402 --- /dev/null +++ b/example_packages/link_executable/app/main.f90 @@ -0,0 +1,11 @@ +program gomp_example + implicit none + + interface + integer function omp_get_num_procs() + end function + end interface + + print *, omp_get_num_procs() + +end program gomp_example diff --git a/example_packages/link_executable/fpm.toml b/example_packages/link_executable/fpm.toml new file mode 100644 index 0000000..f3545ca --- /dev/null +++ b/example_packages/link_executable/fpm.toml @@ -0,0 +1,8 @@ +name = "link_executable" +build.auto-executables = false + +[[executable]] +name = "gomp_test" +source-dir = "app" +main = "main.f90" +link = ["gomp"] diff --git a/example_packages/link_external/.gitignore b/example_packages/link_external/.gitignore new file mode 100644 index 0000000..a007fea --- /dev/null +++ b/example_packages/link_external/.gitignore @@ -0,0 +1 @@ +build/* diff --git a/example_packages/link_external/app/main.f90 b/example_packages/link_external/app/main.f90 new file mode 100644 index 0000000..8df408d --- /dev/null +++ b/example_packages/link_external/app/main.f90 @@ -0,0 +1,21 @@ +program test_blas + use wrapped_gemv, only : sp, gemv + implicit none + + integer :: i, j + real(sp) :: mat(4, 4), vec(4), res(4) + + do i = 1, size(vec) + vec(i) = sqrt(real(i, sp)) + end do + + do i = 1, size(mat, 2) + do j = 1, size(mat, 1) + mat(j, i) = sqrt(real(j * i, sp)) + end do + end do + + call gemv(mat, vec, res, alpha=-1.0_sp, trans='t') + +end program test_blas + diff --git a/example_packages/link_external/fpm.toml b/example_packages/link_external/fpm.toml new file mode 100644 index 0000000..f2eafa2 --- /dev/null +++ b/example_packages/link_external/fpm.toml @@ -0,0 +1,4 @@ +name = "link_external" + +[build] +link = "blas" diff --git a/example_packages/link_external/src/wrapped_gemv.f90 b/example_packages/link_external/src/wrapped_gemv.f90 new file mode 100644 index 0000000..5ff1d7c --- /dev/null +++ b/example_packages/link_external/src/wrapped_gemv.f90 @@ -0,0 +1,126 @@ +!> Performs one of the matrix-vector operations +!> +!> y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, +!> +!> where alpha and beta are scalars, x and y are vectors and A is an +!> m by n matrix. +module wrapped_gemv + implicit none + private + + public :: sp, dp, gemv + + integer, parameter :: sp = selected_real_kind(6) + integer, parameter :: dp = selected_real_kind(15) + + + interface gemv + module procedure :: wrap_sgemv + module procedure :: wrap_dgemv + end interface gemv + + + interface blas_gemv + subroutine sgemv(trans, m, n, alpha, a, lda, x, incx, beta, y, incy) + import :: sp + real(sp), intent(in) :: a(lda, *) + real(sp), intent(in) :: x(*) + real(sp), intent(inout) :: y(*) + real(sp), intent(in) :: alpha + real(sp), intent(in) :: beta + character(len=1), intent(in) :: trans + integer, intent(in) :: incx + integer, intent(in) :: incy + integer, intent(in) :: m + integer, intent(in) :: n + integer, intent(in) :: lda + end subroutine sgemv + subroutine dgemv(trans, m, n, alpha, a, lda, x, incx, beta, y, incy) + import :: dp + real(dp), intent(in) :: a(lda, *) + real(dp), intent(in) :: x(*) + real(dp), intent(inout) :: y(*) + real(dp), intent(in) :: alpha + real(dp), intent(in) :: beta + character(len=1), intent(in) :: trans + integer, intent(in) :: incx + integer, intent(in) :: incy + integer, intent(in) :: m + integer, intent(in) :: n + integer, intent(in) :: lda + end subroutine dgemv + end interface blas_gemv + + +contains + + + subroutine wrap_sgemv(amat, xvec, yvec, alpha, beta, trans) + real(sp), intent(in) :: amat(:, :) + real(sp), intent(in) :: xvec(:) + real(sp), intent(inout) :: yvec(:) + real(sp), intent(in), optional :: alpha + real(sp), intent(in), optional :: beta + character(len=1), intent(in), optional :: trans + real(sp) :: a, b + character(len=1) :: tra + integer :: incx, incy, m, n, lda + if (present(alpha)) then + a = alpha + else + a = 1.0_sp + end if + if (present(beta)) then + b = beta + else + b = 0 + end if + if (present(trans)) then + tra = trans + else + tra = 'n' + end if + incx = 1 + incy = 1 + lda = max(1, size(amat, 1)) + m = size(amat, 1) + n = size(amat, 2) + call blas_gemv(tra, m, n, a, amat, lda, xvec, incx, b, yvec, incy) + end subroutine wrap_sgemv + + + subroutine wrap_dgemv(amat, xvec, yvec, alpha, beta, trans) + real(dp), intent(in) :: amat(:, :) + real(dp), intent(in) :: xvec(:) + real(dp), intent(inout) :: yvec(:) + real(dp), intent(in), optional :: alpha + real(dp), intent(in), optional :: beta + character(len=1), intent(in), optional :: trans + real(dp) :: a, b + character(len=1) :: tra + integer :: incx, incy, m, n, lda + if (present(alpha)) then + a = alpha + else + a = 1.0_dp + end if + if (present(beta)) then + b = beta + else + b = 0 + end if + if (present(trans)) then + tra = trans + else + tra = 'n' + end if + incx = 1 + incy = 1 + lda = max(1, size(amat, 1)) + m = size(amat, 1) + n = size(amat, 2) + call blas_gemv(tra, m, n, a, amat, lda, xvec, incx, b, yvec, incy) + end subroutine wrap_dgemv + + +end module wrapped_gemv diff --git a/fpm/app/main.f90 b/fpm/app/main.f90 index 9982028..28258ad 100644 --- a/fpm/app/main.f90 +++ b/fpm/app/main.f90 @@ -7,7 +7,7 @@ use fpm_command_line, only: & fpm_test_settings, & fpm_install_settings, & get_command_line_settings -use fpm, only: cmd_build, cmd_install, cmd_run, cmd_test +use fpm, only: cmd_build, cmd_install, cmd_run use fpm_cmd_new, only: cmd_new implicit none @@ -22,9 +22,9 @@ type is (fpm_new_settings) type is (fpm_build_settings) call cmd_build(settings) type is (fpm_run_settings) - call cmd_run(settings) + call cmd_run(settings,test=.false.) type is (fpm_test_settings) - call cmd_test(settings) + call cmd_run(settings,test=.true.) type is (fpm_install_settings) call cmd_install(settings) end select diff --git a/fpm/fpm.toml b/fpm/fpm.toml index fc3a381..404e65c 100644 --- a/fpm/fpm.toml +++ b/fpm/fpm.toml @@ -8,7 +8,7 @@ copyright = "2020 fpm contributors" [dependencies] [dependencies.toml-f] git = "https://github.com/toml-f/toml-f" -tag = "v0.2" +tag = "v0.2.1" [dependencies.M_CLI2] git = "https://github.com/urbanjost/M_CLI2.git" diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 01f3150..daa4d98 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -7,7 +7,8 @@ use fpm_environment, only: run use fpm_filesystem, only: is_dir, join_path, number_of_rows, list_files, exists, basename use fpm_model, only: fpm_model_t, srcfile_t, build_target_t, & FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, & - FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST + FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST, & + FPM_TARGET_EXECUTABLE use fpm_sources, only: add_executable_sources, add_sources_from_dir use fpm_targets, only: targets_from_sources, resolve_module_dependencies @@ -21,16 +22,17 @@ use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, & use fpm_manifest_dependency, only: dependency_t implicit none private -public :: cmd_build, cmd_install, cmd_run, cmd_test +public :: cmd_build, cmd_install, cmd_run contains -recursive subroutine add_libsources_from_package(sources,package_list,package, & +recursive subroutine add_libsources_from_package(sources,link_libraries,package_list,package, & package_root,dev_depends,error) ! Discover library sources in a package, recursively including dependencies ! type(srcfile_t), allocatable, intent(inout), target :: sources(:) + type(string_t), allocatable, intent(inout) :: link_libraries(:) type(string_t), allocatable, intent(inout) :: package_list(:) type(package_t), intent(in) :: package character(*), intent(in) :: package_root @@ -120,7 +122,7 @@ recursive subroutine add_libsources_from_package(sources,package_list,package, & end if - call add_libsources_from_package(sources,package_list,dependency, & + call add_libsources_from_package(sources,link_libraries,package_list,dependency, & package_root=dependency_path, & dev_depends=.false., error=error) @@ -133,6 +135,9 @@ recursive subroutine add_libsources_from_package(sources,package_list,package, & dep_name%s = dependency_list(i)%name package_list = [package_list, dep_name] + if (allocated(dependency%build_config%link)) then + link_libraries = [link_libraries, dependency%build_config%link] + end if end do @@ -148,11 +153,16 @@ subroutine build_model(model, settings, package, error) type(fpm_build_settings), intent(in) :: settings type(package_t), intent(in) :: package type(error_t), allocatable, intent(out) :: error - integer :: i + integer :: i type(string_t), allocatable :: package_list(:) model%package_name = package%name + if (allocated(package%build_config%link)) then + model%link_libraries = package%build_config%link + else + allocate(model%link_libraries(0)) + end if allocate(package_list(1)) package_list(1)%s = package%name @@ -219,7 +229,7 @@ subroutine build_model(model, settings, package, error) endif ! Add library sources, including local dependencies - call add_libsources_from_package(model%sources,package_list,package, & + call add_libsources_from_package(model%sources,model%link_libraries,package_list,package, & package_root='.',dev_depends=.true.,error=error) if (allocated(error)) then return @@ -227,17 +237,44 @@ subroutine build_model(model, settings, package, error) call targets_from_sources(model,model%sources) - if(settings%list)then - do i=1,size(model%targets) - write(stderr,*) model%targets(i)%ptr%output_file - enddo - stop - endif + do i = 1, size(model%link_libraries) + model%link_flags = model%link_flags // " -l" // model%link_libraries(i)%s + end do call resolve_module_dependencies(model%targets,error) end subroutine build_model +!> Apply package defaults +subroutine package_defaults(package) + type(package_t), intent(inout) :: package + + ! Populate library in case we find the default src directory + if (.not.allocated(package%library) .and. exists("src")) then + allocate(package%library) + call default_library(package%library) + end if + + ! Populate executable in case we find the default app + if (.not.allocated(package%executable) .and. & + exists(join_path('app',"main.f90"))) then + allocate(package%executable(1)) + call default_executable(package%executable(1), package%name) + end if + + ! Populate test in case we find the default test directory + if (.not.allocated(package%test) .and. & + exists(join_path("test","main.f90"))) then + allocate(package%test(1)) + call default_test(package%test(1), package%name) + endif + + if (.not.(allocated(package%library) .or. allocated(package%executable))) then + print '(a)', "Neither library nor executable found, there is nothing to do" + error stop 1 + end if + +end subroutine subroutine cmd_build(settings) type(fpm_build_settings), intent(in) :: settings @@ -245,29 +282,15 @@ type(package_t) :: package type(fpm_model_t) :: model type(error_t), allocatable :: error +integer :: i + call get_package_data(package, "fpm.toml", error) if (allocated(error)) then print '(a)', error%message error stop 1 end if -! Populate library in case we find the default src directory -if (.not.allocated(package%library) .and. exists("src")) then - allocate(package%library) - call default_library(package%library) -end if - -! Populate executable in case we find the default app -if (.not.allocated(package%executable) .and. & - exists(join_path('app',"main.f90"))) then - allocate(package%executable(1)) - call default_executable(package%executable(1), package%name) -end if - -if (.not.(allocated(package%library) .or. allocated(package%executable))) then - print '(a)', "Neither library nor executable found, there is nothing to do" - error stop 1 -end if +call package_defaults(package) call build_model(model, settings, package, error) if (allocated(error)) then @@ -275,7 +298,13 @@ if (allocated(error)) then error stop 1 end if -call build_package(model) +if(settings%list)then + do i=1,size(model%targets) + write(stderr,*) model%targets(i)%ptr%output_file + enddo +else + call build_package(model) +endif end subroutine @@ -285,167 +314,154 @@ type(fpm_install_settings), intent(in) :: settings error stop 8 end subroutine cmd_install -subroutine cmd_run(settings) -type(fpm_run_settings), intent(in) :: settings -character(len=:),allocatable :: release_name, cmd, fname -integer :: i, j -type(package_t) :: package -type(error_t), allocatable :: error -character(len=:),allocatable :: newwords(:) -logical,allocatable :: foundit(:) -logical :: list +subroutine cmd_run(settings,test) + class(fpm_run_settings), intent(in) :: settings + logical, intent(in) :: test + + integer, parameter :: LINE_WIDTH = 80 + integer :: i, j, col_width, nCol + logical :: found(size(settings%name)) + type(error_t), allocatable :: error + type(package_t) :: package + type(fpm_model_t) :: model + type(string_t) :: exe_cmd + type(string_t), allocatable :: executables(:) + type(build_target_t), pointer :: exe_target + type(srcfile_t), pointer :: exe_source + call get_package_data(package, "fpm.toml", error) if (allocated(error)) then print '(a)', error%message - stop - endif - release_name=trim(merge('gfortran_release','gfortran_debug ',settings%release)) - newwords=[character(len=0) ::] - ! Populate executable in case we find the default app directory - if (.not.allocated(package%executable) .and. exists("app")) then - allocate(package%executable(1)) - call default_executable(package%executable(1), package%name) - endif - if(size(settings%name).eq.0)then - if ( .not.allocated(package%executable) ) then - write(stderr,'(*(g0,1x))')'fpm::run<INFO>:no executables found in fpm.toml and no default app/ directory' - stop - endif - allocate(foundit(size(package%executable))) - do i=1,size(package%executable) - fname=join_path('build',release_name,package%executable(i)%source_dir,package%executable(i)%name) - newwords=[character(len=max(len(newwords),len(fname))) :: newwords,fname] - enddo - if(size(newwords).lt.1)then - write(stderr,'(*(g0,1x))')'fpm::run<INFO>:no executables found in fpm.toml' - stop - endif - else - ! expand names, duplicates are a problem?? - allocate(foundit(size(settings%name))) - foundit=.false. - FINDIT: do i=1,size(package%executable) - do j=1,size(settings%name) - if(settings%name(j).eq.package%executable(i)%name)then - fname=join_path('build',release_name,package%executable(i)%source_dir,package%executable(i)%name) - newwords=[character(len=max(len(newwords),len(fname))) :: newwords,fname] - foundit(j)=.true. - endif - enddo - enddo FINDIT - do i=1,size(settings%name) - if(.not.foundit(i))then - write(stderr,'(*(g0,1x))')'fpm::run<ERROR>:executable',trim(settings%name(i)),'not located' - endif - enddo - if(allocated(foundit))deallocate(foundit) - endif - do i=1,size(newwords) - ! list is a new option for use with xargs, to move files to production area, valgrind, gdb, ls -l, .... - ! maybe add as --mask and could do --mask 'echo %xx' or --mask 'cp %XX /usr/local/bin/' an so on - ! default if blank would be filename uptodate|needs|updated|doesnotexist creation_date, ... - ! or maybe just list filenames so can pipe through xargs, and so on - if(settings%list)then - write(stderr,'(*(g0,1x))')'fpm::run<INFO>:executable expected at',newwords(i),& - & merge('exists ','does not exist',exists(newwords(i))) - cycle - endif - cmd=newwords(i) // ' ' // settings%args - if(exists(newwords(i)))then - call run(cmd) - else ! try to build -- once build works conditionally this should be an unconditional call - call cmd_build(fpm_build_settings(release=settings%release,list=.false.)) - if(exists(newwords(i)))then - call run(cmd) - else - write(stderr,*)'fpm::run<ERROR>',cmd,' not found' - endif - endif - enddo - deallocate(newwords) -end subroutine cmd_run + error stop 1 + end if -subroutine cmd_test(settings) -type(fpm_test_settings), intent(in) :: settings -character(len=:),allocatable :: release_name, cmd, fname -integer :: i, j -type(package_t) :: package -type(error_t), allocatable :: error -character(len=:),allocatable :: newwords(:) -logical,allocatable :: foundit(:) -logical :: list - call get_package_data(package, "fpm.toml", error) + call package_defaults(package) + + call build_model(model, settings%fpm_build_settings, package, error) if (allocated(error)) then print '(a)', error%message + error stop 1 + end if + + ! Enumerate executable targets to run + col_width = -1 + found(:) = .false. + allocate(executables(0)) + do i=1,size(model%targets) + + exe_target => model%targets(i)%ptr + + if (exe_target%target_type == FPM_TARGET_EXECUTABLE .and. & + allocated(exe_target%dependencies)) then + + exe_source => exe_target%dependencies(1)%ptr%source + + if (exe_source%unit_scope == & + merge(FPM_SCOPE_TEST,FPM_SCOPE_APP,test)) then + + col_width = max(col_width,len(basename(exe_target%output_file))+2) + + if (size(settings%name) == 0) then + + exe_cmd%s = exe_target%output_file + executables = [executables, exe_cmd] + + else + + do j=1,size(settings%name) + + if (trim(settings%name(j))==exe_source%exe_name) then + + found(j) = .true. + exe_cmd%s = exe_target%output_file + executables = [executables, exe_cmd] + + end if + + end do + + end if + + end if + + end if + + end do + + ! Check if any apps/tests were found + if (col_width < 0) then + if (test) then + write(stderr,*) 'No tests to run' + else + write(stderr,*) 'No executables to run' + end if stop - endif - release_name=trim(merge('gfortran_release','gfortran_debug ',settings%release)) - newwords=[character(len=0) ::] + end if - ! Populate test in case we find the default test directory - if (.not.allocated(package%test) .and. exists("test")) then - allocate(package%test(1)) - call default_test(package%test(1), package%name) - endif - if(size(settings%name).eq.0)then - if ( .not.allocated(package%test) ) then - write(stderr,'(*(g0,1x))')'fpm::run<INFO>:no tests found in fpm.toml and no default test/ directory' - stop - endif - allocate(foundit(size(package%test))) - do i=1,size(package%test) - fname=join_path('build',release_name,package%test(i)%source_dir,package%test(i)%name) - newwords=[character(len=max(len(newwords),len(fname))) :: newwords,fname] - enddo - if(size(newwords).lt.1)then - write(stderr,'(*(g0,1x))')'fpm::run<INFO>:no tests found in fpm.toml' - stop - endif - else - ! expand names, duplicates are a problem?? - allocate(foundit(size(settings%name))) - foundit=.false. - FINDIT: do i=1,size(package%test) - do j=1,size(settings%name) - if(settings%name(j).eq.package%test(i)%name)then - fname=join_path('build',release_name,package%test(i)%source_dir,package%test(i)%name) - newwords=[character(len=max(len(newwords),len(fname))) :: newwords,fname] - foundit(j)=.true. - endif - enddo - enddo FINDIT - do i=1,size(settings%name) - if(.not.foundit(i))then - write(stderr,'(*(g0,1x))')'fpm::run<ERROR>:test',trim(settings%name(i)),'not located' - endif - enddo - if(allocated(foundit))deallocate(foundit) - endif - do i=1,size(newwords) - ! list is a new option for use with xargs, to move files to production area, valgrind, gdb, ls -l, .... - ! maybe add as --mask and could do --mask 'echo %xx' or --mask 'cp %XX /usr/local/bin/' an so on - ! default if blank would be filename uptodate|needs|updated|doesnotexist creation_date, ... - ! or maybe just list filenames so can pipe through xargs, and so on - if(settings%list)then - write(stderr,'(*(g0,1x))')'fpm::run<INFO>:test expected at',newwords(i),& - & merge('exists ','does not exist',exists(newwords(i))) - cycle - endif - cmd=newwords(i) // ' ' // settings%args - if(exists(newwords(i)))then - call run(cmd) - else ! try to build -- once build works conditionally this should be an unconditional call - call cmd_build(fpm_build_settings(release=settings%release,list=.false.)) - if(exists(newwords(i)))then - call run(cmd) + ! Check all names are valid + if (any(.not.found)) then + + write(stderr,'(A)',advance="no")'fpm::run<ERROR> specified names ' + do j=1,size(settings%name) + if (.not.found(j)) write(stderr,'(A)',advance="no") '"'//trim(settings%name(j))//'" ' + end do + write(stderr,'(A)') 'not found.' + write(stderr,*) + + j = 1 + nCol = LINE_WIDTH/col_width + write(stderr,*) 'Available names:' + do i=1,size(model%targets) + + exe_target => model%targets(i)%ptr + + if (exe_target%target_type == FPM_TARGET_EXECUTABLE .and. & + allocated(exe_target%dependencies)) then + + exe_source => exe_target%dependencies(1)%ptr%source + + if (exe_source%unit_scope == & + merge(FPM_SCOPE_TEST,FPM_SCOPE_APP,test)) then + + write(stderr,'(A)',advance=(merge("yes","no ",modulo(j,nCol)==0))) & + & [character(len=col_width) :: basename(exe_target%output_file)] + j = j + 1 + + end if + + end if + + end do + + write(stderr,*) + stop 1 + + end if + + ! NB. To be replaced after incremental rebuild is implemented + if (.not.settings%list .and. & + any([(.not.exists(executables(i)%s),i=1,size(executables))])) then + + call build_package(model) + + end if + + do i=1,size(executables) + if (settings%list) then + write(stderr,*) executables(i)%s + else + + if (exists(executables(i)%s)) then + call run(executables(i)%s//" "//settings%args) else - write(stderr,*)'fpm::run<ERROR>',cmd,' not found' - endif - endif - enddo - deallocate(newwords) -end subroutine cmd_test + write(stderr,*)'fpm::run<ERROR>',executables(i)%s,' not found' + stop 1 + end if + end if + end do + +end subroutine cmd_run end module fpm diff --git a/fpm/src/fpm/manifest/build_config.f90 b/fpm/src/fpm/manifest/build_config.f90 index 0509915..612c051 100644 --- a/fpm/src/fpm/manifest/build_config.f90 +++ b/fpm/src/fpm/manifest/build_config.f90 @@ -6,9 +6,11 @@ !>[build] !>auto-executables = bool !>auto-tests = bool +!>link = ["lib"] !>``` module fpm_manifest_build_config use fpm_error, only : error_t, syntax_error, fatal_error + use fpm_strings, only : string_t use fpm_toml, only : toml_table, toml_key, toml_stat, get_value implicit none private @@ -25,6 +27,9 @@ module fpm_manifest_build_config !> Automatic discovery of tests logical :: auto_tests + !> Libraries to link against + type(string_t), allocatable :: link(:) + contains !> Print information on this instance @@ -48,7 +53,6 @@ contains !> Error handling type(error_t), allocatable, intent(out) :: error - !> Status integer :: stat call check(table, error) @@ -68,6 +72,9 @@ contains return end if + call get_value(table, "link", self%link, error) + if (allocated(error)) return + end subroutine new_build_config @@ -91,7 +98,7 @@ contains do ikey = 1, size(list) select case(list(ikey)%key) - case("auto-executables", "auto-tests") + case("auto-executables", "auto-tests", "link") continue case default @@ -116,7 +123,7 @@ contains !> Verbosity of the printout integer, intent(in), optional :: verbosity - integer :: pr + integer :: pr, ilink character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)' if (present(verbosity)) then @@ -128,12 +135,14 @@ contains if (pr < 1) return write(unit, fmt) "Build configuration" - ! if (allocated(self%auto_executables)) then - write(unit, fmt) " - auto-discovery (apps) ", merge("enabled ", "disabled", self%auto_executables) - ! end if - ! if (allocated(self%auto_tests)) then - write(unit, fmt) " - auto-discovery (tests) ", merge("enabled ", "disabled", self%auto_tests) - ! end if + write(unit, fmt) " - auto-discovery (apps) ", merge("enabled ", "disabled", self%auto_executables) + write(unit, fmt) " - auto-discovery (tests) ", merge("enabled ", "disabled", self%auto_tests) + if (allocated(self%link)) then + write(unit, fmt) " - link against" + do ilink = 1, size(self%link) + write(unit, fmt) " - " // self%link(ilink)%s + end do + end if end subroutine info diff --git a/fpm/src/fpm/manifest/executable.f90 b/fpm/src/fpm/manifest/executable.f90 index 87d9a8d..b34c409 100644 --- a/fpm/src/fpm/manifest/executable.f90 +++ b/fpm/src/fpm/manifest/executable.f90 @@ -7,11 +7,13 @@ !>name = "string" !>source-dir = "path" !>main = "file" +!>link = ["lib"] !>[executable.dependencies] !>``` module fpm_manifest_executable use fpm_manifest_dependency, only : dependency_t, new_dependencies use fpm_error, only : error_t, syntax_error + use fpm_strings, only : string_t use fpm_toml, only : toml_table, toml_key, toml_stat, get_value implicit none private @@ -34,6 +36,9 @@ module fpm_manifest_executable !> Dependency meta data for this executable type(dependency_t), allocatable :: dependency(:) + !> Libraries to link against + type(string_t), allocatable :: link(:) + contains !> Print information on this instance @@ -76,6 +81,9 @@ contains if (allocated(error)) return end if + call get_value(table, "link", self%link, error) + if (allocated(error)) return + end subroutine new_executable @@ -110,7 +118,7 @@ contains case("name") name_present = .true. - case("source-dir", "main", "dependencies") + case("source-dir", "main", "dependencies", "link") continue end select diff --git a/fpm/src/fpm/manifest/test.f90 b/fpm/src/fpm/manifest/test.f90 index c01d51d..cb7f666 100644 --- a/fpm/src/fpm/manifest/test.f90 +++ b/fpm/src/fpm/manifest/test.f90 @@ -11,6 +11,7 @@ !>name = "string" !>source-dir = "path" !>main = "file" +!>link = ["lib"] !>[test.dependencies] !>``` module fpm_manifest_test @@ -69,6 +70,9 @@ contains if (allocated(error)) return end if + call get_value(table, "link", self%link, error) + if (allocated(error)) return + end subroutine new_test @@ -103,7 +107,7 @@ contains case("name") name_present = .true. - case("source-dir", "main", "dependencies") + case("source-dir", "main", "dependencies", "link") continue end select diff --git a/fpm/src/fpm/toml.f90 b/fpm/src/fpm/toml.f90 index ecefdd8..34f7c58 100644 --- a/fpm/src/fpm/toml.f90 +++ b/fpm/src/fpm/toml.f90 @@ -13,6 +13,7 @@ !> For more details on the library used see: https://toml-f.github.io/toml-f module fpm_toml use fpm_error, only : error_t, fatal_error, file_not_found_error + use fpm_strings, only : string_t use tomlf, only : toml_table, toml_array, toml_key, toml_stat, get_value, & & set_value, toml_parse, toml_error, new_table, add_table, add_array, len implicit none @@ -23,6 +24,11 @@ module fpm_toml public :: new_table, add_table, add_array, len + interface get_value + module procedure :: get_child_value_string_list + end interface get_value + + contains @@ -62,4 +68,50 @@ contains end subroutine read_package_file + subroutine get_child_value_string_list(table, key, list, error) + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Key to read from + character(len=*), intent(in) :: key + + !> List of strings to read + type(string_t), allocatable, intent(out) :: list(:) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: stat, ilist, nlist + type(toml_array), pointer :: children + character(len=:), allocatable :: str + + call get_value(table, key, children, requested=.false.) + if (associated(children)) then + nlist = len(children) + allocate(list(nlist)) + do ilist = 1, nlist + call get_value(children, ilist, str, stat=stat) + if (stat /= toml_stat%success) then + call fatal_error(error, "Entry in "//key//" field cannot be read") + exit + end if + call move_alloc(str, list(ilist)%s) + end do + if (allocated(error)) return + else + call get_value(table, key, str, stat=stat) + if (stat /= toml_stat%success) then + call fatal_error(error, "Entry in "//key//" field cannot be read") + return + end if + if (allocated(str)) then + allocate(list(1)) + call move_alloc(str, list(1)%s) + end if + end if + + end subroutine get_child_value_string_list + + end module fpm_toml diff --git a/fpm/src/fpm_backend.f90 b/fpm/src/fpm_backend.f90 index d705ec2..3cb95d7 100644 --- a/fpm/src/fpm_backend.f90 +++ b/fpm/src/fpm_backend.f90 @@ -22,8 +22,8 @@ contains subroutine build_package(model) type(fpm_model_t), intent(inout) :: model - integer :: i - character(:), allocatable :: base, linking, subdir + integer :: i, ilib + character(:), allocatable :: base, linking, subdir, link_flags if (.not.exists(model%output_directory)) then call mkdir(model%output_directory) @@ -57,9 +57,9 @@ recursive subroutine build_target(model,target,linking) type(build_target_t), intent(inout) :: target character(:), allocatable, intent(in) :: linking - integer :: i, j + integer :: i, j, ilib type(build_target_t), pointer :: exe_obj - character(:), allocatable :: objs + character(:), allocatable :: objs, link_flags if (target%built) then return @@ -119,8 +119,15 @@ recursive subroutine build_target(model,target,linking) // " -o " // target%output_file) case (FPM_TARGET_EXECUTABLE) + link_flags = linking + if (allocated(target%link_libraries)) then + do ilib = 1, size(target%link_libraries) + link_flags = link_flags // " -l" // target%link_libraries(ilib)%s + end do + end if + call run("gfortran " // objs // model%fortran_compile_flags & - //linking// " -o " // target%output_file) + //link_flags// " -o " // target%output_file) case (FPM_TARGET_ARCHIVE) call run("ar -rs " // target%output_file // objs) diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index cf7c761..dc6823f 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -36,18 +36,12 @@ type, extends(fpm_cmd_settings) :: fpm_build_settings logical :: list=.false. end type -type, extends(fpm_cmd_settings) :: fpm_run_settings +type, extends(fpm_build_settings) :: fpm_run_settings character(len=ibug),allocatable :: name(:) - logical :: release=.false. - logical :: list=.false. character(len=:),allocatable :: args end type -type, extends(fpm_cmd_settings) :: fpm_test_settings - character(len=ibug),allocatable :: name(:) - logical :: release=.false. - logical :: list=.false. - character(len=:),allocatable :: args +type, extends(fpm_run_settings) :: fpm_test_settings end type type, extends(fpm_cmd_settings) :: fpm_install_settings diff --git a/fpm/src/fpm_model.f90 b/fpm/src/fpm_model.f90 index b8c3220..20f174b 100644 --- a/fpm/src/fpm_model.f90 +++ b/fpm/src/fpm_model.f90 @@ -51,6 +51,8 @@ type srcfile_t ! Modules USEd by this source file (lowerstring) type(string_t), allocatable :: include_dependencies(:) ! Files INCLUDEd by this source file + type(string_t), allocatable :: link_libraries(:) + ! Native libraries to link against end type srcfile_t type build_target_ptr @@ -66,6 +68,8 @@ type build_target_t type(build_target_ptr), allocatable :: dependencies(:) ! Resolved build dependencies integer :: target_type = FPM_TARGET_UNKNOWN + type(string_t), allocatable :: link_libraries(:) + ! Native libraries to link against logical :: built = .false. logical :: touched = .false. @@ -87,6 +91,8 @@ type :: fpm_model_t ! Command line flags pass for linking character(:), allocatable :: output_directory ! Base directory for build + type(string_t), allocatable :: link_libraries(:) + ! Native libraries to link against end type fpm_model_t end module fpm_model diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index 7d853e0..fa5c6e7 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -51,13 +51,14 @@ function parse_source(source_file_path,error) result(source) end function parse_source -subroutine add_sources_from_dir(sources,directory,scope,with_executables,error) +subroutine add_sources_from_dir(sources,directory,scope,with_executables,recurse,error) ! Enumerate sources in a directory ! type(srcfile_t), allocatable, intent(inout), target :: sources(:) character(*), intent(in) :: directory integer, intent(in) :: scope logical, intent(in), optional :: with_executables + logical, intent(in), optional :: recurse type(error_t), allocatable, intent(out) :: error integer :: i @@ -68,7 +69,7 @@ subroutine add_sources_from_dir(sources,directory,scope,with_executables,error) type(srcfile_t), allocatable :: dir_sources(:) ! Scan directory for sources - call list_files(directory, file_names,recurse=.true.) + call list_files(directory, file_names,recurse=merge(recurse,.true.,present(recurse))) if (allocated(sources)) then allocate(existing_src_files(size(sources))) @@ -135,8 +136,8 @@ subroutine add_executable_sources(sources,executables,scope,auto_discover,error) call get_executable_source_dirs(exe_dirs,executables) do i=1,size(exe_dirs) - call add_sources_from_dir(sources,exe_dirs(i)%s, & - scope, with_executables=auto_discover,error=error) + call add_sources_from_dir(sources,exe_dirs(i)%s, scope, & + with_executables=auto_discover, recurse=.false., error=error) if (allocated(error)) then return @@ -154,6 +155,9 @@ subroutine add_executable_sources(sources,executables,scope,auto_discover,error) canon_path(executables(i)%source_dir) ) then sources(j)%exe_name = executables(i)%name + if (allocated(executables(i)%link)) then + exe_source%link_libraries = executables(i)%link + end if cycle exe_loop end if @@ -163,6 +167,9 @@ subroutine add_executable_sources(sources,executables,scope,auto_discover,error) ! Add if not already discovered (auto_discovery off) exe_source = parse_source(join_path(executables(i)%source_dir,executables(i)%main),error) exe_source%exe_name = executables(i)%name + if (allocated(executables(i)%link)) then + exe_source%link_libraries = executables(i)%link + end if exe_source%unit_scope = scope if (allocated(error)) return diff --git a/fpm/src/fpm_targets.f90 b/fpm/src/fpm_targets.f90 index 2cd4418..c3a59fd 100644 --- a/fpm/src/fpm_targets.f90 +++ b/fpm/src/fpm_targets.f90 @@ -3,7 +3,7 @@ use fpm_error, only: error_t, fatal_error use fpm_model use fpm_environment, only: get_os_type, OS_WINDOWS use fpm_filesystem, only: dirname, join_path, canon_path -use fpm_strings, only: operator(.in.) +use fpm_strings, only: string_t, operator(.in.) implicit none contains @@ -45,9 +45,11 @@ subroutine targets_from_sources(model,sources) if (sources(i)%unit_scope == FPM_SCOPE_APP) then call add_target(model%targets,type = FPM_TARGET_EXECUTABLE,& + link_libraries = sources(i)%link_libraries, & output_file = join_path(model%output_directory,'app',sources(i)%exe_name)) else call add_target(model%targets,type = FPM_TARGET_EXECUTABLE,& + link_libraries = sources(i)%link_libraries, & output_file = join_path(model%output_directory,'test',sources(i)%exe_name)) end if @@ -108,11 +110,12 @@ end subroutine targets_from_sources !> Add new target to target list -subroutine add_target(targets,type,output_file,source) +subroutine add_target(targets,type,output_file,source,link_libraries) type(build_target_ptr), allocatable, intent(inout) :: targets(:) integer, intent(in) :: type character(*), intent(in) :: output_file type(srcfile_t), intent(in), optional :: source + type(string_t), intent(in), optional :: link_libraries(:) integer :: i type(build_target_ptr), allocatable :: temp(:) @@ -138,6 +141,7 @@ subroutine add_target(targets,type,output_file,source) new_target%target_type = type new_target%output_file = output_file if (present(source)) new_target%source = source + if (present(link_libraries)) new_target%link_libraries = link_libraries allocate(new_target%dependencies(0)) targets = [targets, build_target_ptr(new_target)] @@ -245,4 +249,4 @@ function find_module_dependency(targets,module_name,include_dir) result(target_p end function find_module_dependency -end module fpm_targets
\ No newline at end of file +end module fpm_targets diff --git a/fpm/test/cli_test/cli_test.f90 b/fpm/test/cli_test/cli_test.f90 index 59f1f7a..915d9da 100644 --- a/fpm/test/cli_test/cli_test.f90 +++ b/fpm/test/cli_test/cli_test.f90 @@ -193,7 +193,7 @@ use fpm_command_line, only: & fpm_test_settings, & fpm_install_settings, & get_command_line_settings -use fpm, only: cmd_build, cmd_install, cmd_run, cmd_test +use fpm, only: cmd_build, cmd_install, cmd_run use fpm_cmd_new, only: cmd_new class(fpm_cmd_settings), allocatable :: cmd_settings ! duplicates the calls as seen in the main program for fpm diff --git a/fpm/test/fpm_test/test_manifest.f90 b/fpm/test/fpm_test/test_manifest.f90 index 575f255..1116a74 100644 --- a/fpm/test/fpm_test/test_manifest.f90 +++ b/fpm/test/fpm_test/test_manifest.f90 @@ -51,7 +51,10 @@ contains & new_unittest("test-empty", test_test_empty, should_fail=.true.), & & new_unittest("test-typeerror", test_test_typeerror, should_fail=.true.), & & new_unittest("test-noname", test_test_noname, should_fail=.true.), & - & new_unittest("test-wrongkey", test_test_wrongkey, should_fail=.true.)] + & new_unittest("test-wrongkey", test_test_wrongkey, should_fail=.true.), & + & new_unittest("test-link-string", test_link_string), & + & new_unittest("test-link-array", test_link_array), & + & new_unittest("test-link-error", test_invalid_link, should_fail=.true.)] end subroutine collect_manifest @@ -850,4 +853,68 @@ contains end subroutine test_test_wrongkey + !> Test link options + subroutine test_link_string(error) + use fpm_manifest_build_config + use fpm_toml, only : set_value, toml_table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + integer :: stat + type(build_config_t) :: build + + table = toml_table() + call set_value(table, "link", "z", stat=stat) + + call new_build_config(build, table, error) + + end subroutine test_link_string + + + !> Test link options + subroutine test_link_array(error) + use fpm_manifest_build_config + use fpm_toml, only : add_array, set_value, toml_table, toml_array + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(toml_array), pointer :: children + integer :: stat + type(build_config_t) :: build + + table = toml_table() + call add_array(table, "link", children, stat=stat) + call set_value(children, 1, "blas", stat=stat) + call set_value(children, 2, "lapack", stat=stat) + + call new_build_config(build, table, error) + + end subroutine test_link_array + + + !> Test link options + subroutine test_invalid_link(error) + use fpm_manifest_build_config + use fpm_toml, only : add_table, toml_table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: table + type(toml_table), pointer :: child + integer :: stat + type(build_config_t) :: build + + table = toml_table() + call add_table(table, "link", child, stat=stat) + + call new_build_config(build, table, error) + + end subroutine test_invalid_link + + end module test_manifest diff --git a/manifest-reference.md b/manifest-reference.md index 5f0227a..63a533f 100644 --- a/manifest-reference.md +++ b/manifest-reference.md @@ -29,6 +29,8 @@ Every manifest file consists of the following sections: Toggle automatic discovery of test executables - [*auto-executables*](#automatic-target-discovery): Toggle automatic discovery of executables + - [*link*](#link-external-libraries): + Link with external dependencies - Target sections: - [*library*](#library-configuration) Configuration of the library target @@ -228,6 +230,11 @@ See [specifying dependencies](#specifying-dependencies) for more details. > Dependencies supported in Bootstrap fpm only +Executables can also specify their own external library dependencies. +See [external libraries](#link-external-libraries) for more details. + +> Linking against libraries is supported in Fortran fpm only + *Example:* ```toml @@ -238,6 +245,7 @@ main = "program.f90" [[ executable ]] name = "app-tool" +link = "z" [executable.dependencies] helloff = { git = "https://gitlab.com/everythingfunctional/helloff.git" } ``` @@ -267,6 +275,11 @@ See [specifying dependencies](#specifying-dependencies) for more details. > Dependencies supported in Bootstrap fpm only +Tests can also specify their own external library dependencies. +See [external libraries](#link-external-libraries) for more details. + +> Linking against libraries is supported in Fortran fpm only + *Example:* ```toml @@ -277,11 +290,39 @@ main = "tester.F90" [[ test ]] name = "tester" +link = ["blas", "lapack"] [test.dependencies] helloff = { git = "https://gitlab.com/everythingfunctional/helloff.git" } ``` +## Link external libraries + +> Supported in Fortran fpm only + +To declare link time dependencies on external libraries a list of native libraries can be specified in the *link* entry. +Specify either one library as string or a list of strings in case several libraries should be linked. +When possible the project should only link one native library. +The list of library dependencies is exported to dependent packages. + +*Example:* + +To link against the zlib compression library use + +```toml +[build] +link = "z" +``` + +To dependent on LAPACK also BLAS should be linked. +In this case the order of the libraries matters: + +```toml +[build] +link = ["blas", "lapack"] +``` + + ## Automatic target discovery > Supported in Fortran fpm only |