diff --git a/.gitignore b/.gitignore index 16bf9716de..a7b1ac33f6 100644 --- a/.gitignore +++ b/.gitignore @@ -6,3 +6,6 @@ build/* # CodeBlocks project/ +# Temporary files +*.swp + diff --git a/ci/run_tests.sh b/ci/run_tests.sh index b4be003705..0260743f16 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -310,5 +310,39 @@ fi popd +# Test shared library dependencies +pushd shared_lib +"$fpm" build || EXIT_CODE=$? +test $EXIT_CODE -eq 0 +popd + +pushd shared_lib_extra +"$fpm" build || EXIT_CODE=$? +test $EXIT_CODE -eq 0 +popd + +pushd shared_lib_empty +"$fpm" build +"$fpm" run +"$fpm" test +popd + +pushd static_lib_empty +"$fpm" build +"$fpm" run +"$fpm" test +popd + +pushd shared_app_only +"$fpm" test || EXIT_CODE=$? +test $EXIT_CODE -eq 0 +popd + +# Static library dependencies +pushd static_app_only +"$fpm" test || EXIT_CODE=$? +test $EXIT_CODE -eq 0 +popd + # Cleanup rm -rf ./*/build diff --git a/example_packages/shared_app_only/app/main.f90 b/example_packages/shared_app_only/app/main.f90 new file mode 100644 index 0000000000..38fcad0975 --- /dev/null +++ b/example_packages/shared_app_only/app/main.f90 @@ -0,0 +1,4 @@ +program main + use testdrive + print *, 'Hello, world!' +end program main diff --git a/example_packages/shared_app_only/fpm.toml b/example_packages/shared_app_only/fpm.toml new file mode 100644 index 0000000000..1506a4c44e --- /dev/null +++ b/example_packages/shared_app_only/fpm.toml @@ -0,0 +1,8 @@ +# App only, use shared lib from other folder +name = "shared_app_only" +library.type="shared" +install.library=true +[dependencies] +shared_lib_extra = { path = "../shared_lib_extra" } +[dev-dependencies] +test-drive = { git = "https://github.com/fortran-lang/test-drive", tag="v0.5.0" } diff --git a/example_packages/shared_app_only/test/test.f90 b/example_packages/shared_app_only/test/test.f90 new file mode 100644 index 0000000000..652d58d603 --- /dev/null +++ b/example_packages/shared_app_only/test/test.f90 @@ -0,0 +1,50 @@ +module test_shared_lib + use testdrive, only : new_unittest, unittest_type, error_type, check + use shared_lib, only: test_something + + implicit none + + public :: collect + + +contains + + !> Collect all exported unit tests + subroutine collect(testsuite) + !> Collection of tests + type(unittest_type), allocatable, intent(out) :: testsuite(:) + + testsuite = [ new_unittest("shared_lib", test_shared) ] + + end subroutine collect + + subroutine test_shared(error) + type(error_type), allocatable, intent(out) :: error + + call check(error, test_something(), 123, "Should be test_something==123") + + end subroutine test_shared + +end module test_shared_lib + +program tester + use, intrinsic :: iso_fortran_env, only : error_unit + use testdrive, only : run_testsuite, new_testsuite, testsuite_type + use test_shared_lib, only : collect + implicit none + integer :: stat + type(testsuite_type), allocatable :: testsuite + character(len=*), parameter :: fmt = '("#", *(1x, a))' + + stat = 0 + + testsuite = new_testsuite("shared_lib", collect) + + write(error_unit, fmt) "Testing:", testsuite%name + call run_testsuite(testsuite%collect, error_unit, stat) + + if (stat > 0) then + write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!" + error stop + end if +end program tester diff --git a/example_packages/shared_lib/fpm.toml b/example_packages/shared_lib/fpm.toml new file mode 100644 index 0000000000..5d812881f2 --- /dev/null +++ b/example_packages/shared_lib/fpm.toml @@ -0,0 +1,3 @@ +# Shared library with no executables +name = "shared_lib" +library.type="shared" diff --git a/example_packages/shared_lib/src/shared_lib.f90 b/example_packages/shared_lib/src/shared_lib.f90 new file mode 100644 index 0000000000..1743c9fc05 --- /dev/null +++ b/example_packages/shared_lib/src/shared_lib.f90 @@ -0,0 +1,14 @@ +module shared_lib + implicit none + private + + public :: say_hello + public :: test_something +contains + subroutine say_hello + print *, "Hello, shared_lib!" + end subroutine say_hello + integer function test_something() + test_something = 123 + end function test_something +end module shared_lib diff --git a/example_packages/shared_lib_empty/fpm.toml b/example_packages/shared_lib_empty/fpm.toml new file mode 100644 index 0000000000..af881f59a0 --- /dev/null +++ b/example_packages/shared_lib_empty/fpm.toml @@ -0,0 +1,5 @@ +name = "shared_lib_empty" +library.type="shared" +[dependencies] +shared_lib = { path = "../shared_lib" } +shared_app_only = { path = "../shared_app_only" } diff --git a/example_packages/shared_lib_extra/fpm.toml b/example_packages/shared_lib_extra/fpm.toml new file mode 100644 index 0000000000..5ad49477d9 --- /dev/null +++ b/example_packages/shared_lib_extra/fpm.toml @@ -0,0 +1,4 @@ +name = "shared_lib_extra" +library.type="shared" +[dependencies] +shared_lib = { path = "../shared_lib" } diff --git a/example_packages/shared_lib_extra/src/shared_lib_extra.f90 b/example_packages/shared_lib_extra/src/shared_lib_extra.f90 new file mode 100644 index 0000000000..f4b12ef121 --- /dev/null +++ b/example_packages/shared_lib_extra/src/shared_lib_extra.f90 @@ -0,0 +1,10 @@ +module shared_lib_extra + implicit none + private + + public :: say_extra_hello +contains + subroutine say_extra_hello + print *, "Hello, shared_lib_extra!" + end subroutine say_extra_hello +end module shared_lib_extra diff --git a/example_packages/static_app_only/app/main.f90 b/example_packages/static_app_only/app/main.f90 new file mode 100644 index 0000000000..38fcad0975 --- /dev/null +++ b/example_packages/static_app_only/app/main.f90 @@ -0,0 +1,4 @@ +program main + use testdrive + print *, 'Hello, world!' +end program main diff --git a/example_packages/static_app_only/fpm.toml b/example_packages/static_app_only/fpm.toml new file mode 100644 index 0000000000..914339b6b5 --- /dev/null +++ b/example_packages/static_app_only/fpm.toml @@ -0,0 +1,8 @@ +# App only, use shared libs from other folder, no provided sources +name = "static_app_only" +library.type="static" +install.library=true +[dependencies] +shared_lib_extra = { path = "../shared_lib_extra" } +[dev-dependencies] +test-drive = { git = "https://github.com/fortran-lang/test-drive", tag="v0.5.0" } diff --git a/example_packages/static_app_only/test/test.f90 b/example_packages/static_app_only/test/test.f90 new file mode 100644 index 0000000000..652d58d603 --- /dev/null +++ b/example_packages/static_app_only/test/test.f90 @@ -0,0 +1,50 @@ +module test_shared_lib + use testdrive, only : new_unittest, unittest_type, error_type, check + use shared_lib, only: test_something + + implicit none + + public :: collect + + +contains + + !> Collect all exported unit tests + subroutine collect(testsuite) + !> Collection of tests + type(unittest_type), allocatable, intent(out) :: testsuite(:) + + testsuite = [ new_unittest("shared_lib", test_shared) ] + + end subroutine collect + + subroutine test_shared(error) + type(error_type), allocatable, intent(out) :: error + + call check(error, test_something(), 123, "Should be test_something==123") + + end subroutine test_shared + +end module test_shared_lib + +program tester + use, intrinsic :: iso_fortran_env, only : error_unit + use testdrive, only : run_testsuite, new_testsuite, testsuite_type + use test_shared_lib, only : collect + implicit none + integer :: stat + type(testsuite_type), allocatable :: testsuite + character(len=*), parameter :: fmt = '("#", *(1x, a))' + + stat = 0 + + testsuite = new_testsuite("shared_lib", collect) + + write(error_unit, fmt) "Testing:", testsuite%name + call run_testsuite(testsuite%collect, error_unit, stat) + + if (stat > 0) then + write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!" + error stop + end if +end program tester diff --git a/example_packages/static_lib_empty/fpm.toml b/example_packages/static_lib_empty/fpm.toml new file mode 100644 index 0000000000..513661708f --- /dev/null +++ b/example_packages/static_lib_empty/fpm.toml @@ -0,0 +1,5 @@ +name = "static_lib_empty" +library.type="static" +[dependencies] +shared_lib = { path = "../shared_lib" } +shared_app_only = { path = "../shared_app_only" } diff --git a/src/fpm.f90 b/src/fpm.f90 index 2075c02f52..5f1c1e7a6c 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -17,7 +17,7 @@ module fpm use fpm_sources, only: add_executable_sources, add_sources_from_dir use fpm_targets, only: targets_from_sources, build_target_t, build_target_ptr, & - FPM_TARGET_EXECUTABLE, FPM_TARGET_ARCHIVE + FPM_TARGET_EXECUTABLE, get_library_dirs use fpm_manifest, only : get_package_data, package_config_t use fpm_meta, only : resolve_metapackages use fpm_error, only : error_t, fatal_error, fpm_stop @@ -26,7 +26,7 @@ module fpm & stdout => output_unit, & & stderr => error_unit use iso_c_binding, only: c_char, c_ptr, c_int, c_null_char, c_associated, c_f_pointer -use fpm_environment, only: os_is_unix +use fpm_environment, only: os_is_unix, get_os_type, OS_WINDOWS, OS_MACOS, get_env, set_env, delete_env use fpm_settings, only: fpm_global_settings, get_global_settings implicit none @@ -68,10 +68,10 @@ subroutine build_model(model, settings, package, error) end if call new_compiler_flags(model,settings) - model%build_prefix = join_path("build", basename(model%compiler%fc)) - model%include_tests = settings%build_tests + model%build_prefix = join_path("build", basename(model%compiler%fc)) + model%include_tests = settings%build_tests model%enforce_module_names = package%build%module_naming - model%module_prefix = package%build%module_prefix + model%module_prefix = package%build%module_prefix ! Resolve meta-dependencies into the package and the model call resolve_metapackages(model,package,settings,error) @@ -447,7 +447,7 @@ subroutine cmd_build(settings) call fpm_stop(1,'*cmd_build* Model error: '//error%message) end if -call targets_from_sources(targets, model, settings%prune, error) +call targets_from_sources(targets, model, settings%prune, package%library, error) if (allocated(error)) then call fpm_stop(1,'*cmd_build* Target error: '//error%message) end if @@ -487,7 +487,7 @@ subroutine cmd_run(settings,test) type(srcfile_t), pointer :: exe_source integer :: run_scope,firsterror integer, allocatable :: stat(:),target_ID(:) - character(len=:),allocatable :: line + character(len=:),allocatable :: line,run_cmd,library_path call get_package_data(package, "fpm.toml", error, apply_defaults=.true.) if (allocated(error)) then @@ -499,7 +499,7 @@ subroutine cmd_run(settings,test) call fpm_stop(1, '*cmd_run* Model error: '//error%message) end if - call targets_from_sources(targets, model, settings%prune, error) + call targets_from_sources(targets, model, settings%prune, package%library, error) if (allocated(error)) then call fpm_stop(1, '*cmd_run* Targets error: '//error%message) end if @@ -581,25 +581,23 @@ subroutine cmd_run(settings,test) call compact_list() else + ! Save current library path and set a new one that includes the local + ! dynamic library folders + library_path = save_library_path() + call set_library_path(model, targets, error) + if (allocated(error)) call fpm_stop(1, '*cmd_run* Run error: '//error%message) + allocate(stat(size(executables))) do i=1,size(executables) if (exists(executables(i)%s)) then - if(settings%runner /= ' ')then - if(.not.allocated(settings%args))then - call run(settings%runner_command()//' '//executables(i)%s, & - echo=settings%verbose, exitstat=stat(i)) - else - call run(settings%runner_command()//' '//executables(i)%s//" "//settings%args, & - echo=settings%verbose, exitstat=stat(i)) - endif - else - if(.not.allocated(settings%args))then - call run(executables(i)%s,echo=settings%verbose, exitstat=stat(i)) - else - call run(executables(i)%s//" "//settings%args,echo=settings%verbose, & - exitstat=stat(i)) - endif - endif + + ! Prepare command line + run_cmd = executables(i)%s + if (settings%runner/=' ') run_cmd = settings%runner_command()//' '//run_cmd + if (allocated(settings%args)) run_cmd = run_cmd//" "//settings%args + + call run(run_cmd,echo=settings%verbose,exitstat=stat(i)) + else call fpm_stop(1,'*cmd_run*:'//executables(i)%s//' not found') end if @@ -615,6 +613,10 @@ subroutine cmd_run(settings,test) firsterror = findloc(stat/=0,value=.true.,dim=1) call fpm_stop(stat(firsterror),'*cmd_run*:stopping due to failed executions') end if + + ! Restore original library path + call restore_library_path(library_path, error) + if (allocated(error)) call fpm_stop(1, '*cmd_run* Environment error: '//error%message) end if @@ -759,8 +761,6 @@ logical function should_be_run(settings,run_scope,exe_target) integer, intent(in) :: run_scope type(build_target_t), intent(in) :: exe_target - integer :: j - if (exe_target%is_executable_target(run_scope)) then associate(exe_source => exe_target%dependencies(1)%ptr%source) @@ -793,4 +793,86 @@ logical function should_be_run(settings,run_scope,exe_target) end function should_be_run +!> Save the current runtime library path (e.g., PATH or LD_LIBRARY_PATH) +function save_library_path() result(path) + character(len=:), allocatable :: path + + select case (get_os_type()) + case (OS_WINDOWS) + path = get_env("PATH", default="") + case (OS_MACOS) + ! macOS does not use LD_LIBRARY_PATH by default for `.dylib` + allocate(character(0) :: path) + case default ! UNIX/Linux + path = get_env("LD_LIBRARY_PATH", default="") + end select +end function save_library_path + +!> Set the runtime library path for the current process (used for subprocesses) +subroutine set_library_path(model, targets, error) + type(fpm_model_t), intent(in) :: model + type(build_target_ptr), intent(inout), target :: targets(:) + type(error_t), allocatable, intent(out) :: error + + type(string_t), allocatable :: shared_lib_dirs(:) + character(len=:), allocatable :: new_path, sep + logical :: success + integer :: i + + ! Get library directories + call get_library_dirs(model, targets, shared_lib_dirs) + + ! Select platform-specific separator + select case (get_os_type()) + case (OS_WINDOWS) + sep = ";" + case default + sep = ":" + end select + + ! Join the directories into a path string + ! Manually join paths + new_path = "" + do i = 1, size(shared_lib_dirs) + if (i > 1) new_path = new_path // sep + new_path = new_path // shared_lib_dirs(i)%s + end do + + ! Set the appropriate environment variable + select case (get_os_type()) + case (OS_WINDOWS) + success = set_env("PATH", new_path // sep // get_env("PATH", default="")) + case (OS_MACOS) + ! Typically not required for local .dylib use, noop or DYLD_LIBRARY_PATH if needed + success = .true. + case default ! UNIX/Linux + success = set_env("LD_LIBRARY_PATH", new_path // sep // get_env("LD_LIBRARY_PATH", default="")) + end select + + if (.not.success) call fatal_error(error," Cannot set library path: "//new_path) + +end subroutine set_library_path + +!> Restore a previously saved runtime library path +subroutine restore_library_path(saved_path,error) + character(*), intent(in) :: saved_path + type(error_t), allocatable, intent(out) :: error + logical :: success + + select case (get_os_type()) + case (OS_WINDOWS) + success = set_env("PATH", saved_path) + case (OS_MACOS) + ! noop + success = .true. + case default ! UNIX/Linux + success = set_env("LD_LIBRARY_PATH", saved_path) + end select + + if (.not.success) call fatal_error(error, "Cannot restore library path "//saved_path) + +end subroutine restore_library_path + + + end module fpm diff --git a/src/fpm/cmd/export.f90 b/src/fpm/cmd/export.f90 index d2ec0dbaf1..8d05546fbc 100644 --- a/src/fpm/cmd/export.f90 +++ b/src/fpm/cmd/export.f90 @@ -22,7 +22,6 @@ subroutine cmd_export(settings) type(fpm_model_t) :: model type(error_t), allocatable :: error - integer :: ii character(len=:), allocatable :: filename if (len_trim(settings%dump_manifest)<=0 .and. & diff --git a/src/fpm/cmd/install.f90 b/src/fpm/cmd/install.f90 index 8e6c516052..0fba266b0e 100644 --- a/src/fpm/cmd/install.f90 +++ b/src/fpm/cmd/install.f90 @@ -26,11 +26,11 @@ subroutine cmd_install(settings) type(package_config_t) :: package type(error_t), allocatable :: error type(fpm_model_t) :: model - type(build_target_ptr), allocatable :: targets(:) + type(build_target_ptr), allocatable :: targets(:), libraries(:) type(installer_t) :: installer type(string_t), allocatable :: list(:) logical :: installable - integer :: ntargets + integer :: ntargets,i call get_package_data(package, "fpm.toml", error, apply_defaults=.true.) call handle_error(error) @@ -38,7 +38,12 @@ subroutine cmd_install(settings) call build_model(model, settings, package, error) call handle_error(error) - call targets_from_sources(targets, model, settings%prune, error) + ! ifx bug: does not resolve allocatable -> optional + if (allocated(package%library)) then + call targets_from_sources(targets, model, settings%prune, package%library, error) + else + call targets_from_sources(targets, model, settings%prune, error=error) + endif call handle_error(error) call install_info(output_unit, settings%list, targets, ntargets) @@ -62,11 +67,13 @@ subroutine cmd_install(settings) verbosity=merge(2, 1, settings%verbose)) if (allocated(package%library) .and. package%install%library) then - call filter_library_targets(targets, list) + call filter_library_targets(targets, libraries) - if (size(list) > 0) then - call installer%install_library(list(1)%s, error) - call handle_error(error) + if (size(libraries) > 0) then + do i=1,size(libraries) + call installer%install_library(libraries(i)%ptr, error) + call handle_error(error) + end do call install_module_files(installer, targets, error) call handle_error(error) @@ -95,11 +102,12 @@ subroutine install_info(unit, verbose, targets, ntargets) integer :: ii type(string_t), allocatable :: install_target(:), temp(:) + type(build_target_ptr), allocatable :: libs(:) allocate(install_target(0)) - call filter_library_targets(targets, temp) - install_target = [install_target, temp] + call filter_library_targets(targets, libs) + install_target = [install_target, (string_t(libs(ii)%ptr%output_file),ii=1,size(libs))] call filter_executable_targets(targets, FPM_SCOPE_APP, temp) install_target = [install_target, temp] diff --git a/src/fpm/cmd/new.f90 b/src/fpm/cmd/new.f90 index 6e09b85ce3..04e096559b 100644 --- a/src/fpm/cmd/new.f90 +++ b/src/fpm/cmd/new.f90 @@ -223,6 +223,12 @@ subroutine cmd_new(settings) &' # files and library archive. Without this being set to "true" an "install" ',& &' # subcommand ignores parameters that specify library installation. ',& &' ',& + &' # If your project sets `[library] type = "shared"`, enabling this option ',& + &' # will install the compiled `.so`, `.dylib`, or `.dll` files into the ',& + &' # appropriate `lib/` folder. This applies equally to static archives. ',& + &' # ',& + &' # For shared libraries, installing is typically required for runtime usage. ',& + &' ',& &'library = false ',& &' ',& &'[build] # General Build Options ',& @@ -305,6 +311,32 @@ subroutine cmd_new(settings) &' # This rule applies generally to any number of nested directories and ',& &' # modules. For example, src/a/b/c/d.f90 must define a module called a_b_c_d. ',& &' # Again, this is not enforced but may be required in future releases. ',& + &' ',& + &' ### Library type ',& + &' # Set `type = "shared"` to build dynamic libraries (.so/.dylib/.dll) ',& + &' # instead of a static archive. You can also set `type = "static"` to ',& + &' # generate per-package archives, or use `type = "monolithic"` (default) ',& + &' # to bundle all sources and dependencies into a single archive. ',& + &' # ',& + &' # Supported types: ',& + &' # ',& + &' # + "monolithic": Single archive with used sources and dependencies. ',& + &' # + "static": One full archive per package (for external integration). ',& + &' # + "shared": One shared library per package, for dynamic linking. ',& + &' # ',& + &' # Shared libraries are useful for plugin systems, dynamic linking, or ',& + &' # language bindings. Static per-package archives may aid external reuse. ',& + &' # ',& + &' # When running with `fpm run`, shared library paths are automatically ',& + &' # added to the environment (e.g. `LD_LIBRARY_PATH`, `PATH`) at runtime. ',& + &' # ',& + &' # Note: library files are not installed unless `[install] library=true` ',& + &' # is also enabled. ',& + &' # ',& + &' # Example: ',& + &' ',& + &'type = "shared" ',& + &' ',& &''] endif ! create placeholder module src/bname.f90 diff --git a/src/fpm/dependency.f90 b/src/fpm/dependency.f90 index 8929ea7c79..a12e3d44ff 100644 --- a/src/fpm/dependency.f90 +++ b/src/fpm/dependency.f90 @@ -61,17 +61,16 @@ module fpm_dependency use fpm_filesystem, only: exists, join_path, mkdir, canon_path, windows_path, list_files, is_dir, basename, & os_delete_dir, get_temp_filename, parent_dir use fpm_git, only: git_target_revision, git_target_default, git_revision, serializable_t - use fpm_manifest, only: package_config_t, dependency_config_t, get_package_data + use fpm_manifest, only: package_config_t, dependency_config_t, get_package_data, get_package_dependencies use fpm_manifest_dependency, only: manifest_has_changed, dependency_destroy use fpm_manifest_preprocess, only: operator(==) - use fpm_strings, only: string_t, operator(.in.) - use tomlf, only: toml_table, toml_key, toml_error, toml_load, toml_stat - use fpm_toml, only: toml_serialize, get_value, set_value, add_table, set_string + use fpm_strings, only: string_t, operator(.in.), operator(==), str + use tomlf, only: toml_table, toml_key, toml_error, toml_load, toml_stat, toml_array, len, add_array + use fpm_toml, only: toml_serialize, get_value, set_value, add_table, set_string, get_list, set_list use fpm_versioning, only: version_t, new_version use fpm_settings, only: fpm_global_settings, get_global_settings, official_registry_base_url use fpm_downloader, only: downloader_t use jonquil, only: json_object - use fpm_strings, only: str implicit none private @@ -86,7 +85,7 @@ module fpm_dependency !> Dependency node in the projects dependency tree type, extends(dependency_config_t) :: dependency_node_t !> Actual version of this dependency - type(version_t), allocatable :: version + type(version_t), allocatable :: version !> Installation prefix of this dependencies character(len=:), allocatable :: proj_dir !> Checked out revision of the version control system @@ -97,9 +96,13 @@ module fpm_dependency logical :: update = .false. !> Dependency was loaded from a cache logical :: cached = .false. + !> Package dependencies of this node + type(string_t), allocatable :: package_dep(:) contains + !> Update dependency from project manifest. - procedure :: register + procedure :: register + !> Get dependency from the registry. procedure :: get_from_registry procedure, private :: get_from_local_registry @@ -108,8 +111,8 @@ module fpm_dependency !> Serialization interface procedure :: serializable_is_same => dependency_node_is_same - procedure :: dump_to_toml => node_dump_to_toml - procedure :: load_from_toml => node_load_from_toml + procedure :: dump_to_toml => node_dump_to_toml + procedure :: load_from_toml => node_load_from_toml end type dependency_node_t @@ -162,6 +165,8 @@ module fpm_dependency generic :: find => find_name !> Find a dependency by its name procedure, private :: find_name + !> Establish local link order for a node's package dependencies + procedure :: local_link_order !> Depedendncy resolution finished procedure :: finished !> Reading of dependency tree @@ -189,8 +194,8 @@ module fpm_dependency !> Serialization interface procedure :: serializable_is_same => dependency_tree_is_same - procedure :: dump_to_toml => tree_dump_to_toml - procedure :: load_from_toml => tree_load_from_toml + procedure :: dump_to_toml => tree_dump_to_toml + procedure :: load_from_toml => tree_load_from_toml end type dependency_tree_t @@ -262,7 +267,7 @@ subroutine info(self, unit, verbosity) !> Verbosity of the printout integer, intent(in), optional :: verbosity - integer :: pr + integer :: pr, i character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)' if (present(verbosity)) then @@ -288,7 +293,14 @@ subroutine info(self, unit, verbosity) write (unit, fmt) "- done", merge('YES', 'NO ', self%done) write (unit, fmt) "- update", merge('YES', 'NO ', self%update) - + + if (allocated(self%package_dep)) then + write(unit, fmt) " - package_dep " + do i = 1, size(self%package_dep) + write(unit, fmt) " - " // self%package_dep(i)%s + end do + end if + end subroutine info !> Add project dependencies, each depth level after each other. @@ -321,7 +333,7 @@ subroutine add_project(self, package, error) ! Resolve the root project call self%resolve(root, error) if (allocated(error)) return - + ! Add the root project dependencies (depth 1) call self%add(package, root, .true., error) if (allocated(error)) return @@ -346,6 +358,10 @@ subroutine add_project(self, package, error) if (allocated(error)) exit end do if (allocated(error)) return + + ! Resolve internal dependency graph and remove temporary package storage + call resolve_dependency_graph(self, package, error) + if (allocated(error)) return if (allocated(self%cache)) then call self%dump_cache(self%cache, error) @@ -354,6 +370,63 @@ subroutine add_project(self, package, error) end subroutine add_project + subroutine resolve_dependency_graph(self, main, error) + !> Instance of the dependency tree + class(dependency_tree_t), intent(inout) :: self + !> Main project configuration + type(package_config_t), intent(in) :: main + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: i,nit + integer, parameter :: MAXIT = 50 + logical, allocatable :: finished(:) + type(string_t), allocatable :: old_package_dep(:) + + if (self%ndep<1) then + call fatal_error(error, "Trying to compute the dependency graph of an empty tree") + return + end if + + nit = 0 + allocate(finished(self%ndep),source=.false.) + do while (.not.all(finished) .and. nit=MAXIT) call fatal_error(error, "Infinite loop detected computing the dependency graph") + + contains + + pure logical function all_alloc(this,that) + type(string_t), intent(in), allocatable :: this(:),that(:) + all_alloc = .false. + if (allocated(this).neqv.allocated(that)) return + if (.not.allocated(this)) then + all_alloc = .true. + else + if (size(this)/=size(that)) return + if (.not.(this==that)) return + all_alloc = .true. + end if + end function all_alloc + + end subroutine resolve_dependency_graph + !> Add a project and its dependencies to the dependency tree recursive subroutine add_project_dependencies(self, package, root, main, error) !> Instance of the dependency tree @@ -649,6 +722,7 @@ subroutine resolve_dependency(self, dependency, global_settings, root, error) call dependency%register(package, proj_dir, fetch, revision, error) if (allocated(error)) return + if (self%verbosity > 1) then write (self%unit, out_fmt) & @@ -658,7 +732,7 @@ subroutine resolve_dependency(self, dependency, global_settings, root, error) call self%add(package, proj_dir, .false., error) if (allocated(error)) return - + end subroutine resolve_dependency !> Get a dependency from the registry. Whether the dependency is fetched @@ -966,11 +1040,12 @@ pure function finished(self) end function finished !> Update dependency from project manifest - subroutine register(self, package, root, fetch, revision, error) + subroutine register(node, package, root, fetch, revision, error) !> Instance of the dependency node - class(dependency_node_t), intent(inout) :: self + class(dependency_node_t), intent(inout) :: node !> Package configuration data type(package_config_t), intent(in) :: package + !> Project has been fetched logical, intent(in) :: fetch !> Root directory of the project @@ -983,26 +1058,187 @@ subroutine register(self, package, root, fetch, revision, error) logical :: update update = .false. - if (self%name /= package%name) then + if (node%name /= package%name) then call fatal_error(error, "Dependency name '"//package%name// & - & "' found, but expected '"//self%name//"' instead") + & "' found, but expected '"//node%name//"' instead") + return end if - self%version = package%version - self%proj_dir = root + node%version = package%version + node%proj_dir = root - if (allocated(self%git) .and. present(revision)) then - self%revision = revision + if (allocated(node%git) .and. present(revision)) then + node%revision = revision if (.not. fetch) then ! Change in revision ID was checked already. Only update if ALL git information is missing - update = .not. allocated(self%git%url) + update = .not. allocated(node%git%url) end if end if + + if (update) node%update = update + node%done = .true. + + end subroutine register - if (update) self%update = update - self%done = .true. + !> Capture the list of "required" packages while the manifest is loaded. + !> This subroutine should be called during the "resolve" phase, i.e. when the whole + !> dependency tree has been built already + subroutine get_required_packages(tree, node_ID, error) + !> Instance of the dependency tree + class(dependency_tree_t), intent(inout) :: tree + !> Instance of the dependency node + integer, intent(in) :: node_ID + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: nreq,k,id + type(dependency_config_t), allocatable :: dependency(:) + type(package_config_t) :: manifest + logical :: required(tree%ndep),main + + associate(node => tree%dep(node_ID)) + + ! Is the main project + main = node_ID==1 + + ! Get manifest + call get_package_data(manifest, join_path(node%proj_dir,"fpm.toml"), error) + if (allocated(error)) return + + call get_package_dependencies(manifest, main, dependency) + nreq = size(dependency) + + ! Translate names -> indices + required = .false. + + do k = 1, nreq + + id = tree%find(dependency(k)%name) + if (id<=0) then + ! Shouldn't happen because tree already contains every dep + call fatal_error(error, "Internal error: "//trim(node%name)// & + & " cannot find resolved dependency "//trim(dependency(k)%name)//" in tree") + return + end if + + ! Recurse dependencies + call recurse_deps(tree, id, required) + + end do + + ! Recursed list + nreq = count(required) + if (allocated(node%package_dep)) deallocate(node%package_dep) + allocate(node%package_dep(nreq)) + k = 0 + do id=1,tree%ndep + if (.not.required(id)) cycle + k = k+1 + node%package_dep(k) = string_t(tree%dep(id)%name) + end do + + endassociate + + contains + + recursive subroutine recurse_deps(tree, id, required) + class(dependency_tree_t), intent(in) :: tree + integer, intent(in) :: id + logical, intent(inout) :: required(:) + + integer :: j,dep_id + + if (required(id)) return + + required(id) = .true. + if (allocated(tree%dep(id)%package_dep)) then + do j = 1, size(tree%dep(id)%package_dep) + dep_id = tree%find(tree%dep(id)%package_dep(j)%s) + call recurse_deps(tree, dep_id, required) + end do + end if + end subroutine recurse_deps + + end subroutine get_required_packages + + !> Build a correct topological link order for a given dependency node. + !> + !> This routine returns the list of dependencies required to build `root_id`, + !> sorted such that each dependency appears *before* any node that depends on it. + !> This is suitable for correct linker ordering: `-lA -lB` means B can use symbols from A. + !> + !> The returned list includes both the transitive dependencies and the node itself. + !> Example: if node 3 requires [5, 7, 9, 2] and 9 also requires 2, + !> then the result will ensure that 2 appears before 9, etc. + subroutine local_link_order(tree, root_id, order, error) + !> The full dependency graph + class(dependency_tree_t), intent(in) :: tree + !> Index of the node for which to compute link order (e.g., the target being linked) + integer, intent(in) :: root_id + !> Ordered list of dependency indices (subset of tree%dep(:)) in link-safe order + integer, allocatable, intent(out) :: order(:) + !> Optional fatal error if a cycle is detected (not expected) + type(error_t), allocatable, intent(out) :: error - end subroutine register + !> Track which nodes have been visited + logical, allocatable :: visited(:) + !> Work stack holding post-order DFS traversal + integer, allocatable :: stack(:) + !> Total number of nodes and current stack position + integer :: n, top + + n = tree%ndep + allocate(visited(n), source=.false.) + allocate(stack(n), source=0) + top = 0 + + !> Depth-First Search from root node + call dfs(root_id,visited,stack,top,error) + if (allocated(error)) return + + !> The final link order is the reverse of the DFS post-order + allocate(order(top)) + if (top>0) order(:) = stack(:top) + + contains + + !> Recursive depth-first search, post-order + recursive subroutine dfs(i,visited,stack,top,error) + integer, intent(in) :: i + logical, intent(inout) :: visited(:) + integer, intent(inout) :: stack(:),top + type(error_t), allocatable, intent(out) :: error + integer :: k, id + + if (.not.(i>0 .and. i<=tree%ndep)) then + call fatal_error(error,'package graph failed: invalid dependency ID') + return + end if + if (visited(i)) return + + visited(i) = .true. + + ! Visit all required dependencies before this node + if (allocated(tree%dep(i)%package_dep)) then + do k = 1, size(tree%dep(i)%package_dep) + id = tree%find(tree%dep(i)%package_dep(k)%s) + + if (.not.(id>0 .and. id<=tree%ndep)) then + call fatal_error(error,'package graph failed: cannot find '//tree%dep(i)%package_dep(k)%s) + return + end if + + call dfs(id, visited, stack, top, error) + if (allocated(error)) return + end do + end if + + ! Now that all dependencies are handled, record this node + top = top + 1 + stack(top) = i + end subroutine dfs + + end subroutine local_link_order !> Read dependency tree from file subroutine load_cache_from_file(self, file, error) @@ -1321,6 +1557,12 @@ logical function dependency_node_is_same(this,that) if (.not.(this%version==other%version)) return endif + if (allocated(this%package_dep).neqv.allocated(other%package_dep)) return + if (allocated(this%package_dep)) then + if (.not.size(this%package_dep)==size(other%package_dep)) return + if (.not.(this%package_dep==other%package_dep)) return + endif + class default ! Not the same type return @@ -1343,7 +1585,8 @@ subroutine node_dump_to_toml(self, table, error) !> Error handling type(error_t), allocatable, intent(out) :: error - integer :: ierr + integer :: i,n,ierr + type(toml_array), pointer :: array ! Dump parent class call self%dependency_config_t%dump_to_toml(table, error) @@ -1362,8 +1605,10 @@ subroutine node_dump_to_toml(self, table, error) call set_value(table, "update", self%update, error, 'dependency_node_t') if (allocated(error)) return call set_value(table, "cached", self%cached, error, 'dependency_node_t') - if (allocated(error)) return - + if (allocated(error)) return + call set_list(table, "package-dep",self%package_dep, error) + if (allocated(error)) return + end subroutine node_dump_to_toml !> Read dependency from toml table (no checks made at this stage) @@ -1380,7 +1625,8 @@ subroutine node_load_from_toml(self, table, error) !> Local variables character(len=:), allocatable :: version - integer :: ierr + integer :: ierr,i,n + type(toml_array), pointer :: array call destroy_dependency_node(self) @@ -1406,8 +1652,11 @@ subroutine node_load_from_toml(self, table, error) error%message = 'dependency_node_t: version error from TOML table - '//error%message return endif - end if - + end if + + call get_list(table,"package-dep",self%package_dep, error) + if (allocated(error)) return + end subroutine node_load_from_toml !> Destructor @@ -1422,6 +1671,7 @@ elemental subroutine destroy_dependency_node(self) deallocate(self%version,stat=ierr) deallocate(self%proj_dir,stat=ierr) deallocate(self%revision,stat=ierr) + deallocate(self%package_dep,stat=ierr) self%done = .false. self%update = .false. self%cached = .false. diff --git a/src/fpm/installer.f90 b/src/fpm/installer.f90 index 7cfc93e77b..cc7b7fdd96 100644 --- a/src/fpm/installer.f90 +++ b/src/fpm/installer.f90 @@ -5,8 +5,9 @@ !> to any directory within the prefix. module fpm_installer use, intrinsic :: iso_fortran_env, only : output_unit - use fpm_environment, only : get_os_type, os_is_unix + use fpm_environment, only : get_os_type, os_is_unix, OS_WINDOWS use fpm_error, only : error_t, fatal_error + use fpm_targets, only: build_target_t, FPM_TARGET_ARCHIVE, FPM_TARGET_SHARED, FPM_TARGET_NAME use fpm_filesystem, only : join_path, mkdir, exists, unix_path, windows_path, get_local_prefix implicit none @@ -193,12 +194,41 @@ end subroutine install_executable subroutine install_library(self, library, error) !> Instance of the installer class(installer_t), intent(inout) :: self - !> Path to the library - character(len=*), intent(in) :: library + !> Library target + type(build_target_t), intent(in) :: library !> Error handling type(error_t), allocatable, intent(out) :: error - - call self%install(library, self%libdir, error) + + character(:), allocatable :: def_file, implib_file + + select case (library%target_type) + case (FPM_TARGET_ARCHIVE) + call self%install(library%output_file, self%libdir, error) + case (FPM_TARGET_SHARED) + call self%install(library%output_file, self%libdir, error) + + ! Handle shared library side-files only on Windows + if (self%os==OS_WINDOWS) then + + ! Try both compiler-dependent import library names + implib_file = join_path(library%output_dir, library%package_name // ".dll.a") + if (exists(implib_file)) then + call self%install(implib_file, self%libdir, error) + if (allocated(error)) return + else + implib_file = join_path(library%output_dir, library%package_name // ".lib") + if (exists(implib_file)) call self%install(implib_file, self%libdir, error) + if (allocated(error)) return + endif + + end if + + case default + call fatal_error(error,"Installer error: "//library%package_name//" is a "// & + FPM_TARGET_NAME(library%target_type)//", not a library") + return + end select + end subroutine install_library !> Install a test program in its correct subdirectory diff --git a/src/fpm/manifest.f90 b/src/fpm/manifest.f90 index b85c25abe0..f3c0485168 100644 --- a/src/fpm/manifest.f90 +++ b/src/fpm/manifest.f90 @@ -24,6 +24,7 @@ module fpm_manifest private public :: get_package_data, default_executable, default_library, default_test + public :: get_package_dependencies public :: default_example public :: package_config_t, dependency_config_t, preprocess_config_t @@ -181,6 +182,106 @@ subroutine package_defaults(package, root, error) end if end subroutine package_defaults + + ! Return an array of all dependencies in the manifest + subroutine get_package_dependencies(package, main, deps) + + !> Parsed package meta data + type(package_config_t), intent(in) :: package + + !> Is the main project + logical, intent(in) :: main + + !> Unprocessed list of all dependencies listed in this manifest + type(dependency_config_t), allocatable, intent(out) :: deps(:) + + integer :: ndeps,k + + ndeps = 0 + if (allocated(package%dependency)) & + ndeps = ndeps + size(package%dependency) + + if (main) then + + if (allocated(package%dev_dependency)) & + ndeps = ndeps + size(package%dev_dependency) + + if (allocated(package%example)) then + do k = 1, size(package%example) + if (allocated(package%example(k)%dependency)) & + ndeps = ndeps + size(package%example(k)%dependency) + end do + end if + + if (allocated(package%executable)) then + do k = 1, size(package%executable) + if (allocated(package%executable(k)%dependency)) & + ndeps = ndeps + size(package%executable(k)%dependency) + end do + end if + + if (allocated(package%test)) then + do k = 1, size(package%test) + if (allocated(package%test(k)%dependency)) & + ndeps = ndeps + size(package%test(k)%dependency) + end do + end if + + endif + + allocate(deps(ndeps)) + + if (ndeps > 0) then + + ndeps = 0 + + if (allocated(package%dependency)) & + call collect(deps,ndeps,package%dependency) + + if (main) then + + if (allocated(package%dev_dependency)) & + call collect(deps,ndeps,package%dev_dependency) + + if (allocated(package%example)) then + do k = 1, size(package%example) + if (allocated(package%example(k)%dependency)) & + call collect(deps,ndeps,package%example(k)%dependency) + end do + end if + if (allocated(package%executable)) then + do k = 1, size(package%executable) + if (allocated(package%executable(k)%dependency)) & + call collect(deps,ndeps,package%executable(k)%dependency) + end do + end if + if (allocated(package%test)) then + do k = 1, size(package%test) + if (allocated(package%test(k)%dependency)) & + call collect(deps,ndeps,package%test(k)%dependency) + end do + end if + + endif + + endif + + contains + + ! Add dependencies to the list + pure subroutine collect(list, nreq, new_deps) + type(dependency_config_t), intent(inout) :: list(:) + integer, intent(inout) :: nreq + type(dependency_config_t), intent(in) :: new_deps(:) + + integer :: i + do i = 1, size(new_deps) + nreq = nreq + 1 + list(nreq) = new_deps(i) + end do + end subroutine collect + + end subroutine get_package_dependencies end module fpm_manifest diff --git a/src/fpm/manifest/library.f90 b/src/fpm/manifest/library.f90 index 81f9736bf4..e9e6201366 100644 --- a/src/fpm/manifest/library.f90 +++ b/src/fpm/manifest/library.f90 @@ -9,7 +9,7 @@ !>build-script = "file" !>``` module fpm_manifest_library - use fpm_error, only : error_t, syntax_error + use fpm_error, only : error_t, syntax_error, fatal_error use fpm_strings, only: string_t, string_cat, operator(==) use tomlf, only : toml_table, toml_key, toml_stat use fpm_toml, only : get_value, get_list, serializable_t, set_value, & @@ -31,6 +31,9 @@ module fpm_manifest_library !> Alternative build script to be invoked character(len=:), allocatable :: build_script + + !> Shared / Static / Monolithic library + character(:), allocatable :: lib_type contains @@ -41,6 +44,11 @@ module fpm_manifest_library procedure :: serializable_is_same => library_is_same procedure :: dump_to_toml procedure :: load_from_toml + + !> Check library types + procedure, non_overridable :: monolithic + procedure, non_overridable :: shared + procedure, non_overridable :: static end type library_config_t @@ -49,6 +57,44 @@ module fpm_manifest_library contains + !> Check if this is a shared library config + !> (full packages built as shared libs) + elemental logical function shared(self) + !> Instance of the library configuration + class(library_config_t), intent(in) :: self + + if (allocated(self%lib_type)) then + shared = self%lib_type == "shared" + else + shared = .false. + endif + + end function shared + + + !> Check if this is a static library config + !> (full packages built as static libs) + elemental logical function static(self) + !> Instance of the library configuration + class(library_config_t), intent(in) :: self + + if (allocated(self%lib_type)) then + static = self%lib_type == "static" + else + static = .false. + endif + end function static + + + !> Check if this is a monolithic library config + !> (single monolithic archive with all objects used by this project) + elemental logical function monolithic(self) + !> Instance of the library configuration + class(library_config_t), intent(in) :: self + + monolithic = .not.(static(self) .or. shared(self)) + end function monolithic + !> Construct a new library configuration from a TOML data structure subroutine new_library(self, table, error) @@ -61,6 +107,8 @@ subroutine new_library(self, table, error) !> Error handling type(error_t), allocatable, intent(out) :: error + + integer :: stat call check(table, error) if (allocated(error)) return @@ -70,16 +118,36 @@ subroutine new_library(self, table, error) return end if + if (has_list(table, "type")) then + call syntax_error(error, "Manifest key [library.type] does not allow list input") + return + end if + call get_value(table, "source-dir", self%source_dir, "src") call get_value(table, "build-script", self%build_script) call get_list(table, "include-dir", self%include_dir, error) if (allocated(error)) return - + + call get_value(table, "type", self%lib_type, "monolithic") + + select case(self%lib_type) + case("shared","static","monolithic") + ! OK + case default + call fatal_error(error,"Value of library.type cannot be '"//self%lib_type & + //"', choose shared/static/monolithic (default)") + return + end select + ! Set default value of include-dir if not found in manifest if (.not.allocated(self%include_dir)) then self%include_dir = [string_t("include")] end if + + if (.not.allocated(self%lib_type)) then + self%lib_type = "monolithic" + end if end subroutine new_library @@ -107,7 +175,7 @@ subroutine check(table, error) call syntax_error(error, "Key "//list(ikey)%key//" is not allowed in library") exit - case("source-dir", "include-dir", "build-script") + case("source-dir", "include-dir", "build-script", "type") continue end select @@ -146,6 +214,9 @@ subroutine info(self, unit, verbosity) if (allocated(self%include_dir)) then write(unit, fmt) "- include directory", string_cat(self%include_dir,",") end if + + write(unit, fmt) "- library type", self%lib_type + if (allocated(self%build_script)) then write(unit, fmt) "- custom build", self%build_script end if @@ -169,6 +240,10 @@ logical function library_is_same(this,that) if (allocated(this%build_script)) then if (.not.this%build_script==other%build_script) return end if + if (allocated(this%lib_type).neqv.allocated(other%lib_type)) return + if (allocated(this%lib_type)) then + if (.not.this%lib_type==other%lib_type) return + end if class default ! Not the same type return @@ -197,6 +272,8 @@ subroutine dump_to_toml(self, table, error) if (allocated(error)) return call set_list(table, "include-dir", self%include_dir, error) if (allocated(error)) return + call set_string(table, "type", self%lib_type, error, class_name) + if (allocated(error)) return end subroutine dump_to_toml @@ -217,6 +294,9 @@ subroutine load_from_toml(self, table, error) call get_value(table, "build-script", self%build_script) if (allocated(error)) return call get_list(table, "include-dir", self%include_dir, error) + if (allocated(error)) return + call get_value(table, "type", self%lib_type) + if (allocated(error)) return end subroutine load_from_toml diff --git a/src/fpm/manifest/package.f90 b/src/fpm/manifest/package.f90 index a7be263366..126cc591eb 100644 --- a/src/fpm/manifest/package.f90 +++ b/src/fpm/manifest/package.f90 @@ -641,7 +641,7 @@ subroutine dump_to_toml(self, table, error) !> Error handling type(error_t), allocatable, intent(out) :: error - integer :: ierr, ii + integer :: ii type(toml_table), pointer :: ptr,ptr_pkg character(30) :: unnamed character(128) :: profile_name @@ -898,7 +898,7 @@ subroutine load_from_toml(self, table, error) type(error_t), allocatable, intent(out) :: error type(toml_key), allocatable :: keys(:),pkg_keys(:) - integer :: ierr, ii, jj + integer :: ii, jj character(len=:), allocatable :: flag type(toml_table), pointer :: ptr,ptr_pkg diff --git a/src/fpm_backend.F90 b/src/fpm_backend.F90 index 784d140ecd..148742cc1a 100644 --- a/src/fpm_backend.F90 +++ b/src/fpm_backend.F90 @@ -34,7 +34,7 @@ module fpm_backend use fpm_strings, only: string_t, operator(.in.) use fpm_targets, only: build_target_t, build_target_ptr, FPM_TARGET_OBJECT, & FPM_TARGET_C_OBJECT, FPM_TARGET_ARCHIVE, FPM_TARGET_EXECUTABLE, & - FPM_TARGET_CPP_OBJECT + FPM_TARGET_CPP_OBJECT, FPM_TARGET_SHARED use fpm_backend_output use fpm_compile_commands, only: compile_command_table_t implicit none @@ -354,6 +354,11 @@ subroutine build_target(model,target,verbose,dry_run,table,stat) case (FPM_TARGET_ARCHIVE) call model%archiver%make_archive(target%output_file, target%link_objects, & & target%output_log_file, stat, dry_run) + + case (FPM_TARGET_SHARED) + + call model%compiler%link_shared(target%output_file, target%link_flags, & + & target%output_log_file, stat, dry_run) end select diff --git a/src/fpm_compiler.F90 b/src/fpm_compiler.F90 index 28dd1cdeda..8a2c00ea49 100644 --- a/src/fpm_compiler.F90 +++ b/src/fpm_compiler.F90 @@ -36,7 +36,8 @@ module fpm_compiler OS_SOLARIS, & OS_FREEBSD, & OS_OPENBSD, & - OS_UNKNOWN + OS_UNKNOWN, & + library_filename use fpm_filesystem, only: join_path, basename, get_temp_filename, delete_file, unix_path, & & getline, run use fpm_strings, only: split, string_cat, string_t, str_ends_with, str_begins_with_str, & @@ -46,7 +47,7 @@ module fpm_compiler use tomlf, only: toml_table use fpm_toml, only: serializable_t, set_string, set_value, toml_stat, get_value use fpm_compile_commands, only: compile_command_t, compile_command_table_t -use shlex_module, only: sh_split => split, ms_split +use shlex_module, only: sh_split => split, ms_split, quote => ms_quote implicit none public :: compiler_t, new_compiler, archiver_t, new_archiver, get_macros public :: append_clean_flags, append_clean_flags_array @@ -102,12 +103,16 @@ module fpm_compiler procedure :: get_feature_flag !> Get flags for the main linking command procedure :: get_main_flags + !> Get library export flags + procedure :: get_export_flags !> Compile a Fortran object procedure :: compile_fortran !> Compile a C object procedure :: compile_c !> Compile a CPP object procedure :: compile_cpp + !> Link a shared library + procedure :: link_shared !> Link executable procedure :: link => link_executable !> Check whether compiler is recognized @@ -119,6 +124,7 @@ module fpm_compiler !> Enumerate libraries, based on compiler and platform procedure :: enumerate_libraries + !> Serialization interface procedure :: serializable_is_same => compiler_is_same procedure :: dump_to_toml => compiler_dump @@ -266,12 +272,29 @@ function get_default_flags(self, release) result(flags) logical, intent(in) :: release character(len=:), allocatable :: flags + character(len=:), allocatable :: pic_flag + if (release) then call get_release_compile_flags(self%id, flags) else call get_debug_compile_flags(self%id, flags) end if + ! Append position-independent code (PIC) flag, that is necessary + ! building shared libraries + select case (self%id) + case (id_gcc, id_f95, id_caf, id_flang, id_flang_new, id_f18, id_lfortran, & + id_intel_classic_nix, id_intel_classic_mac, id_intel_llvm_nix, & + id_pgi, id_nvhpc, id_nag, id_cray, id_ibmxl) + pic_flag = " -fPIC" + case (id_intel_classic_windows, id_intel_llvm_windows) + pic_flag = "" ! Windows does not use -fPIC + case default + pic_flag = " -fPIC" ! Conservative fallback + end select + + flags = flags // pic_flag + end function get_default_flags subroutine get_release_compile_flags(id, flags) @@ -614,6 +637,30 @@ function get_module_flag(self, path) result(flags) end function get_module_flag +function get_shared_flag(self) result(shared_flag) + class(compiler_t), intent(in) :: self + character(len=:), allocatable :: shared_flag + + select case (self%id) + case default + shared_flag = "-shared" + case (id_gcc, id_f95, id_flang, id_flang_new, id_lfortran) + shared_flag = "-shared" + case (id_intel_classic_nix, id_intel_llvm_nix, id_pgi, id_nvhpc) + shared_flag = "-shared" + case (id_intel_classic_windows, id_intel_llvm_windows) + shared_flag = "/DLL" + case (id_nag) + shared_flag = "-Wl,-shared" + case (id_ibmxl) + shared_flag = "-qmkshrobj" + case (id_cray, id_lahey) + shared_flag = "" ! Needs special handling + end select + +end function get_shared_flag + + function get_feature_flag(self, feature) result(flags) class(compiler_t), intent(in) :: self character(len=*), intent(in) :: feature @@ -998,14 +1045,77 @@ function enumerate_libraries(self, prefix, libs) result(r) type(string_t), intent(in) :: libs(:) character(len=:), allocatable :: r - if (self%id == id_intel_classic_windows .or. & - self%id == id_intel_llvm_windows) then - r = prefix // " " // string_cat(libs,".lib ")//".lib" - else - r = prefix // " -l" // string_cat(libs," -l") + character(len=:), allocatable :: joined + + if (size(libs) == 0) then + r = prefix + return end if + + select case (self%id) + + case (id_intel_classic_windows, id_intel_llvm_windows) + ! Windows Intel uses `.lib` files directly + joined = string_cat(libs, ".lib ") // ".lib" + r = trim(prefix) // " " // trim(joined) + + case (id_nag, id_ibmxl) + ! NAG and IBMXL need -Wl, wrapper around linker flags + joined = string_cat(libs, " -Wl,") + r = trim(prefix) // " -Wl," // trim(joined) + + case default + ! Generic Unix-style linker flags: use `-lfoo` + joined = string_cat(libs, " -l") + r = trim(prefix) // " -l" // trim(joined) + + end select + end function enumerate_libraries +!> +!> Generate library export flags for a shared library build +!> +function get_export_flags(self, target_dir, target_name) result(export_flags) + !> Instance of the compiler + class(compiler_t), intent(in) :: self + !> Path and package name + character(len=*), intent(in) :: target_dir, target_name + character(len=:), allocatable :: export_flags + + character(len=:), allocatable :: implib_path, def_path + + ! Only apply on Windows + if (get_os_type() /= OS_WINDOWS) then + export_flags = "" + return + end if + + select case (self%id) + + case (id_gcc, id_caf, id_f95) + ! GNU-based: emit both import library and def file + implib_path = quote(join_path(target_dir, target_name // ".dll.a") , for_cmd=.true.) + def_path = quote(join_path(target_dir, target_name // ".def" ) , for_cmd=.true.) + + export_flags = " -Wl,--out-implib," // implib_path // & + " -Wl,--output-def," // def_path + + case (id_intel_classic_windows, id_intel_llvm_windows) + ! Intel/MSVC-style + implib_path = quote(join_path(target_dir, target_name // ".lib") , for_cmd=.true.) + def_path = quote(join_path(target_dir, target_name // ".def") , for_cmd=.true.) + + export_flags = " /IMPLIB:" // implib_path // & + " /DEF:" // def_path + + case default + + export_flags = "" ! Do nothing elsewhere + + end select + +end function get_export_flags !> Create new compiler instance subroutine new_compiler(self, fc, cc, cxx, echo, verbose) @@ -1267,6 +1377,38 @@ subroutine link_executable(self, output, args, log_file, stat, dry_run) end subroutine link_executable +!> Link a shared library +subroutine link_shared(self, output, args, log_file, stat, dry_run) + !> Instance of the compiler object + class(compiler_t), intent(in) :: self + !> Output file of shared library object + character(len=*), intent(in) :: output + !> Arguments for the compiler + character(len=*), 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 + logical :: mock + character(len=:), allocatable :: shared_flag + + mock = .false. + if (present(dry_run)) mock = dry_run + + shared_flag = get_shared_flag(self) + + command = self%fc // " " // shared_flag // " " // args // " -o " // output + + if (.not.mock) & + call run(command, echo=self%echo, verbose=self%verbose, redirect=log_file, exitstat=stat) + +end subroutine link_shared + + !> Create an archive !> @todo For Windows OS, use the local `delete_file_win32` in stead of `delete_file`. !> This may be related to a bug in Mingw64-openmp and is expected to be resolved in the future, diff --git a/src/fpm_environment.f90 b/src/fpm_environment.f90 index cea8a633e5..02bd3e32b0 100644 --- a/src/fpm_environment.f90 +++ b/src/fpm_environment.f90 @@ -17,8 +17,8 @@ module fpm_environment public :: delete_env public :: get_command_arguments_quoted public :: separator + public :: library_filename - public :: OS_NAME integer, parameter, public :: OS_UNKNOWN = 0 integer, parameter, public :: OS_LINUX = 1 @@ -30,6 +30,40 @@ module fpm_environment integer, parameter, public :: OS_OPENBSD = 7 contains + !> Utility function: return library filename + pure function library_filename(package_name, shared, import, target_os) result(name) + character(*), intent(in) :: package_name + !> Whether it's a shared library + logical, intent(in) :: shared + !> Whether it's for linking (import library) or actual library + logical, intent(in) :: import + !> Build target OS: one of OS_WINDOWS, OS_MACOS, ... + integer, intent(in) :: target_os + + character(len=:), allocatable :: name + + if (shared) then + select case (target_os) + case (OS_WINDOWS) + if (import) then + ! Linking requires the import library + name = 'lib' // package_name // '.lib' + else + ! The actual shared object is a DLL + name = 'lib' // package_name // '.dll' + end if + case (OS_MACOS) + name = 'lib' // package_name // '.dylib' + case default + name = 'lib' // package_name // '.so' + end select + else + ! Static library (same for all platforms) + name = 'lib' // package_name // '.a' + end if + + end function library_filename + !> Return string describing the OS type flag pure function OS_NAME(os) integer, intent(in) :: os @@ -375,6 +409,7 @@ end function c_setenv end interface !> Overwrite setting + cerr = 0_c_int can_overwrite = .true. if (present(overwrite)) can_overwrite = overwrite cover = merge(1_c_int,0_c_int,can_overwrite) diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index 12f16ce8a8..cda4654f34 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -43,6 +43,7 @@ module fpm_model use fpm_toml, only: serializable_t, set_value, set_list, get_value, & & get_list, add_table, toml_key, add_array, set_string use fpm_error, only: error_t, fatal_error +use fpm_environment, only: OS_WINDOWS,OS_MACOS use fpm_manifest_preprocess, only: preprocess_config_t implicit none @@ -172,7 +173,10 @@ module fpm_model type(fortran_features_t) :: features contains - + + !> Check if a package will create a library + procedure :: has_library => package_has_library + !> Serialization interface procedure :: serializable_is_same => package_is_same procedure :: dump_to_toml => package_dump_to_toml @@ -234,7 +238,10 @@ module fpm_model type(string_t) :: module_prefix contains - + + !> Get target link flags + procedure :: get_package_libraries_link + !> Serialization interface procedure :: serializable_is_same => model_is_same procedure :: dump_to_toml => model_dump_to_toml @@ -244,7 +251,6 @@ module fpm_model contains - function info_package(p) result(s) ! Returns representation of package_t type(package_t), intent(in) :: p @@ -1136,4 +1142,80 @@ subroutine model_load_from_toml(self, table, error) end subroutine model_load_from_toml +function get_package_libraries_link(model, package_name, prefix, exclude_self, dep_IDs, error) result(r) + class(fpm_model_t), intent(in) :: model + character(*), intent(in) :: package_name + type(error_t), allocatable, intent(out) :: error + character(*), intent(in) :: prefix + !> Option to exclude linking to the given package (needed building it as a library) + logical, optional, intent(in) :: exclude_self + !> Optionally export the list of dependency IDs + integer, allocatable, optional, intent(out) :: dep_IDs(:) + character(len=:), allocatable :: r + + integer :: id,ndep,i + logical :: no_root + integer, allocatable :: sorted_package_IDs(:) + logical, allocatable :: has_lib(:) + type(string_t), allocatable :: package_deps(:) + + ! Get dependency ID of this target + id = model%deps%find(package_name) + if (id<=0) then + call fatal_error(error, "Internal error: shared library "//package_name// & + " does not correspond to a package") + return + end if + + ! Get ordered IDs of the shared libraries that should be linked against + call model%deps%local_link_order(id, sorted_package_IDs, error) + if (allocated(error)) return + + ! Get names of the package dependencies + ndep = size(sorted_package_IDs) + + if (ndep<=0) then + r = prefix + if (present(dep_IDs)) allocate(dep_IDs(0)) + return + end if + + ! Optional exclusion of self (top-level) package + no_root = .false. + if (present(exclude_self)) no_root = exclude_self + if (no_root) then + sorted_package_IDs = pack(sorted_package_IDs, sorted_package_IDs /= id) + ndep = size(sorted_package_IDs) + endif + + ! Exclusion of package IDs marked "empty" (i.e. they contain no sources) + has_lib = model%packages%has_library() + + if (any(.not.has_lib)) then + sorted_package_IDs = pack(sorted_package_IDs, has_lib(sorted_package_IDs)) + ndep = size(sorted_package_IDs) + end if + + package_deps = [(string_t(model%deps%dep(sorted_package_IDs(i))%name),i=1,ndep)] + + r = model%compiler%enumerate_libraries(prefix, package_deps) + + ! If requested, export the list of dependency IDs + if (present(dep_IDs)) call move_alloc(from=sorted_package_IDs,to=dep_IDs) + +end function get_package_libraries_link + +!> Check whether a package has an object library +elemental logical function package_has_library(self) result(has_library) + class(package_t), intent(in) :: self + + if (allocated(self%sources)) then + has_library = any(self%sources%unit_scope==FPM_SCOPE_LIB) + else + has_library = .false. + end if + +end function package_has_library + + end module fpm_model diff --git a/src/fpm_source_parsing.f90 b/src/fpm_source_parsing.f90 index 4032292006..5d119281c7 100644 --- a/src/fpm_source_parsing.f90 +++ b/src/fpm_source_parsing.f90 @@ -21,8 +21,7 @@ module fpm_source_parsing FPM_UNIT_UNKNOWN, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, & FPM_UNIT_CSOURCE, FPM_UNIT_CHEADER, FPM_SCOPE_UNKNOWN, & - FPM_SCOPE_LIB, FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST, & - FPM_UNIT_CPPSOURCE + FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST, FPM_UNIT_CPPSOURCE use fpm_filesystem, only: read_lines, read_lines_expanded, exists implicit none diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index 24b746b439..4e09441f23 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -24,27 +24,28 @@ !> Describes the type of build target — determines backend build rules !> module fpm_targets -use iso_fortran_env, only: int64 +use iso_fortran_env, only: int64, stdout=>output_unit use fpm_error, only: error_t, fatal_error, fpm_stop use fpm_model use fpm_compiler, only : compiler_t -use fpm_environment, only: get_os_type, OS_WINDOWS, OS_MACOS +use fpm_environment, only: get_os_type, OS_WINDOWS, OS_MACOS, library_filename use fpm_filesystem, only: dirname, join_path, canon_path use fpm_strings, only: string_t, operator(.in.), string_cat, fnv_1a, resize, lower, str_ends_with use fpm_compiler, only: get_macros use fpm_sources, only: get_exe_name_with_suffix +use fpm_manifest_library, only: library_config_t use fpm_manifest_preprocess, only: preprocess_config_t implicit none private -public FPM_TARGET_UNKNOWN, FPM_TARGET_EXECUTABLE, & - FPM_TARGET_ARCHIVE, FPM_TARGET_OBJECT, & +public FPM_TARGET_UNKNOWN, FPM_TARGET_EXECUTABLE, & + FPM_TARGET_ARCHIVE, FPM_TARGET_OBJECT, & FPM_TARGET_C_OBJECT, FPM_TARGET_CPP_OBJECT, & - FPM_TARGET_NAME + FPM_TARGET_SHARED, FPM_TARGET_NAME public build_target_t, build_target_ptr public targets_from_sources, resolve_module_dependencies -public add_target, add_dependency +public add_target, new_target, add_dependency, get_library_dirs public filter_library_targets, filter_executable_targets, filter_modules @@ -61,6 +62,8 @@ module fpm_targets integer, parameter :: FPM_TARGET_C_OBJECT = 4 !> Target type is cpp compiled object integer, parameter :: FPM_TARGET_CPP_OBJECT = 5 +!> Target type is a shared library +integer, parameter :: FPM_TARGET_SHARED = 6 !> Wrapper type for constructing arrays of `[[build_target_t]]` pointers type build_target_ptr @@ -135,10 +138,21 @@ module fpm_targets contains + !> Print information on this instance + procedure :: info + + !> Set output directory + procedure :: set_output_dir + procedure :: is_executable_target end type build_target_t +interface add_target + module procedure add_new_target + module procedure add_old_target + module procedure add_old_targets +end interface contains @@ -149,42 +163,122 @@ pure function FPM_TARGET_NAME(type) result(msg) select case (type) case (FPM_TARGET_ARCHIVE); msg = 'Archive' + case (FPM_TARGET_SHARED); msg = 'Shared library' case (FPM_TARGET_CPP_OBJECT); msg = 'C++ object' case (FPM_TARGET_C_OBJECT); msg = 'C Object' case (FPM_TARGET_EXECUTABLE); msg = 'Executable' - case (FPM_TARGET_OBJECT); msg = 'Object' + case (FPM_TARGET_OBJECT); msg = 'Object' case default; msg = 'Unknown' end select end function FPM_TARGET_NAME +!> Write information on a build target +subroutine info(self, unit, verbosity) + class(build_target_t), intent(in) :: self + integer, intent(in) :: unit + integer, intent(in), optional :: verbosity + + integer :: pr + character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)' + character(len=*), parameter :: fmt_list = '("#", 1x, a, t30, a, " (", i0, " items)")' + + if (present(verbosity)) then + pr = verbosity + else + pr = 1 + end if + if (pr < 1) return + + write(unit, fmt) "Build target" + write(unit, fmt) "- output file", self%output_file + write(unit, fmt) "- output name", self%output_name + write(unit, fmt) "- output directory", self%output_dir + write(unit, fmt) "- log file", self%output_log_file + write(unit, fmt) "- package", self%package_name + write(unit, fmt) "- type", FPM_TARGET_NAME(self%target_type) + + if (allocated(self%source)) then + write(unit, fmt) "- source file", self%source%file_name + end if + + if (allocated(self%dependencies)) then + write(unit, fmt_list) "- dependencies", "", size(self%dependencies) + end if + + if (allocated(self%link_objects)) then + write(unit, fmt_list) "- link objects", "", size(self%link_objects) + end if + + if (allocated(self%link_libraries)) then + write(unit, fmt_list) "- link libraries", "", size(self%link_libraries) + end if + + if (allocated(self%compile_flags)) then + write(unit, fmt) "- compile flags", self%compile_flags + end if + + if (allocated(self%link_flags)) then + write(unit, fmt) "- link flags", self%link_flags + end if + + if (allocated(self%version)) then + write(unit, fmt) "- version", self%version + end if + + if (allocated(self%macros)) then + write(unit, fmt_list) "- macros", "", size(self%macros) + end if + + write(unit, fmt) "- skip", merge("yes", "no ", self%skip) + write(unit, fmt) "- schedule", trim(adjustl(to_string(self%schedule))) + +contains + + pure function to_string(i) result(s) + integer, intent(in) :: i + character(len=32) :: s + write(s, '(i0)') i + end function to_string + +end subroutine info + !> High-level wrapper to generate build target information -subroutine targets_from_sources(targets,model,prune,error) +subroutine targets_from_sources(targets,model,prune,library,error) !> The generated list of build targets type(build_target_ptr), intent(out), allocatable :: targets(:) !> The package model from which to construct the target list type(fpm_model_t), intent(inout), target :: model + + !> Library build configuration + type(library_config_t), intent(in), optional :: library !> Enable tree-shaking/pruning of module dependencies logical, intent(in) :: prune !> Error structure type(error_t), intent(out), allocatable :: error + + logical :: should_prune - call build_target_list(targets,model) + call build_target_list(targets,model,library) call collect_exe_link_dependencies(targets) call resolve_module_dependencies(targets,model%external_modules,error) if (allocated(error)) return - if (prune) then - call prune_build_targets(targets,root_package=model%package_name) - end if + ! Prune unused source files, unless we're building shared libraries that need + ! all sources to be distributable + should_prune = prune + if (present(library)) should_prune = should_prune .and. library%monolithic() + + call prune_build_targets(targets,model%packages(1),should_prune) - call resolve_target_linking(targets,model) + call resolve_target_linking(targets,model,library,error) + if (allocated(error)) return end subroutine targets_from_sources @@ -208,17 +302,20 @@ end subroutine targets_from_sources !> is a library, then the executable target has an additional dependency on the library !> archive target. !> -subroutine build_target_list(targets,model) +subroutine build_target_list(targets,model,library) !> The generated list of build targets type(build_target_ptr), intent(out), allocatable :: targets(:) !> The package model from which to construct the target list type(fpm_model_t), intent(inout), target :: model + + !> The optional model library configuration + type(library_config_t), optional, intent(in) :: library - integer :: i, j, n_source, exe_type - character(:), allocatable :: exe_dir, compile_flags - logical :: with_lib + integer :: i, j, k, n_source, exe_type + character(:), allocatable :: exe_dir, compile_flags, lib_name + logical :: with_lib, monolithic, shared_lib, static_lib ! Initialize targets allocate(targets(0)) @@ -229,14 +326,44 @@ subroutine build_target_list(targets,model) if (n_source < 1) return - with_lib = any([((model%packages(j)%sources(i)%unit_scope == FPM_SCOPE_LIB, & - i=1,size(model%packages(j)%sources)), & - j=1,size(model%packages))]) - - if (with_lib) call add_target(targets,package=model%package_name,type = FPM_TARGET_ARCHIVE,& - output_name = join_path(& - model%package_name,'lib'//model%package_name//'.a')) + with_lib = any(model%packages%has_library()) + + if (with_lib .and. present(library)) then + shared_lib = library%shared() + static_lib = library%static() + monolithic = library%monolithic() + else + monolithic = with_lib + shared_lib = .false. + static_lib = .false. + end if + ! For a static object archive, everything from this package or all its dependencies is + ! put into the same file. For a shared library configuration, each package has its own + ! dynamic library file to avoid dependency collisions + if (monolithic) then + + lib_name = join_path(model%package_name, & + library_filename(model%packages(1)%name,.false.,.false.,get_os_type())) + + call add_target(targets,package=model%package_name, & + type = FPM_TARGET_ARCHIVE,output_name = lib_name) + + elseif (shared_lib .or. static_lib) then + + ! Individual package libraries are built. + ! Create as many targets as the packages in the dependency tree + do j=1,size(model%packages) + + lib_name = library_filename(model%packages(j)%name,shared_lib,.false.,get_os_type()) + + call add_target(targets,package=model%packages(j)%name, & + type=merge(FPM_TARGET_SHARED,FPM_TARGET_ARCHIVE,shared_lib), & + output_name=lib_name) + end do + + endif + do j=1,size(model%packages) associate(sources=>model%packages(j)%sources) @@ -249,19 +376,19 @@ subroutine build_target_list(targets,model) select case (sources(i)%unit_type) case (FPM_UNIT_MODULE,FPM_UNIT_SUBMODULE,FPM_UNIT_SUBPROGRAM,FPM_UNIT_CSOURCE) - + call add_target(targets,package=model%packages(j)%name,source = sources(i), & type = merge(FPM_TARGET_C_OBJECT,FPM_TARGET_OBJECT,& sources(i)%unit_type==FPM_UNIT_CSOURCE), & output_name = get_object_name(sources(i)), & - features = model%packages(j)%features, & - preprocess = model%packages(j)%preprocess, & + features = model%packages(j)%features, & + preprocess = model%packages(j)%preprocess, & version = model%packages(j)%version) if (with_lib .and. sources(i)%unit_scope == FPM_SCOPE_LIB) then ! Archive depends on object - call add_dependency(targets(1)%ptr, targets(size(targets))%ptr) + call add_dependency(targets(merge(1,j,monolithic))%ptr, targets(size(targets))%ptr) end if case (FPM_UNIT_CPPSOURCE) @@ -274,7 +401,7 @@ subroutine build_target_list(targets,model) if (with_lib .and. sources(i)%unit_scope == FPM_SCOPE_LIB) then ! Archive depends on object - call add_dependency(targets(1)%ptr, targets(size(targets))%ptr) + call add_dependency(targets(merge(1,j,monolithic))%ptr, targets(size(targets))%ptr) end if !> Add stdc++ as a linker flag. If not already there. @@ -340,8 +467,10 @@ subroutine build_target_list(targets,model) call add_dependency(target, targets(size(targets)-1)%ptr) if (with_lib) then - ! Executable depends on library - call add_dependency(target, targets(1)%ptr) + ! Executable depends on library file(s) + do k=1,merge(1,size(model%packages),monolithic) + call add_dependency(target, targets(k)%ptr) + end do end if endassociate @@ -432,10 +561,44 @@ subroutine collect_exe_link_dependencies(targets) end subroutine collect_exe_link_dependencies +!> Allocate a new target +type(build_target_ptr) function new_target(package, type, output_name, source, link_libraries, & + & features, preprocess, version, output_dir) + character(*), intent(in) :: package + integer, intent(in) :: type + character(*), intent(in) :: output_name + type(srcfile_t), intent(in), optional :: source + type(string_t), intent(in), optional :: link_libraries(:) + type(fortran_features_t), intent(in), optional :: features + type(preprocess_config_t), intent(in), optional :: preprocess + character(*), intent(in), optional :: version + character(*), intent(in), optional :: output_dir + + allocate(new_target%ptr) + + associate(target=>new_target%ptr) + + target%target_type = type + target%output_name = output_name + target%package_name = package + if (present(source)) target%source = source + if (present(link_libraries)) target%link_libraries = link_libraries + if (present(features)) target%features = features + if (present(preprocess)) then + if (allocated(preprocess%macros)) target%macros = preprocess%macros + endif + if (present(version)) target%version = version + allocate(target%dependencies(0)) + + call target%set_output_dir(output_dir) + + endassociate + +end function new_target !> Allocate a new target and append to target list -subroutine add_target(targets, package, type, output_name, source, link_libraries, & - & features, preprocess, version) +subroutine add_new_target(targets, package, type, output_name, source, link_libraries, & + & features, preprocess, version, output_dir) type(build_target_ptr), allocatable, intent(inout) :: targets(:) character(*), intent(in) :: package integer, intent(in) :: type @@ -445,43 +608,57 @@ subroutine add_target(targets, package, type, output_name, source, link_librarie type(fortran_features_t), intent(in), optional :: features type(preprocess_config_t), intent(in), optional :: preprocess character(*), intent(in), optional :: version + character(*), intent(in), optional :: output_dir - integer :: i - type(build_target_t), pointer :: new_target + type(build_target_ptr) :: added if (.not.allocated(targets)) allocate(targets(0)) + + ! Create new target + added = new_target(package,type,output_name,source,link_libraries,features,preprocess,& + version,output_dir) - ! Check for duplicate outputs - do i=1,size(targets) + call add_old_target(targets, added) - if (targets(i)%ptr%output_name == output_name) then +end subroutine add_new_target - write(*,*) 'Error while building target list: duplicate output object "',& - output_name,'"' - if (present(source)) write(*,*) ' Source file: "',source%file_name,'"' - call fpm_stop(1,' ') +subroutine add_old_targets(targets, add_targets) + type(build_target_ptr), allocatable, intent(inout) :: targets(:) + type(build_target_ptr), intent(in) :: add_targets(:) - end if + integer :: i,j - end do + if (.not.allocated(targets)) allocate(targets(0)) + + ! Check for duplicate outputs + do j=1,size(add_targets) + associate(added=>add_targets(j)%ptr) - allocate(new_target) - new_target%target_type = type - new_target%output_name = output_name - new_target%package_name = package - if (present(source)) new_target%source = source - if (present(link_libraries)) new_target%link_libraries = link_libraries - if (present(features)) new_target%features = features - if (present(preprocess)) then - if (allocated(preprocess%macros)) new_target%macros = preprocess%macros - endif - if (present(version)) new_target%version = version - allocate(new_target%dependencies(0)) + do i=1,size(targets) + + if (targets(i)%ptr%output_name == added%output_name) then + + write(*,*) 'Error while building target list: duplicate output object "',& + added%output_name,'"' + if (allocated(added%source)) write(*,*) ' Source file: "',added%source%file_name,'"' + call fpm_stop(1,' ') - targets = [targets, build_target_ptr(new_target)] + end if + + end do + + endassociate + end do + + targets = [targets, add_targets ] -end subroutine add_target +end subroutine add_old_targets +subroutine add_old_target(targets, add_target) + type(build_target_ptr), allocatable, intent(inout) :: targets(:) + type(build_target_ptr), intent(in) :: add_target + call add_old_targets(targets, [add_target]) +end subroutine add_old_target !> Add pointer to dependeny in target%dependencies subroutine add_dependency(target, dependency) @@ -610,13 +787,16 @@ end function find_module_dependency !> Perform tree-shaking to remove unused module targets -subroutine prune_build_targets(targets, root_package) +subroutine prune_build_targets(targets, root_package, prune_unused_objects) !> Build target list to prune type(build_target_ptr), intent(inout), allocatable :: targets(:) - !> Name of root package - character(*), intent(in) :: root_package + !> Root package + type(package_t), intent(in) :: root_package + + !> Whether unused objects should be pruned + logical, intent(in) :: prune_unused_objects integer :: i, j, nexec type(string_t), allocatable :: modules_used(:) @@ -656,8 +836,8 @@ subroutine prune_build_targets(targets, root_package) do i=1,size(targets) - if (targets(i)%ptr%package_name == root_package .and. & - targets(i)%ptr%target_type /= FPM_TARGET_ARCHIVE) then + if (targets(i)%ptr%package_name == root_package%name .and. & + all(targets(i)%ptr%target_type /= [FPM_TARGET_ARCHIVE,FPM_TARGET_SHARED])) then call collect_used_modules(targets(i)%ptr) @@ -668,8 +848,8 @@ subroutine prune_build_targets(targets, root_package) end if call reset_target_flags(targets) - - exclude_target(:) = .false. + + exclude_target = .false. ! Exclude purely module targets if they are not used anywhere do i=1,size(targets) @@ -678,8 +858,8 @@ subroutine prune_build_targets(targets, root_package) if (allocated(target%source)) then if (target%source%unit_type == FPM_UNIT_MODULE) then - exclude_target(i) = .true. - target%skip = .true. + exclude_target(i) = prune_unused_objects + target%skip = prune_unused_objects do j=1,size(target%source%modules_provided) @@ -695,8 +875,8 @@ subroutine prune_build_targets(targets, root_package) elseif (target%source%unit_type == FPM_UNIT_SUBMODULE) then ! Remove submodules if their parents are not used - exclude_target(i) = .true. - target%skip = .true. + exclude_target(i) = prune_unused_objects + target%skip = prune_unused_objects do j=1,size(target%source%parent_modules) if (target%source%parent_modules(j)%s .in. modules_used) then @@ -709,40 +889,55 @@ subroutine prune_build_targets(targets, root_package) end do end if + + elseif (any(target%target_type == [FPM_TARGET_ARCHIVE,FPM_TARGET_SHARED])) then + + ! Remove empty library files + if (size(target%dependencies)==0) then + exclude_target(i) = .true. + target%skip = .true. + endif + end if - ! (If there aren't any executables then we only prune modules from dependencies) - if (nexec < 1 .and. target%package_name == root_package) then - exclude_target(i) = .false. - target%skip = .false. + ! (If there aren't any executables then we only prune modules from dependencies, + ! unless the root package is also empty) + if (nexec < 1 .and. target%package_name == root_package%name) then + exclude_target(i) = .not.root_package%has_library() + target%skip = exclude_target(i) end if - + end associate end do targets = pack(targets,.not.exclude_target) - ! Remove unused targets from archive dependency list - if (targets(1)%ptr%target_type == FPM_TARGET_ARCHIVE) then - associate(archive=>targets(1)%ptr) + ! Remove unused targets from library dependency list + do j=1,size(targets) + associate(archive=>targets(j)%ptr) + + if (any(archive%target_type==[FPM_TARGET_ARCHIVE,FPM_TARGET_OBJECT])) then - allocate(exclude_from_archive(size(archive%dependencies))) - exclude_from_archive(:) = .false. + allocate(exclude_from_archive(size(archive%dependencies)),source=.false.) - do i=1,size(archive%dependencies) + do i=1,size(archive%dependencies) - if (archive%dependencies(i)%ptr%skip) then + if (archive%dependencies(i)%ptr%skip) then - exclude_from_archive(i) = .true. + exclude_from_archive(i) = .true. - end if + end if - end do + end do - archive%dependencies = pack(archive%dependencies,.not.exclude_from_archive) + archive%dependencies = pack(archive%dependencies,.not.exclude_from_archive) + + deallocate(exclude_from_archive) + + endif end associate - end if + end do contains @@ -814,13 +1009,17 @@ end subroutine prune_build_targets !> Construct the linker flags string for each target !> `target%link_flags` includes non-library objects and library flags !> -subroutine resolve_target_linking(targets, model) +subroutine resolve_target_linking(targets, model, library, error) type(build_target_ptr), intent(inout), target :: targets(:) type(fpm_model_t), intent(in) :: model + type(library_config_t), intent(in), optional :: library + type(error_t), allocatable, intent(out) :: error - integer :: i + integer :: i,j + logical :: shared,static,monolithic,has_self_lib + integer, allocatable :: package_deps(:),dep_target_ID(:) character(:), allocatable :: global_link_flags, local_link_flags - character(:), allocatable :: global_include_flags + character(:), allocatable :: global_include_flags, shared_lib_paths if (size(targets) == 0) return @@ -830,15 +1029,25 @@ subroutine resolve_target_linking(targets, model) global_link_flags = model%compiler%enumerate_libraries(global_link_flags, model%link_libraries) end if end if - + allocate(character(0) :: global_include_flags) if (allocated(model%include_dirs)) then if (size(model%include_dirs) > 0) then global_include_flags = global_include_flags // & & " -I" // string_cat(model%include_dirs," -I") end if + end if + + if (present(library)) then + shared = library%shared() + static = library%static() + monolithic = library%monolithic() + else + shared = .false. + static = .false. + monolithic = .true. end if - + do i=1,size(targets) associate(target => targets(i)%ptr) @@ -868,54 +1077,123 @@ subroutine resolve_target_linking(targets, model) if (len(global_include_flags) > 0) then target%compile_flags = target%compile_flags//global_include_flags end if - target%output_dir = get_output_dir(model%build_prefix, target%compile_flags) - target%output_file = join_path(target%output_dir, target%output_name) - target%output_log_file = join_path(target%output_dir, target%output_name)//'.log' + + call target%set_output_dir(get_output_dir(model%build_prefix, target%compile_flags)) + end associate end do - + call add_include_build_dirs(model, targets) - + call add_library_link_dirs(model, targets, shared_lib_paths) + call library_targets_to_deps(model, targets, dep_target_ID) + do i=1,size(targets) associate(target => targets(i)%ptr) allocate(target%link_objects(0)) - if (target%target_type == FPM_TARGET_ARCHIVE) then - global_link_flags = target%output_file // global_link_flags - - call get_link_objects(target%link_objects,target,is_exe=.false.) - - allocate(character(0) :: target%link_flags) - - else if (target%target_type == FPM_TARGET_EXECUTABLE) then - - call get_link_objects(target%link_objects,target,is_exe=.true.) - - local_link_flags = "" - if (allocated(model%link_flags)) local_link_flags = model%link_flags - target%link_flags = model%link_flags//" "//string_cat(target%link_objects," ") + select case (target%target_type) + case (FPM_TARGET_ARCHIVE) + + ! This adds the monolithic archive to the link flags + if (monolithic) global_link_flags = " " // target%output_file // global_link_flags + + call get_link_objects(target%link_objects,target,is_exe=.false.) + + allocate(character(0) :: target%link_flags) + + case (FPM_TARGET_SHARED) + + ! Gather object files from this package only + call get_link_objects(target%link_objects, target, is_exe=.false.) + + ! Build link flags + target%link_flags = string_cat(target%link_objects, " ") + + target%link_flags = target%link_flags // shared_lib_paths + + ! Add dependencies' shared libraries (excluding self) + target%link_flags = model%get_package_libraries_link(target%package_name, & + target%link_flags, & + exclude_self=.true., & + dep_IDs=package_deps, & + error=error) + + if (allocated(error)) return + + ! Now that they're available, add these dependencies to the targets + if (size(package_deps)>0) then + do j=1,size(package_deps) + if (dep_target_ID(package_deps(j))<=0) cycle + call add_dependency(target, targets(dep_target_ID(package_deps(j)))%ptr) + end do + end if + + ! Add any per-target libraries (e.g., `target%link_libraries`) + if (allocated(target%link_libraries)) then + if (size(target%link_libraries) > 0) then + target%link_flags = model%compiler%enumerate_libraries(target%link_flags, & + target%link_libraries) + end if + end if - if (allocated(target%link_libraries)) then - if (size(target%link_libraries) > 0) then - target%link_flags = model%compiler%enumerate_libraries(target%link_flags, target%link_libraries) - local_link_flags = model%compiler%enumerate_libraries(local_link_flags, target%link_libraries) + ! Add shared library exports (import library + .def) + target%link_flags = target%link_flags // " " // & + model%compiler%get_export_flags(target%output_dir,target%package_name) + + ! Add global link flags (e.g., system-wide libraries) + target%link_flags = target%link_flags // " " // global_link_flags + + case (FPM_TARGET_EXECUTABLE) + + local_link_flags = "" + if (allocated(model%link_flags)) local_link_flags = model%link_flags + + call get_link_objects(target%link_objects,target,is_exe=.true.) + + target%link_flags = model%link_flags//" "//string_cat(target%link_objects," ") + + ! Add shared libs + if (.not.monolithic) then + + target%link_flags = target%link_flags // shared_lib_paths + + ! Check if there's a library with this name (maybe not, if it is a + ! single-file app with only external dependencies) + has_self_lib = .false. + find_self: do j=1,size(targets) + associate(target_loop=>targets(j)%ptr) + if (any(target_loop%target_type==[FPM_TARGET_SHARED,FPM_TARGET_ARCHIVE]) & + .and. target_loop%package_name==target%package_name) then + has_self_lib = .true. + exit find_self + end if + end associate + end do find_self + + ! Add dependencies' shared libraries (including self if there is a library) + target%link_flags = model%get_package_libraries_link(target%package_name, & + target%link_flags, & + error=error, & + exclude_self=.not.has_self_lib) end if - end if - target%link_flags = target%link_flags//" "//global_link_flags + if (allocated(target%link_libraries)) then + if (size(target%link_libraries) > 0) then + target%link_flags = model%compiler%enumerate_libraries(target%link_flags, target%link_libraries) + local_link_flags = model%compiler%enumerate_libraries(local_link_flags, target%link_libraries) + end if + end if - target%output_dir = get_output_dir(model%build_prefix, & - & target%compile_flags//local_link_flags) - target%output_file = join_path(target%output_dir, target%output_name) - target%output_log_file = join_path(target%output_dir, target%output_name)//'.log' - end if + target%link_flags = target%link_flags//" "//global_link_flags + + end select end associate end do - + contains !> Wrapper to build link object list @@ -932,13 +1210,13 @@ recursive subroutine get_link_objects(link_objects,target,is_exe) integer :: i type(string_t) :: temp_str - + if (.not.allocated(target%dependencies)) return do i=1,size(target%dependencies) associate(dep => target%dependencies(i)%ptr) - + if (.not.allocated(dep%source)) cycle ! Skip library dependencies for executable targets @@ -951,7 +1229,7 @@ recursive subroutine get_link_objects(link_objects,target,is_exe) ! Add dependency object file to link object list temp_str%s = dep%output_file link_objects = [link_objects, temp_str] - + ! For executable objects, also need to include non-library ! dependencies from dependencies (recurse) if (is_exe) call get_link_objects(link_objects,dep,is_exe=.true.) @@ -995,6 +1273,40 @@ subroutine add_include_build_dirs(model, targets) end subroutine add_include_build_dirs +!> Add link directories for all shared libraries in the dependency graph +subroutine get_library_dirs(model, targets, shared_lib_dirs) + type(fpm_model_t), intent(in) :: model + type(build_target_ptr), intent(inout), target :: targets(:) + type(string_t), allocatable, intent(out) :: shared_lib_dirs(:) + + integer :: i + type(string_t) :: temp + + allocate(shared_lib_dirs(0)) + + do i = 1, size(targets) + associate(target => targets(i)%ptr) + if (all(target%target_type /= [FPM_TARGET_SHARED,FPM_TARGET_ARCHIVE])) cycle + if (target%output_dir .in. shared_lib_dirs) cycle + temp = string_t(target%output_dir) + shared_lib_dirs = [shared_lib_dirs, temp] + end associate + end do + +end subroutine get_library_dirs + +!> Add link directories for all shared libraries in the dependency graph +subroutine add_library_link_dirs(model, targets, shared_lib_path) + type(fpm_model_t), intent(in) :: model + type(build_target_ptr), intent(inout), target :: targets(:) + character(:), allocatable, intent(out) :: shared_lib_path + + type(string_t), allocatable :: shared_lib_dirs(:) + + call get_library_dirs(model, targets, shared_lib_dirs) + shared_lib_path = " -L" // string_cat(shared_lib_dirs, " -L") + +end subroutine add_library_link_dirs function get_output_dir(build_prefix, args) result(path) character(len=*), intent(in) :: build_prefix @@ -1007,23 +1319,29 @@ function get_output_dir(build_prefix, args) result(path) path = build_prefix//"_"//build_hash end function get_output_dir - +!> Returns pointers to all library targets subroutine filter_library_targets(targets, list) type(build_target_ptr), intent(in) :: targets(:) - type(string_t), allocatable, intent(out) :: list(:) + type(build_target_ptr), allocatable, intent(out) :: list(:) integer :: i, n + + n = 0 + do i = 1, size(targets) + if (any(targets(i)%ptr%target_type == [FPM_TARGET_ARCHIVE,FPM_TARGET_SHARED])) then + n = n + 1 + end if + end do + + allocate(list(n)) n = 0 - call resize(list) do i = 1, size(targets) - if (targets(i)%ptr%target_type == FPM_TARGET_ARCHIVE) then - if (n >= size(list)) call resize(list) + if (any(targets(i)%ptr%target_type == [FPM_TARGET_ARCHIVE,FPM_TARGET_SHARED])) then n = n + 1 - list(n)%s = targets(i)%ptr%output_file + list(n)%ptr => targets(i)%ptr end if end do - call resize(list, n) end subroutine filter_library_targets subroutine filter_executable_targets(targets, scope, list) @@ -1105,4 +1423,51 @@ function get_feature_flags(compiler, features) result(flags) end if end function get_feature_flags +!> Helper function: update output directory of a target +subroutine set_output_dir(self, output_dir) + class(build_target_t), intent(inout) :: self + character(*), optional, intent(in) :: output_dir + + character(:), allocatable :: outdir + + ! Normalize: if output_dir is empty, use no path + outdir = "" + if (present(output_dir)) outdir = trim(output_dir) + + self%output_dir = outdir + self%output_file = join_path(outdir, self%output_name) + self%output_log_file = self%output_file // ".log" + +end subroutine set_output_dir + +!> Build a lookup table mapping each package dependency to its corresponding +!> shared or archive build target in the targets list. +!> +!> This mapping is essential when model%deps%dep(i) indices do not match +!> the pruned or reordered targets(:) array. +subroutine library_targets_to_deps(model, targets, target_ID) + class(fpm_model_t), intent(in) :: model + type(build_target_ptr), intent(in) :: targets(:) + + !> For each package (by dependency index), gives the index of the corresponding target + integer, allocatable, intent(out) :: target_ID(:) + + integer :: it, ip, n + + n = size(model%deps%dep) + allocate(target_ID(n), source=0) + + do it = 1, size(targets) + associate(target => targets(it)%ptr) + ! Only shared libraries and archives are mapped + if (all(target%target_type /= [FPM_TARGET_ARCHIVE, FPM_TARGET_SHARED])) cycle + + ! Get the dependency graph index of this package + ip = model%deps%find(target%package_name) + if (ip > 0) target_ID(ip) = it + end associate + end do + +end subroutine library_targets_to_deps + end module fpm_targets diff --git a/test/fpm_test/test_backend.f90 b/test/fpm_test/test_backend.f90 index 30ca898b46..e936856c9f 100644 --- a/test/fpm_test/test_backend.f90 +++ b/test/fpm_test/test_backend.f90 @@ -4,7 +4,7 @@ module test_backend use test_module_dependencies, only: operator(.in.) use fpm_filesystem, only: exists, mkdir, get_temp_filename use fpm_targets, only: build_target_t, build_target_ptr, & - FPM_TARGET_OBJECT, FPM_TARGET_ARCHIVE, & + FPM_TARGET_OBJECT, FPM_TARGET_ARCHIVE, FPM_TARGET_SHARED, & add_target, add_dependency use fpm_backend, only: sort_target, schedule_targets use fpm_strings, only: string_t @@ -28,6 +28,7 @@ subroutine collect_backend(testsuite) & new_unittest("target-sort", test_target_sort), & & new_unittest("target-sort-skip-all", test_target_sort_skip_all), & & new_unittest("target-sort-rebuild-all", test_target_sort_rebuild_all), & + & new_unittest("target-shared-sort", test_target_shared), & & new_unittest("schedule-targets", test_schedule_targets), & & new_unittest("schedule-targets-empty", test_schedule_empty), & & new_unittest("serialize-compile-commands", compile_commands_roundtrip), & @@ -354,10 +355,6 @@ function new_test_package() result(targets) call add_dependency(targets(2)%ptr,targets(4)%ptr) call add_dependency(targets(3)%ptr,targets(4)%ptr) - do i = 1, size(targets) - targets(i)%ptr%output_file = targets(i)%ptr%output_name - end do - end function new_test_package subroutine compile_commands_roundtrip(error) @@ -469,6 +466,58 @@ subroutine compile_commands_register_from_string(error) end subroutine compile_commands_register_from_string + !> Check sorting and scheduling for shared library targets + subroutine test_target_shared(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(build_target_ptr), allocatable :: targets(:) + integer :: i + + ! Create a new test package with a shared library + call add_target(targets, 'test-shared', FPM_TARGET_SHARED, get_temp_filename()) + call add_target(targets, 'test-shared', FPM_TARGET_OBJECT, get_temp_filename()) + call add_target(targets, 'test-shared', FPM_TARGET_OBJECT, get_temp_filename()) + + ! Shared library depends on the two object files + call add_dependency(targets(1)%ptr, targets(2)%ptr) + call add_dependency(targets(1)%ptr, targets(3)%ptr) + + ! Perform topological sort + do i = 1, size(targets) + call sort_target(targets(i)%ptr) + end do + + ! Check scheduling and flags + do i = 1, size(targets) + if (.not.targets(i)%ptr%touched) then + call test_failed(error, "Shared: Target not touched") + return + end if + if (.not.targets(i)%ptr%sorted) then + call test_failed(error, "Shared: Target not sorted") + return + end if + if (targets(i)%ptr%skip) then + call test_failed(error, "Shared: Target incorrectly skipped") + return + end if + end do + + ! Check dependencies scheduled before the shared lib + if (targets(2)%ptr%schedule >= targets(1)%ptr%schedule) then + call test_failed(error, "Shared: Object 2 scheduled after shared lib") + return + end if + if (targets(3)%ptr%schedule >= targets(1)%ptr%schedule) then + call test_failed(error, "Shared: Object 3 scheduled after shared lib") + return + end if + + end subroutine test_target_shared + + end module test_backend diff --git a/test/fpm_test/test_installer.f90 b/test/fpm_test/test_installer.f90 index d6cc444d8c..edc5838d88 100644 --- a/test/fpm_test/test_installer.f90 +++ b/test/fpm_test/test_installer.f90 @@ -8,6 +8,8 @@ module test_installer use fpm_environment, only : OS_WINDOWS, OS_LINUX use fpm_filesystem, only : join_path use fpm_installer + use fpm_targets, only: build_target_ptr, add_target, FPM_TARGET_ARCHIVE, & + FPM_TARGET_SHARED implicit none private @@ -37,7 +39,8 @@ subroutine collect_installer(testsuite) & new_unittest("install-exe-unix", test_install_exe_unix), & & new_unittest("install-exe-win", test_install_exe_win), & & new_unittest("install-test-unix", test_install_tests_unix), & - & new_unittest("install-test-win", test_install_tests_win)] + & new_unittest("install-test-win", test_install_tests_win), & + & new_unittest("install-shared-lib-unix", test_install_shared_library_unix)] end subroutine collect_installer @@ -115,13 +118,18 @@ subroutine test_install_lib(error) type(mock_installer_t) :: mock type(installer_t) :: installer + type(build_target_ptr), allocatable :: targets(:) call new_installer(installer, prefix="PREFIX", verbosity=0, copy="mock") mock%installer_t = installer mock%expected_dir = join_path("PREFIX", "lib") mock%expected_run = 'mock "name" "'//join_path("PREFIX", "lib")//'"' + + call add_target(targets,"name",FPM_TARGET_ARCHIVE,"name") - call mock%install_library("name", error) + call mock%install_library(targets(1)%ptr, error) + + deallocate(targets(1)%ptr) end subroutine test_install_lib @@ -130,16 +138,16 @@ subroutine test_install_pkgconfig(error) type(error_t), allocatable, intent(out) :: error type(mock_installer_t) :: mock - type(installer_t) :: installer + type(installer_t) :: installer call new_installer(installer, prefix="PREFIX", verbosity=0, copy="mock") mock%installer_t = installer mock%os = OS_WINDOWS mock%expected_dir = "PREFIX\lib\pkgconfig" mock%expected_run = 'mock "name" "'//mock%expected_dir//'"' - + call mock%install("name", "lib/pkgconfig", error) - + end subroutine test_install_pkgconfig subroutine test_install_sitepackages(error) @@ -176,6 +184,29 @@ subroutine test_install_mod(error) end subroutine test_install_mod + subroutine test_install_shared_library_unix(error) + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(mock_installer_t) :: mock + type(installer_t) :: installer + character(len=*), parameter :: libname = "libname.so" + type(build_target_ptr), allocatable :: targets(:) + + call new_installer(installer, prefix="PREFIX", verbosity=0, copy="mock") + mock%installer_t = installer + mock%expected_dir = join_path("PREFIX", "lib") + mock%expected_run = 'mock "'//libname//'" "'//mock%expected_dir//'"' + + call add_target(targets,"name",FPM_TARGET_SHARED,libname) + + call mock%install_library(targets(1)%ptr, error) + + deallocate(targets(1)%ptr) + + end subroutine test_install_shared_library_unix + + !> Create a new directory in the prefix subroutine make_dir(self, dir, error) !> Instance of the installer diff --git a/test/fpm_test/test_module_dependencies.f90 b/test/fpm_test/test_module_dependencies.f90 index 1e4bcf265c..afb87eb302 100644 --- a/test/fpm_test/test_module_dependencies.f90 +++ b/test/fpm_test/test_module_dependencies.f90 @@ -99,7 +99,7 @@ subroutine test_library_module_use(error) provides=[string_t('my_mod_2')], & uses=[string_t('my_mod_1')]) - call targets_from_sources(targets,model,.false.,error) + call targets_from_sources(targets,model,.false.,error=error) if (allocated(error)) return if (allocated(error)) then @@ -173,7 +173,7 @@ subroutine test_scope(exe_scope,error) scope=exe_scope, & uses=[string_t('my_mod_1')]) - call targets_from_sources(targets,model,.false.,error) + call targets_from_sources(targets,model,.false.,error=error) if (allocated(error)) return if (size(targets) /= 4) then @@ -230,7 +230,7 @@ subroutine test_program_with_module(error) provides=[string_t('app_mod')], & uses=[string_t('app_mod')]) - call targets_from_sources(targets,model,.false.,error) + call targets_from_sources(targets,model,.false.,error=error) if (allocated(error)) return if (size(targets) /= 2) then @@ -296,7 +296,7 @@ subroutine test_scope(exe_scope,error) scope=exe_scope, & uses=[string_t('app_mod2')]) - call targets_from_sources(targets,model,.false.,error) + call targets_from_sources(targets,model,.false.,error=error) if (allocated(error)) return if (size(targets) /= 4) then @@ -354,7 +354,7 @@ subroutine test_missing_library_use(error) provides=[string_t('my_mod_2')], & uses=[string_t('my_mod_3')]) - call targets_from_sources(targets,model,.false.,error) + call targets_from_sources(targets,model,.false.,error=error) end subroutine test_missing_library_use @@ -384,7 +384,7 @@ subroutine test_missing_program_use(error) scope=FPM_SCOPE_APP, & uses=[string_t('my_mod_2')]) - call targets_from_sources(targets,model,.false.,error) + call targets_from_sources(targets,model,.false.,error=error) end subroutine test_missing_program_use @@ -415,7 +415,7 @@ subroutine test_invalid_library_use(error) provides=[string_t('my_mod')], & uses=[string_t('app_mod')]) - call targets_from_sources(targets,model,.false.,error) + call targets_from_sources(targets,model,.false.,error=error) end subroutine test_invalid_library_use @@ -445,7 +445,7 @@ subroutine test_subdirectory_module_use(error) scope=FPM_SCOPE_APP, & uses=[string_t('app_mod')]) - call targets_from_sources(targets,model,.false.,error) + call targets_from_sources(targets,model,.false.,error=error) end subroutine test_subdirectory_module_use @@ -733,7 +733,7 @@ subroutine test_invalid_subdirectory_module_use(error) scope=FPM_SCOPE_APP, & uses=[string_t('app_mod')]) - call targets_from_sources(targets,model,.false.,error) + call targets_from_sources(targets,model,.false.,error=error) end subroutine test_invalid_subdirectory_module_use