From fcc971fd8703c37b8e0e02dabfe95138b4979309 Mon Sep 17 00:00:00 2001 From: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> Date: Tue, 10 Nov 2020 20:28:43 +0100 Subject: Allow external link dependencies with scope limited to targets - move reader for string list to toml-f proxy - allow link entry in executable and test tables - bump toml-f version to v0.2.1 - add example package linking a single executable against gomp --- ci/run_tests.bat | 10 ++++++ ci/run_tests.sh | 4 +++ example_packages/README.md | 1 + example_packages/link_executable/.gitignore | 1 + example_packages/link_executable/app/main.f90 | 11 ++++++ example_packages/link_executable/fpm.toml | 8 +++++ fpm/fpm.toml | 2 +- fpm/src/fpm/manifest/build_config.f90 | 33 +++-------------- fpm/src/fpm/manifest/executable.f90 | 10 +++++- fpm/src/fpm/manifest/test.f90 | 6 +++- fpm/src/fpm/toml.f90 | 52 +++++++++++++++++++++++++++ fpm/src/fpm_backend.f90 | 17 ++++++--- fpm/src/fpm_model.f90 | 4 +++ fpm/src/fpm_sources.f90 | 6 ++++ fpm/src/fpm_targets.f90 | 10 ++++-- manifest-reference.md | 4 +-- 16 files changed, 137 insertions(+), 42 deletions(-) create mode 100644 example_packages/link_executable/.gitignore create mode 100644 example_packages/link_executable/app/main.f90 create mode 100644 example_packages/link_executable/fpm.toml 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 d5d3045..894b1f0 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -73,3 +73,7 @@ cd ../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 95f28d7..0eb0653 100644 --- a/example_packages/README.md +++ b/example_packages/README.md @@ -17,5 +17,6 @@ the features demonstrated in each package and which versions of fpm are supporte | 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 | 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/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/manifest/build_config.f90 b/fpm/src/fpm/manifest/build_config.f90 index a88fd58..612c051 100644 --- a/fpm/src/fpm/manifest/build_config.f90 +++ b/fpm/src/fpm/manifest/build_config.f90 @@ -11,8 +11,7 @@ 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_array, toml_key, toml_stat, get_value, & - & len + use fpm_toml, only : toml_table, toml_key, toml_stat, get_value implicit none private @@ -54,9 +53,7 @@ contains !> Error handling type(error_t), allocatable, intent(out) :: error - integer :: stat, ilink, nlink - type(toml_array), pointer :: children - character(len=:), allocatable :: link + integer :: stat call check(table, error) if (allocated(error)) return @@ -75,30 +72,8 @@ contains return end if - call get_value(table, "link", children, requested=.false.) - if (associated(children)) then - nlink = len(children) - allocate(self%link(nlink)) - do ilink = 1, nlink - call get_value(children, ilink, link, stat=stat) - if (stat /= toml_stat%success) then - call fatal_error(error, "Entry in link field cannot be read") - exit - end if - call move_alloc(link, self%link(ilink)%s) - end do - if (allocated(error)) return - else - call get_value(table, "link", link, stat=stat) - if (stat /= toml_stat%success) then - call fatal_error(error, "Entry in link field cannot be read") - return - end if - if (allocated(link)) then - allocate(self%link(1)) - call move_alloc(link, self%link(1)%s) - end if - end if + call get_value(table, "link", self%link, error) + if (allocated(error)) return end subroutine new_build_config 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_model.f90 b/fpm/src/fpm_model.f90 index 7643416..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. diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index 2932b52..fa5c6e7 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -155,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 @@ -164,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/manifest-reference.md b/manifest-reference.md index 5002881..63a533f 100644 --- a/manifest-reference.md +++ b/manifest-reference.md @@ -233,7 +233,7 @@ See [specifying dependencies](#specifying-dependencies) for more details. Executables can also specify their own external library dependencies. See [external libraries](#link-external-libraries) for more details. -> Currently not supported in any version +> Linking against libraries is supported in Fortran fpm only *Example:* @@ -278,7 +278,7 @@ See [specifying dependencies](#specifying-dependencies) for more details. Tests can also specify their own external library dependencies. See [external libraries](#link-external-libraries) for more details. -> Currently not supported in any version +> Linking against libraries is supported in Fortran fpm only *Example:* -- cgit v1.2.3