diff --git a/src/fpm.f90 b/src/fpm.f90 index 37cf069c9c..4a9d032472 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -12,12 +12,14 @@ module fpm use fpm_model, only: fpm_model_t, srcfile_t, show_model, fortran_features_t, & FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, FPM_SCOPE_DEP, & FPM_SCOPE_APP, FPM_SCOPE_EXAMPLE, FPM_SCOPE_TEST -use fpm_compiler, only: new_compiler, new_archiver, set_cpp_preprocessor_flags +use fpm_compiler, only: new_compiler, new_archiver, set_cpp_preprocessor_flags, & + generate_shared_library 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, FPM_TARGET_ARCHIVE, & + FPM_TARGET_OBJECT 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 @@ -467,6 +469,12 @@ subroutine cmd_build(settings) call build_package(targets,model,verbose=settings%verbose) endif +do i=1, size(targets) + if (targets(i)%ptr%target_type == FPM_TARGET_ARCHIVE .and. package%build%shared_library) then + call model%compiler%generate_shared_library(model%package_name, targets(i)%ptr%output_file) + exit + end if +enddo end subroutine cmd_build subroutine cmd_run(settings,test) diff --git a/src/fpm/manifest/build.f90 b/src/fpm/manifest/build.f90 index 035ea0d51d..0782f10bd7 100644 --- a/src/fpm/manifest/build.f90 +++ b/src/fpm/manifest/build.f90 @@ -41,6 +41,9 @@ module fpm_manifest_build !> External modules to use type(string_t), allocatable :: external_modules(:) + !> Generate a shared library. + logical :: shared_library = .false. + contains !> Print information on this instance @@ -135,6 +138,8 @@ subroutine new_build_config(self, table, package_name, error) call get_list(table, "external-modules", self%external_modules, error) if (allocated(error)) return + call get_value(table, "shared-library", self%shared_library, .false., stat=stat) + end subroutine new_build_config !> Check local schema for allowed entries @@ -160,7 +165,7 @@ subroutine check(table, package_name, error) do ikey = 1, size(list) select case(list(ikey)%key) - case("auto-executables", "auto-examples", "auto-tests", "link", "external-modules", "module-naming") + case("auto-executables", "auto-examples", "auto-tests", "link", "external-modules", "module-naming", "shared-library") continue case default @@ -216,6 +221,8 @@ subroutine info(self, unit, verbosity) end do end if + write(unit, fmt) " - generate shared library ", merge("enabled ", "disabled", self%shared_library) + end subroutine info !> Check that two dependency trees are equal @@ -235,6 +242,7 @@ logical function build_conf_is_same(this,that) if (.not.this%module_prefix==other%module_prefix) return if (.not.this%link==other%link) return if (.not.this%external_modules==other%external_modules) return + if (this%shared_library.neqv.other%shared_library) return class default ! Not the same type @@ -278,6 +286,8 @@ subroutine dump_to_toml(self, table, error) call set_list(table, "external-modules", self%external_modules, error) if (allocated(error)) return + call set_value(table, "shared-library", self%shared_library, error, class_name) + end subroutine dump_to_toml !> Read build config from toml table (no checks made at this stage) @@ -321,6 +331,8 @@ subroutine load_from_toml(self, table, error) call get_list(table, "external-modules", self%external_modules, error) if (allocated(error)) return + call get_value(table, "shared-library", self%shared_library, error, class_name) + end subroutine load_from_toml diff --git a/src/fpm/manifest/install.f90 b/src/fpm/manifest/install.f90 index 88c3097eb0..e8cde34d00 100644 --- a/src/fpm/manifest/install.f90 +++ b/src/fpm/manifest/install.f90 @@ -118,6 +118,7 @@ logical function install_conf_same(this,that) install_conf_same = .false. + select type (other=>that) type is (install_config_t) if (this%library.neqv.other%library) return diff --git a/src/fpm_compiler.F90 b/src/fpm_compiler.F90 index f173267659..6ce32ffd24 100644 --- a/src/fpm_compiler.F90 +++ b/src/fpm_compiler.F90 @@ -46,6 +46,7 @@ module fpm_compiler implicit none public :: compiler_t, new_compiler, archiver_t, new_archiver, get_macros public :: debug +public :: generate_shared_library enum, bind(C) enumerator :: & @@ -114,6 +115,8 @@ module fpm_compiler procedure :: is_gnu !> Enumerate libraries, based on compiler and platform procedure :: enumerate_libraries + !> Function for generating shared library. + procedure :: generate_shared_library !> Serialization interface procedure :: serializable_is_same => compiler_is_same @@ -1104,6 +1107,18 @@ subroutine compile_fortran(self, input, output, args, log_file, stat) & echo=self%echo, verbose=self%verbose, redirect=log_file, exitstat=stat) end subroutine compile_fortran +subroutine generate_shared_library(self, package_name, output_file) + !> Instance of the compiler object + class(compiler_t), intent(in) :: self + !> Name of the package. + character(len=*), intent(in) :: package_name + !> Output file of library archive. + character(len=*), intent(in) :: output_file + + call run(self%fc // " --shared " // " -o " // "lib" // package_name // ".so" // " " & + // output_file, echo=self%echo, verbose=self%verbose) +end subroutine generate_shared_library + !> Compile a C object subroutine compile_c(self, input, output, args, log_file, stat)