diff --git a/src/fpm.f90 b/src/fpm.f90 index 5e86498d2e..aabd4f16db 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -9,7 +9,8 @@ module fpm use fpm_model, only: fpm_model_t, srcfile_t, show_model, & FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, FPM_SCOPE_DEP, & FPM_SCOPE_APP, FPM_SCOPE_EXAMPLE, FPM_SCOPE_TEST -use fpm_compiler, only: get_module_flags, is_unknown_compiler, get_default_c_compiler +use fpm_compiler, only: get_module_flags, is_unknown_compiler, get_default_c_compiler, & + archiver_t, compiler_t use fpm_sources, only: add_executable_sources, add_sources_from_dir @@ -43,6 +44,7 @@ subroutine build_model(model, settings, package, error) integer :: i, j type(package_config_t) :: dependency character(len=:), allocatable :: manifest, lib_dir + character(len=:), allocatable :: fortran_compiler, fortran_compiler_flags, c_compiler logical :: duplicates_found = .false. type(string_t) :: include_dir @@ -58,25 +60,27 @@ subroutine build_model(model, settings, package, error) if (allocated(error)) return if(settings%compiler.eq.'')then - model%fortran_compiler = 'gfortran' + fortran_compiler = 'gfortran' else - model%fortran_compiler = settings%compiler + fortran_compiler = settings%compiler endif - call get_default_c_compiler(model%fortran_compiler, model%c_compiler) - model%c_compiler = get_env('FPM_C_COMPILER',model%c_compiler) + call get_default_c_compiler(fortran_compiler, c_compiler) + c_compiler = get_env('FPM_C_COMPILER', c_compiler) - if (is_unknown_compiler(model%fortran_compiler)) then + if (is_unknown_compiler(fortran_compiler)) then write(*, '(*(a:,1x))') & - "", "Unknown compiler", model%fortran_compiler, "requested!", & + "", "Unknown compiler", fortran_compiler, "requested!", & "Defaults for this compiler might be incorrect" end if - model%output_directory = join_path('build',basename(model%fortran_compiler)//'_'//settings%build_name) + model%output_directory = join_path('build',basename(fortran_compiler)//'_'//settings%build_name) - call get_module_flags(model%fortran_compiler, & + call get_module_flags(fortran_compiler, & & join_path(model%output_directory,model%package_name), & - & model%fortran_compile_flags) - model%fortran_compile_flags = settings%flag // model%fortran_compile_flags + & fortran_compiler_flags) + model%compiler = compiler_t(fortran_compiler, settings%flag // fortran_compiler_flags) + model%c_compiler = compiler_t(c_compiler, settings%flag) + model%archiver = archiver_t() allocate(model%packages(model%deps%ndep)) @@ -185,9 +189,9 @@ subroutine build_model(model, settings, package, error) if (settings%verbose) then write(*,*)' BUILD_NAME: ',settings%build_name - write(*,*)' COMPILER: ',settings%compiler - write(*,*)' C COMPILER: ',model%c_compiler - write(*,*)' COMPILER OPTIONS: ', model%fortran_compile_flags + write(*,*)' COMPILER: ',model%compiler%prog + write(*,*)' C COMPILER: ',model%c_compiler%prog + write(*,*)' COMPILER OPTIONS: ', model%compiler%flags write(*,*)' INCLUDE DIRECTORIES: [', string_cat(model%include_dirs,','),']' end if diff --git a/src/fpm_backend.f90 b/src/fpm_backend.f90 index 8c4cf4064d..4a92bee239 100644 --- a/src/fpm_backend.f90 +++ b/src/fpm_backend.f90 @@ -238,20 +238,18 @@ subroutine build_target(model,target) select case(target%target_type) case (FPM_TARGET_OBJECT) - call run(model%fortran_compiler//" -c " // target%source%file_name // target%compile_flags & - // " -o " // target%output_file) + call model%compiler%compile(target%output_file, target%source%file_name, & + target%compile_flags) case (FPM_TARGET_C_OBJECT) - call run(model%c_compiler//" -c " // target%source%file_name // target%compile_flags & - // " -o " // target%output_file) + call model%c_compiler%compile(target%output_file, target%source%file_name, & + target%compile_flags) case (FPM_TARGET_EXECUTABLE) - - call run(model%fortran_compiler// " " // target%compile_flags & - //" "//target%link_flags// " -o " // target%output_file) + call model%compiler%link(target%output_file, target%link_flags, target%compile_flags) case (FPM_TARGET_ARCHIVE) - call run("ar -rs " // target%output_file // " " // string_cat(target%link_objects," ")) + call model%archiver%archive(target%output_file, target%link_objects) end select diff --git a/src/fpm_compiler.f90 b/src/fpm_compiler.f90 index ca0f4d7110..87e0d4583f 100644 --- a/src/fpm_compiler.f90 +++ b/src/fpm_compiler.f90 @@ -26,9 +26,10 @@ ! Open64 ? ? -module -I -mp discontinued ! Unisys ? ? ? ? ? discontinued module fpm_compiler -use fpm_model, only: fpm_model_t use fpm_filesystem, only: join_path, basename +use fpm_strings, only : string_t, string_cat use fpm_environment, only: & + run, & get_os_type, & OS_LINUX, & OS_MACOS, & @@ -67,7 +68,85 @@ module fpm_compiler end enum integer, parameter :: compiler_enum = kind(id_unknown) +!> Abstraction for the compiler +type :: compiler_t + character(len=:), allocatable :: prog + character(len=:), allocatable :: flags contains + procedure :: compile + procedure :: link +end type compiler_t +interface compiler_t + module procedure :: new_compiler +end interface compiler_t + +!> Abstraction for the archive / static library creation +type :: archiver_t + character(len=:), allocatable :: prog + character(len=:), allocatable :: flags +contains + procedure :: archive +end type archiver_t +interface archiver_t + module procedure :: new_archiver +end interface archiver_t + +contains + +!> Create a new archiver object +function new_archiver() result(new) + type(archiver_t) :: new + character(len=*), parameter :: default_archiver = "ar" + character(len=*), parameter :: default_archiver_flags = "-rs" + new%prog = default_archiver + new%flags = default_archiver_flags +end function new_archiver + +!> Create an archive / static library from a given set of object files +subroutine archive(self, output, objects) + class(archiver_t), intent(in) :: self + character(len=*), intent(in) :: output + type(string_t), intent(in) :: objects(:) + + call run(self%prog //" "// self%flags //" "// output //" "// string_cat(objects, " ")) +end subroutine archive + +!> Create a new compiler object +function new_compiler(compiler, compiler_flags) result(new) + type(compiler_t) :: new + character(len=*), intent(in) :: compiler + character(len=*), intent(in) :: compiler_flags + new%prog = compiler + new%flags = compiler_flags +end function new_compiler + +!> Compile an object file from a given source file +subroutine compile(self, output, input, flags) + class(compiler_t), intent(in) :: self + character(len=*), intent(in) :: output + character(len=*), intent(in) :: input + character(len=*), intent(in), optional :: flags + + if (present(flags)) then + call run(self%prog // " " // flags // " -o " // output // " -c " // input) + else + call run(self%prog // " " // self%flags // " -o " // output // " -c " // input) + end if +end subroutine compile + +!> Link an executable from a given set of object files (might contain link flags as well) +subroutine link(self, output, objects, flags) + class(compiler_t), intent(in) :: self + character(len=*), intent(in) :: output + character(len=*), intent(in) :: objects + character(len=*), intent(in), optional :: flags + + if (present(flags)) then + call run(self%prog // " " // flags // " -o " // output // " " // objects) + else + call run(self%prog // " " // self%flags // " -o " // output // " " // objects) + end if +end subroutine link subroutine get_default_compile_flags(compiler, release, flags) character(len=*), intent(in) :: compiler diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index b8a4143005..ab4bcc668f 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -19,6 +19,7 @@ !> module fpm_model use iso_fortran_env, only: int64 +use fpm_compiler, only : archiver_t, compiler_t use fpm_strings, only: string_t, str use fpm_dependency, only: dependency_tree_t implicit none @@ -114,15 +115,6 @@ module fpm_model !> Array of packages (including the root package) type(package_t), allocatable :: packages(:) - !> Command line name to invoke fortran compiler - character(:), allocatable :: fortran_compiler - - !> Command line name to invoke c compiler - character(:), allocatable :: c_compiler - - !> Command line flags passed to fortran for compilation - character(:), allocatable :: fortran_compile_flags - !> Base directory for build character(:), allocatable :: output_directory @@ -138,6 +130,15 @@ module fpm_model !> Project dependencies type(dependency_tree_t) :: deps + !> Compiler command + type(compiler_t) :: compiler + + !> Compiler command + type(compiler_t) :: c_compiler + + !> Archiver command + type(archiver_t) :: archiver + end type fpm_model_t contains @@ -270,9 +271,9 @@ function info_model(model) result(s) end do s = s // "]" ! character(:), allocatable :: fortran_compiler - s = s // ', fortran_compiler="' // model%fortran_compiler // '"' + s = s // ', fortran_compiler="' // model%compiler%prog // '"' ! character(:), allocatable :: fortran_compile_flags - s = s // ', fortran_compile_flags="' // model%fortran_compile_flags // '"' + s = s // ', fortran_compile_flags="' // model%compiler%flags // '"' ! character(:), allocatable :: output_directory s = s // ', output_directory="' // model%output_directory // '"' ! type(string_t), allocatable :: link_libraries(:) diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index c247232b6d..4d784c7fcb 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -480,9 +480,9 @@ subroutine resolve_target_linking(targets, model) associate(target => targets(i)%ptr) if (target%target_type /= FPM_TARGET_C_OBJECT) then - target%compile_flags = model%fortran_compile_flags//" "//global_include_flags + target%compile_flags = model%compiler%flags//" "//global_include_flags else - target%compile_flags = global_include_flags + target%compile_flags = model%c_compiler%flags//" "//global_include_flags end if allocate(target%link_objects(0))