diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/fpm.f90 | 24 | ||||
| -rw-r--r-- | src/fpm_backend.f90 | 44 | ||||
| -rw-r--r-- | src/fpm_compiler.f90 | 186 | ||||
| -rw-r--r-- | src/fpm_model.f90 | 18 |
4 files changed, 205 insertions, 67 deletions
diff --git a/src/fpm.f90 b/src/fpm.f90 index 89eca1a..465d16e 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -10,7 +10,7 @@ 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, & - get_archiver + archiver_t use fpm_sources, only: add_executable_sources, add_sources_from_dir @@ -59,23 +59,23 @@ subroutine build_model(model, settings, package, error) if (allocated(error)) return if(settings%compiler.eq.'')then - model%fortran_compiler = 'gfortran' + model%compiler%fc = "gfortran" else - model%fortran_compiler = settings%compiler + model%compiler%fc = settings%compiler endif - model%archiver = get_archiver() - call get_default_c_compiler(model%fortran_compiler, model%c_compiler) - model%c_compiler = get_env('FPM_C_COMPILER',model%c_compiler) + model%archiver = archiver_t() + call get_default_c_compiler(model%compiler%fc, model%compiler%cc) + model%compiler%cc = get_env('FPM_C_COMPILER',model%compiler%cc) - if (is_unknown_compiler(model%fortran_compiler)) then + if (is_unknown_compiler(model%compiler%fc)) then write(*, '(*(a:,1x))') & - "<WARN>", "Unknown compiler", model%fortran_compiler, "requested!", & + "<WARN>", "Unknown compiler", model%compiler%fc, "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(model%compiler%fc)//'_'//settings%build_name) - call get_module_flags(model%fortran_compiler, & + call get_module_flags(model%compiler%fc, & & join_path(model%output_directory,model%package_name), & & model%fortran_compile_flags) model%fortran_compile_flags = settings%flag // model%fortran_compile_flags @@ -187,8 +187,8 @@ subroutine build_model(model, settings, package, error) if (settings%verbose) then write(*,*)'<INFO> BUILD_NAME: ',settings%build_name - write(*,*)'<INFO> COMPILER: ',settings%compiler - write(*,*)'<INFO> C COMPILER: ',model%c_compiler + write(*,*)'<INFO> COMPILER: ',model%compiler%fc + write(*,*)'<INFO> C COMPILER: ',model%compiler%cc write(*,*)'<INFO> COMPILER OPTIONS: ', model%fortran_compile_flags write(*,*)'<INFO> INCLUDE DIRECTORIES: [', string_cat(model%include_dirs,','),']' end if diff --git a/src/fpm_backend.f90 b/src/fpm_backend.f90 index 4d0c709..b559343 100644 --- a/src/fpm_backend.f90 +++ b/src/fpm_backend.f90 @@ -30,12 +30,10 @@ module fpm_backend use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit use fpm_error, only : fpm_stop use fpm_environment, only: run, get_os_type, OS_WINDOWS -use fpm_filesystem, only: basename, dirname, join_path, exists, mkdir, unix_path +use fpm_filesystem, only: basename, dirname, join_path, exists, mkdir use fpm_model, only: fpm_model_t use fpm_targets, only: build_target_t, build_target_ptr, FPM_TARGET_OBJECT, & FPM_TARGET_C_OBJECT, FPM_TARGET_ARCHIVE, FPM_TARGET_EXECUTABLE -use fpm_strings, only: string_cat, string_t - implicit none private @@ -265,31 +263,19 @@ subroutine build_target(model,target,stat) 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, echo=.true., exitstat=stat) + call model%compiler%compile_fortran(target%source%file_name, target%output_file, & + & target%compile_flags, stat) case (FPM_TARGET_C_OBJECT) - call run(model%c_compiler//" -c " // target%source%file_name // target%compile_flags & - // " -o " // target%output_file, echo=.true., exitstat=stat) + call model%compiler%compile_c(target%source%file_name, target%output_file, & + & target%compile_flags, stat) case (FPM_TARGET_EXECUTABLE) - - call run(model%fortran_compiler// " " // target%compile_flags & - //" "//target%link_flags// " -o " // target%output_file, echo=.true., exitstat=stat) + call model%compiler%link(target%output_file, & + & target%compile_flags//" "//target%link_flags, stat) case (FPM_TARGET_ARCHIVE) - - select case (get_os_type()) - case (OS_WINDOWS) - call write_response_file(target%output_file//".resp" ,target%link_objects) - call run(model%archiver // target%output_file // " @" // target%output_file//".resp", & - echo=.true., exitstat=stat) - - case default - call run(model%archiver // target%output_file // " " // string_cat(target%link_objects," "), & - echo=.true., exitstat=stat) - - end select + call model%archiver%make_archive(target%output_file, target%link_objects, stat) end select @@ -301,19 +287,5 @@ subroutine build_target(model,target,stat) end subroutine build_target -!> Response files allow to read command line options from files. -!> Whitespace is used to separate the arguments, we will use newlines -!> as separator to create readable response files which can be inspected -!> in case of errors. -subroutine write_response_file(name, argv) - character(len=*), intent(in) :: name - type(string_t), intent(in) :: argv(:) - integer :: iarg, io - open(file=name, newunit=io) - do iarg = 1, size(argv) - write(io, '(a)') unix_path(argv(iarg)%s) - end do - close(io) -end subroutine write_response_file end module fpm_backend diff --git a/src/fpm_compiler.f90 b/src/fpm_compiler.f90 index b3e3a56..b432f11 100644 --- a/src/fpm_compiler.f90 +++ b/src/fpm_compiler.f90 @@ -26,9 +26,8 @@ ! Open64 ? ? -module -I -mp discontinued ! Unisys ? ? ? ? ? discontinued module fpm_compiler -use fpm_model, only: fpm_model_t -use fpm_filesystem, only: join_path, basename, get_temp_filename use fpm_environment, only: & + run, & get_os_type, & OS_LINUX, & OS_MACOS, & @@ -38,13 +37,17 @@ use fpm_environment, only: & OS_FREEBSD, & OS_OPENBSD, & OS_UNKNOWN +use fpm_filesystem, only: join_path, basename, get_temp_filename, delete_file, unix_path +use fpm_strings, only: string_cat, string_t implicit none public :: is_unknown_compiler public :: get_module_flags public :: get_default_compile_flags public :: get_debug_compile_flags public :: get_release_compile_flags -public :: get_archiver + +public :: compiler_t, archiver_t +public :: debug enum, bind(C) enumerator :: & @@ -70,6 +73,52 @@ enum, bind(C) end enum integer, parameter :: compiler_enum = kind(id_unknown) + +!> Definition of compiler object +type :: compiler_t + !> Path to the Fortran compiler + character(len=:), allocatable :: fc + !> Path to the C compiler + character(len=:), allocatable :: cc + !> Print all commands + logical :: echo = .true. +contains + !> Compile a Fortran object + procedure :: compile_fortran + !> Compile a C object + procedure :: compile_c + !> Link executable + procedure :: link +end type compiler_t + + +!> Definition of archiver object +type :: archiver_t + !> Path to archiver + character(len=:), allocatable :: ar + !> Use response files to pass arguments + logical :: use_response_file = .false. + !> Print all command + logical :: echo = .true. +contains + !> Create static archive + procedure :: make_archive +end type archiver_t + + +!> Constructor for archiver +interface archiver_t + module procedure :: new_archiver +end interface archiver_t + + +!> Create debug printout +interface debug + module procedure :: debug_compiler + module procedure :: debug_archiver +end interface debug + + contains subroutine get_default_compile_flags(compiler, release, flags) @@ -460,6 +509,7 @@ function check_compiler(compiler, expected) result(match) end if end function check_compiler + function is_unknown_compiler(compiler) result(is_unknown) character(len=*), intent(in) :: compiler logical :: is_unknown @@ -467,22 +517,140 @@ function is_unknown_compiler(compiler) result(is_unknown) end function is_unknown_compiler -function get_archiver() result(archiver) - character(:), allocatable :: archiver +!> Create new archiver +function new_archiver() result(self) + !> New instance of the archiver + type(archiver_t) :: self integer :: estat, os_type os_type = get_os_type() if (os_type /= OS_WINDOWS .and. os_type /= OS_UNKNOWN) then - archiver = "ar -rs " + self%ar = "ar -rs " else call execute_command_line("ar --version > "//get_temp_filename()//" 2>&1", & & exitstat=estat) if (estat /= 0) then - archiver = "lib /OUT:" + self%ar = "lib /OUT:" else - archiver = "ar -rs " + self%ar = "ar -rs " end if end if -end function + self%use_response_file = os_type == OS_WINDOWS + self%echo = .true. +end function new_archiver + + +!> Compile a Fortran object +subroutine compile_fortran(self, input, output, args, stat) + !> Instance of the compiler object + class(compiler_t), intent(in) :: self + !> Source file input + character(len=*), intent(in) :: input + !> Output file of object + character(len=*), intent(in) :: output + !> Arguments for compiler + character(len=*), intent(in) :: args + !> Status flag + integer, intent(out) :: stat + + call run(self%fc // " -c " // input // " " // args // " -o " // output, & + & echo=self%echo, exitstat=stat) +end subroutine compile_fortran + + +!> Compile a C object +subroutine compile_c(self, input, output, args, stat) + !> Instance of the compiler object + class(compiler_t), intent(in) :: self + !> Source file input + character(len=*), intent(in) :: input + !> Output file of object + character(len=*), intent(in) :: output + !> Arguments for compiler + character(len=*), intent(in) :: args + !> Status flag + integer, intent(out) :: stat + + call run(self%cc // " -c " // input // " " // args // " -o " // output, & + & echo=self%echo, exitstat=stat) +end subroutine compile_c + + +!> Link an executable +subroutine link(self, output, args, stat) + !> Instance of the compiler object + class(compiler_t), intent(in) :: self + !> Output file of object + character(len=*), intent(in) :: output + !> Arguments for compiler + character(len=*), intent(in) :: args + !> Status flag + integer, intent(out) :: stat + + call run(self%fc // " " // args // " -o " // output, echo=self%echo, exitstat=stat) +end subroutine link + + +!> Create an archive +subroutine make_archive(self, output, args, stat) + !> Instance of the archiver object + class(archiver_t), intent(in) :: self + !> Name of the archive to generate + character(len=*), intent(in) :: output + !> Object files to include into the archive + type(string_t), intent(in) :: args(:) + !> Status flag + integer, intent(out) :: stat + + if (self%use_response_file) then + call write_response_file(output//".resp" , args) + call run(self%ar // output // " @" // output//".resp", echo=self%echo, exitstat=stat) + call delete_file(output//".resp") + else + call run(self%ar // output // " " // string_cat(args, " "), & + & echo=self%echo, exitstat=stat) + end if +end subroutine make_archive + + +!> Response files allow to read command line options from files. +!> Whitespace is used to separate the arguments, we will use newlines +!> as separator to create readable response files which can be inspected +!> in case of errors. +subroutine write_response_file(name, argv) + character(len=*), intent(in) :: name + type(string_t), intent(in) :: argv(:) + + integer :: iarg, io + + open(file=name, newunit=io) + do iarg = 1, size(argv) + write(io, '(a)') unix_path(argv(iarg)%s) + end do + close(io) +end subroutine write_response_file + + +!> String representation of a compiler object +pure function debug_compiler(self) result(repr) + !> Instance of the compiler object + type(compiler_t), intent(in) :: self + !> Representation as string + character(len=:), allocatable :: repr + + repr = 'fc="'//self%fc//'", cc="'//self%cc//'"' +end function debug_compiler + + +!> String representation of an archiver object +pure function debug_archiver(self) result(repr) + !> Instance of the archiver object + type(archiver_t), intent(in) :: self + !> Representation as string + character(len=:), allocatable :: repr + + repr = 'ar="'//self%ar//'"' +end function debug_archiver + end module fpm_compiler diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index 49f598e..2dd9514 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -19,8 +19,9 @@ !> module fpm_model use iso_fortran_env, only: int64 -use fpm_strings, only: string_t, str +use fpm_compiler, only: compiler_t, archiver_t, debug use fpm_dependency, only: dependency_tree_t +use fpm_strings, only: string_t, str implicit none private @@ -114,14 +115,11 @@ type :: fpm_model_t !> 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 to invoke for creating static library - character(:), allocatable :: archiver + !> Compiler object + type(compiler_t) :: compiler - !> Command line name to invoke c compiler - character(:), allocatable :: c_compiler + !> Archiver object + type(archiver_t) :: archiver !> Command line flags passed to fortran for compilation character(:), allocatable :: fortran_compile_flags @@ -271,8 +269,8 @@ function info_model(model) result(s) if (i < size(model%packages)) s = s // ", " end do s = s // "]" - ! character(:), allocatable :: fortran_compiler - s = s // ', fortran_compiler="' // model%fortran_compiler // '"' + s = s // ', compiler=(' // debug(model%compiler) // ')' + s = s // ', archiver=(' // debug(model%archiver) // ')' ! character(:), allocatable :: fortran_compile_flags s = s // ', fortran_compile_flags="' // model%fortran_compile_flags // '"' ! character(:), allocatable :: output_directory |