diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/fpm.f90 | 50 | ||||
| -rw-r--r-- | src/fpm_backend.f90 | 44 | ||||
| -rw-r--r-- | src/fpm_command_line.f90 | 19 | ||||
| -rw-r--r-- | src/fpm_compiler.f90 | 699 | ||||
| -rw-r--r-- | src/fpm_model.f90 | 18 |
5 files changed, 517 insertions, 313 deletions
diff --git a/src/fpm.f90 b/src/fpm.f90 index 68e2bbd..7208abf 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -1,5 +1,5 @@ module fpm -use fpm_strings, only: string_t, operator(.in.), glob, join, string_cat +use fpm_strings, only: string_t, operator(.in.), glob, join, string_cat, fnv_1a use fpm_backend, only: build_package use fpm_command_line, only: fpm_build_settings, fpm_new_settings, & fpm_run_settings, fpm_install_settings, fpm_test_settings @@ -9,8 +9,7 @@ use fpm_filesystem, only: is_dir, join_path, number_of_rows, list_files, exists, 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 +use fpm_compiler, only: new_compiler, new_archiver use fpm_sources, only: add_executable_sources, add_sources_from_dir @@ -19,12 +18,9 @@ use fpm_targets, only: targets_from_sources, resolve_module_dependencies, & FPM_TARGET_EXECUTABLE, FPM_TARGET_ARCHIVE use fpm_manifest, only : get_package_data, package_config_t use fpm_error, only : error_t, fatal_error, fpm_stop -use fpm_manifest_test, only : test_config_t use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, & & stdout=>output_unit, & & stderr=>error_unit -use fpm_manifest_dependency, only: dependency_config_t -use, intrinsic :: iso_fortran_env, only: error_unit implicit none private public :: cmd_build, cmd_run @@ -43,10 +39,11 @@ subroutine build_model(model, settings, package, error) integer :: i, j type(package_config_t) :: dependency - character(len=:), allocatable :: manifest, lib_dir + character(len=:), allocatable :: manifest, lib_dir, flags logical :: duplicates_found = .false. type(string_t) :: include_dir + character(len=16) :: build_name model%package_name = package%name @@ -63,27 +60,30 @@ subroutine build_model(model, settings, package, error) call filewrite(join_path("build", ".gitignore"),["*"]) end if - if(settings%compiler.eq.'')then - model%fortran_compiler = 'gfortran' + call new_compiler(model%compiler, settings%compiler) + call new_archiver(model%archiver) + + if (settings%flag == '') then + flags = model%compiler%get_default_flags(settings%profile == "release") else - model%fortran_compiler = settings%compiler - endif + flags = settings%flag + select case(settings%profile) + case("release", "debug") + flags = flags // model%compiler%get_default_flags(settings%profile == "release") + end select + end if - 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) + write(build_name, '(z16.16)') fnv_1a(flags) - if (is_unknown_compiler(model%fortran_compiler)) then + if (model%compiler%is_unknown()) 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)//'_'//build_name) - call get_module_flags(model%fortran_compiler, & - & join_path(model%output_directory,model%package_name), & - & model%fortran_compile_flags) - model%fortran_compile_flags = settings%flag // model%fortran_compile_flags + model%fortran_compile_flags = flags // " " // & + & model%compiler%get_module_flag(join_path(model%output_directory, model%package_name)) allocate(model%packages(model%deps%ndep)) @@ -191,9 +191,9 @@ subroutine build_model(model, settings, package, error) if (allocated(error)) return 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> BUILD_NAME: ',build_name + 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 @@ -236,7 +236,7 @@ subroutine check_modules_for_duplicates(model, duplicates_found) if (allocated(model%packages(k)%sources(l)%modules_provided)) then do m=1,size(model%packages(k)%sources(l)%modules_provided) if (model%packages(k)%sources(l)%modules_provided(m)%s.in.modules(:modi-1)) then - write(error_unit, *) "Warning: Module ",model%packages(k)%sources(l)%modules_provided(m)%s, & + write(stderr, *) "Warning: Module ",model%packages(k)%sources(l)%modules_provided(m)%s, & " in ",model%packages(k)%sources(l)%file_name," is a duplicate" duplicates_found = .true. else 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_command_line.f90 b/src/fpm_command_line.f90 index 959a13f..9c2da6b 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -31,7 +31,6 @@ use M_CLI2, only : get_subcommand, CLI_RESPONSE_FILE use fpm_strings, only : lower, split, fnv_1a, to_fortran_name, is_fortran_name use fpm_filesystem, only : basename, canon_path, which use fpm_environment, only : run, get_command_arguments_quoted -use fpm_compiler, only : get_default_compile_flags use fpm_error, only : fpm_stop use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, & & stdout=>output_unit, & @@ -70,7 +69,6 @@ type, extends(fpm_cmd_settings) :: fpm_build_settings logical :: show_model=.false. character(len=:),allocatable :: compiler character(len=:),allocatable :: profile - character(len=:),allocatable :: build_name character(len=:),allocatable :: flag end type @@ -113,7 +111,7 @@ character(len=20),parameter :: manual(*)=[ character(len=20) ::& & ' ', 'fpm', 'new', 'build', 'run', & & 'test', 'runner', 'install', 'update', 'list', 'help', 'version' ] -character(len=:), allocatable :: val_runner, val_build, val_compiler, val_flag, val_profile +character(len=:), allocatable :: val_runner, val_compiler, val_flag, val_profile contains subroutine get_command_line_settings(cmd_settings) @@ -199,7 +197,6 @@ contains if(specified('runner') .and. val_runner.eq.'')val_runner='echo' cmd_settings=fpm_run_settings(& & args=remaining,& - & build_name=val_build,& & profile=val_profile,& & compiler=val_compiler, & & flag=val_flag, & @@ -223,7 +220,6 @@ contains allocate( fpm_build_settings :: cmd_settings ) cmd_settings=fpm_build_settings( & - & build_name=val_build,& & profile=val_profile,& & compiler=val_compiler, & & flag=val_flag, & @@ -361,7 +357,6 @@ contains allocate(install_settings) install_settings = fpm_install_settings(& list=lget('list'), & - build_name=val_build, & profile=val_profile,& compiler=val_compiler, & flag=val_flag, & @@ -417,7 +412,6 @@ contains if(specified('runner') .and. val_runner.eq.'')val_runner='echo' cmd_settings=fpm_test_settings(& & args=remaining, & - & build_name=val_build, & & profile=val_profile, & & compiler=val_compiler, & & flag=val_flag, & @@ -487,17 +481,6 @@ contains val_flag = " " // sget('flag') val_profile = sget('profile') - if (val_flag == '') then - call get_default_compile_flags(val_compiler, val_profile == "release", val_flag) - else - select case(val_profile) - case("release", "debug") - call get_default_compile_flags(val_compiler, val_profile == "release", flags) - val_flag = flags // val_flag - end select - end if - allocate(character(len=16) :: val_build) - write(val_build, '(z16.16)') fnv_1a(val_flag) end subroutine check_build_vals diff --git a/src/fpm_compiler.f90 b/src/fpm_compiler.f90 index b3e3a56..32dfe33 100644 --- a/src/fpm_compiler.f90 +++ b/src/fpm_compiler.f90 @@ -26,9 +26,9 @@ ! 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_env, & get_os_type, & OS_LINUX, & OS_MACOS, & @@ -38,13 +38,12 @@ use fpm_environment, only: & OS_FREEBSD, & OS_OPENBSD, & OS_UNKNOWN +use fpm_filesystem, only: join_path, basename, get_temp_filename, delete_file, unix_path, & + & getline +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, new_compiler, archiver_t, new_archiver +public :: debug enum, bind(C) enumerator :: & @@ -55,7 +54,6 @@ enum, bind(C) id_intel_classic_nix, & id_intel_classic_mac, & id_intel_classic_windows, & - id_intel_classic_unknown, & id_intel_llvm_nix, & id_intel_llvm_windows, & id_intel_llvm_unknown, & @@ -70,114 +68,206 @@ enum, bind(C) end enum integer, parameter :: compiler_enum = kind(id_unknown) + +!> Definition of compiler object +type :: compiler_t + !> Identifier of the compiler + integer(compiler_enum) :: id = id_unknown + !> 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 + !> Get default compiler flags + procedure :: get_default_flags + !> Get flag for module output directories + procedure :: get_module_flag + !> Get flag for include directories + procedure :: get_include_flag + !> Compile a Fortran object + procedure :: compile_fortran + !> Compile a C object + procedure :: compile_c + !> Link executable + procedure :: link + !> Check whether compiler is recognized + procedure :: is_unknown +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 + + +!> Create debug printout +interface debug + module procedure :: debug_compiler + module procedure :: debug_archiver +end interface debug + +character(*), parameter :: & + flag_gnu_coarray = " -fcoarray=single", & + flag_gnu_backtrace = " -fbacktrace", & + flag_gnu_opt = " -O3 -funroll-loops", & + flag_gnu_debug = " -g", & + flag_gnu_pic = " -fPIC", & + flag_gnu_warn = " -Wall -Wextra -Wimplicit-interface", & + flag_gnu_check = " -fcheck=bounds -fcheck=array-temps", & + flag_gnu_limit = " -fmax-errors=1", & + flag_gnu_external = " -Wimplicit-interface" + +character(*), parameter :: & + flag_pgi_backslash = " -Mbackslash", & + flag_pgi_traceback = " -traceback", & + flag_pgi_debug = " -g", & + flag_pgi_check = " -Mbounds -Mchkptr -Mchkstk", & + flag_pgi_warn = " -Minform=inform" + +character(*), parameter :: & + flag_intel_backtrace = " -traceback", & + flag_intel_warn = " -warn all", & + flag_intel_check = " -check all", & + flag_intel_debug = " -O0 -g", & + flag_intel_fp = " -fp-model precise -pc64", & + flag_intel_align = " -align all", & + flag_intel_limit = " -error-limit 1", & + flag_intel_pthread = " -reentrancy threaded", & + flag_intel_nogen = " -nogen-interfaces", & + flag_intel_byterecl = " -assume byterecl" + +character(*), parameter :: & + flag_intel_backtrace_win = " /traceback", & + flag_intel_warn_win = " /warn:all", & + flag_intel_check_win = " /check:all", & + flag_intel_debug_win = " /Od /Z7", & + flag_intel_fp_win = " /fp-model:precise", & + flag_intel_align_win = " /align:all", & + flag_intel_limit_win = " /error-limit:1", & + flag_intel_pthread_win = " /reentrancy:threaded", & + flag_intel_nogen_win = " /nogen-interfaces", & + flag_intel_byterecl_win = " /assume:byterecl" + +character(*), parameter :: & + flag_nag_coarray = " -coarray=single", & + flag_nag_pic = " -PIC", & + flag_nag_check = " -C=all", & + flag_nag_debug = " -g -O0", & + flag_nag_opt = " -O4", & + flag_nag_backtrace = " -gline" -subroutine get_default_compile_flags(compiler, release, flags) - character(len=*), intent(in) :: compiler +contains + + +function get_default_flags(self, release) result(flags) + class(compiler_t), intent(in) :: self logical, intent(in) :: release - character(len=:), allocatable, intent(out) :: flags - integer :: id + character(len=:), allocatable :: flags - id = get_compiler_id(compiler) if (release) then - call get_release_compile_flags(id, flags) + call get_release_compile_flags(self%id, flags) else - call get_debug_compile_flags(id, flags) + call get_debug_compile_flags(self%id, flags) end if -end subroutine get_default_compile_flags +end function get_default_flags subroutine get_release_compile_flags(id, flags) integer(compiler_enum), intent(in) :: id character(len=:), allocatable, intent(out) :: flags + select case(id) case default flags = "" case(id_caf) - flags='& - & -O3& - & -Wimplicit-interface& - & -fPIC& - & -fmax-errors=1& - & -funroll-loops& - &' + flags = & + flag_gnu_opt//& + flag_gnu_external//& + flag_gnu_pic//& + flag_gnu_limit + case(id_gcc) - flags='& - & -O3& - & -Wimplicit-interface& - & -fPIC& - & -fmax-errors=1& - & -funroll-loops& - & -fcoarray=single& - &' + flags = & + flag_gnu_opt//& + flag_gnu_external//& + flag_gnu_pic//& + flag_gnu_limit//& + flag_gnu_coarray + case(id_f95) - flags='& - & -O3& - & -Wimplicit-interface& - & -fPIC& - & -fmax-errors=1& - & -ffast-math& - & -funroll-loops& - &' + flags = & + flag_gnu_opt//& + flag_gnu_external//& + flag_gnu_pic//& + flag_gnu_limit + case(id_nvhpc) - flags = '& - & -Mbackslash& - &' - case(id_intel_classic_nix, id_intel_classic_unknown) - flags = '& - & -fp-model precise& - & -pc64& - & -align all& - & -error-limit 1& - & -reentrancy threaded& - & -nogen-interfaces& - & -assume byterecl& - &' + flags = & + flag_pgi_backslash + + case(id_intel_classic_nix) + flags = & + flag_intel_fp//& + flag_intel_align//& + flag_intel_limit//& + flag_intel_pthread//& + flag_intel_nogen//& + flag_intel_byterecl + case(id_intel_classic_mac) - flags = '& - & -fp-model precise& - & -pc64& - & -align all& - & -error-limit 1& - & -reentrancy threaded& - & -nogen-interfaces& - & -assume byterecl& - &' + flags = & + flag_intel_fp//& + flag_intel_align//& + flag_intel_limit//& + flag_intel_pthread//& + flag_intel_nogen//& + flag_intel_byterecl + case(id_intel_classic_windows) - flags = '& - & /fp:precise& - & /align:all& - & /error-limit:1& - & /reentrancy:threaded& - & /nogen-interfaces& - & /assume:byterecl& - &' - case(id_intel_llvm_nix, id_intel_llvm_unknown) - flags = '& - & -fp-model=precise& - & -pc64& - & -align all& - & -error-limit 1& - & -reentrancy threaded& - & -nogen-interfaces& - & -assume byterecl& - &' + flags = & + & flag_intel_fp_win//& + flag_intel_align_win//& + flag_intel_limit_win//& + flag_intel_pthread_win//& + flag_intel_nogen_win//& + flag_intel_byterecl_win + + case(id_intel_llvm_nix) + flags = & + flag_intel_fp//& + flag_intel_align//& + flag_intel_limit//& + flag_intel_pthread//& + flag_intel_nogen//& + flag_intel_byterecl + case(id_intel_llvm_windows) - flags = '& - & /fp:precise& - & /align:all& - & /error-limit:1& - & /reentrancy:threaded& - & /nogen-interfaces& - & /assume:byterecl& - &' + flags = & + flag_intel_fp_win//& + flag_intel_align_win//& + flag_intel_limit_win//& + flag_intel_pthread_win//& + flag_intel_nogen_win//& + flag_intel_byterecl_win + case(id_nag) - flags = ' & - & -O4& - & -coarray=single& - & -PIC& - &' + flags = & + flag_nag_opt//& + flag_nag_coarray//& + flag_nag_pic + end select end subroutine get_release_compile_flags @@ -189,147 +279,142 @@ subroutine get_debug_compile_flags(id, flags) case default flags = "" case(id_caf) - flags = '& - & -Wall& - & -Wextra& - & -Wimplicit-interface& - & -fPIC -fmax-errors=1& - & -g& - & -fcheck=bounds& - & -fcheck=array-temps& - & -fbacktrace& - &' + flags = & + flag_gnu_warn//& + flag_gnu_pic//& + flag_gnu_limit//& + flag_gnu_debug//& + flag_gnu_check//& + flag_gnu_backtrace case(id_gcc) - flags = '& - & -Wall& - & -Wextra& - & -Wimplicit-interface& - & -fPIC -fmax-errors=1& - & -g& - & -fcheck=bounds& - & -fcheck=array-temps& - & -fbacktrace& - & -fcoarray=single& - &' + flags = & + flag_gnu_warn//& + flag_gnu_pic//& + flag_gnu_limit//& + flag_gnu_debug//& + flag_gnu_check//& + flag_gnu_backtrace//& + flag_gnu_coarray case(id_f95) - flags = '& - & -Wall& - & -Wextra& - & -Wimplicit-interface& - & -fPIC -fmax-errors=1& - & -g& - & -fcheck=bounds& - & -fcheck=array-temps& - & -Wno-maybe-uninitialized -Wno-uninitialized& - & -fbacktrace& - &' + flags = & + flag_gnu_warn//& + flag_gnu_pic//& + flag_gnu_limit//& + flag_gnu_debug//& + flag_gnu_check//& + ' -Wno-maybe-uninitialized -Wno-uninitialized'//& + flag_gnu_backtrace case(id_nvhpc) - flags = '& - & -Minform=inform& - & -Mbackslash& - & -g& - & -Mbounds& - & -Mchkptr& - & -Mchkstk& - & -traceback& - &' - case(id_intel_classic_nix, id_intel_classic_unknown) - flags = '& - & -warn all& - & -check all& - & -error-limit 1& - & -O0& - & -g& - & -assume byterecl& - & -traceback& - &' + flags = & + flag_pgi_warn//& + flag_pgi_backslash//& + flag_pgi_check//& + flag_pgi_traceback + case(id_intel_classic_nix) + flags = & + flag_intel_warn//& + flag_intel_check//& + flag_intel_limit//& + flag_intel_debug//& + flag_intel_byterecl//& + flag_intel_backtrace case(id_intel_classic_mac) - flags = '& - & -warn all& - & -check all& - & -error-limit 1& - & -O0& - & -g& - & -assume byterecl& - & -traceback& - &' + flags = & + flag_intel_warn//& + flag_intel_check//& + flag_intel_limit//& + flag_intel_debug//& + flag_intel_byterecl//& + flag_intel_backtrace case(id_intel_classic_windows) - flags = '& - & /warn:all& - & /check:all& - & /error-limit:1& - & /Od& - & /Z7& - & /assume:byterecl& - & /traceback& - &' - case(id_intel_llvm_nix, id_intel_llvm_unknown) - flags = '& - & -warn all& - & -check all& - & -error-limit 1& - & -O0& - & -g& - & -assume byterecl& - & -traceback& - &' + flags = & + flag_intel_warn_win//& + flag_intel_check_win//& + flag_intel_limit_win//& + flag_intel_debug_win//& + flag_intel_byterecl_win//& + flag_intel_backtrace_win + case(id_intel_llvm_nix) + flags = & + flag_intel_warn//& + flag_intel_check//& + flag_intel_limit//& + flag_intel_debug//& + flag_intel_byterecl//& + flag_intel_backtrace case(id_intel_llvm_windows) - flags = '& - & /warn:all& - & /check:all& - & /error-limit:1& - & /Od& - & /Z7& - & /assume:byterecl& - &' + flags = & + flag_intel_warn_win//& + flag_intel_check_win//& + flag_intel_limit_win//& + flag_intel_debug_win//& + flag_intel_byterecl_win case(id_nag) - flags = '& - & -g& - & -C=all& - & -O0& - & -gline& - & -coarray=single& - & -PIC& - &' + flags = & + flag_nag_debug//& + flag_nag_check//& + flag_nag_backtrace//& + flag_nag_coarray//& + flag_nag_pic end select end subroutine get_debug_compile_flags -subroutine get_module_flags(compiler, modpath, flags) - character(len=*), intent(in) :: compiler - character(len=*), intent(in) :: modpath - character(len=:), allocatable, intent(out) :: flags - integer(compiler_enum) :: id +function get_include_flag(self, path) result(flags) + class(compiler_t), intent(in) :: self + character(len=*), intent(in) :: path + character(len=:), allocatable :: flags + + select case(self%id) + case default + flags = "-I "//path - id = get_compiler_id(compiler) + case(id_caf, id_gcc, id_f95, id_cray, id_nvhpc, id_pgi, id_flang, & + & id_intel_classic_nix, id_intel_classic_mac, & + & id_intel_llvm_nix, id_lahey, id_nag, id_ibmxl) + flags = "-I "//path - select case(id) + case(id_intel_classic_windows, id_intel_llvm_windows) + flags = "/I"//path + + end select +end function get_include_flag + +function get_module_flag(self, path) result(flags) + class(compiler_t), intent(in) :: self + character(len=*), intent(in) :: path + character(len=:), allocatable :: flags + + select case(self%id) case default - flags=' -module '//modpath//' -I '//modpath + flags = "-module "//path case(id_caf, id_gcc, id_f95, id_cray) - flags=' -J '//modpath//' -I '//modpath + flags = "-J "//path case(id_nvhpc, id_pgi, id_flang) - flags=' -module '//modpath//' -I '//modpath + flags = "-module "//path - case(id_intel_classic_nix, id_intel_classic_mac, id_intel_classic_unknown, id_intel_llvm_nix, id_intel_llvm_unknown) - flags=' -module '//modpath//' -I'//modpath + case(id_intel_classic_nix, id_intel_classic_mac, & + & id_intel_llvm_nix) + flags = "-module "//path case(id_intel_classic_windows, id_intel_llvm_windows) - flags=' /module:'//modpath//' /I'//modpath + flags = "/module:"//path case(id_lahey) - flags=' -M '//modpath//' -I '//modpath + flags = "-M "//path case(id_nag) - flags=' -mdir '//modpath//' -I '//modpath ! + flags = "-mdir "//path case(id_ibmxl) - flags=' -qmoddir '//modpath//' -I '//modpath + flags = "-qmoddir "//path end select + flags = flags//" "//self%get_include_flag(path) + +end function get_module_flag -end subroutine get_module_flags subroutine get_default_c_compiler(f_compiler, c_compiler) character(len=*), intent(in) :: f_compiler @@ -340,10 +425,10 @@ subroutine get_default_c_compiler(f_compiler, c_compiler) select case(id) - case(id_intel_classic_nix, id_intel_classic_mac, id_intel_classic_windows, id_intel_classic_unknown) + case(id_intel_classic_nix, id_intel_classic_mac, id_intel_classic_windows) c_compiler = 'icc' - case(id_intel_llvm_nix,id_intel_llvm_windows, id_intel_llvm_unknown) + case(id_intel_llvm_nix,id_intel_llvm_windows) c_compiler = 'icx' case(id_flang) @@ -359,10 +444,44 @@ subroutine get_default_c_compiler(f_compiler, c_compiler) end subroutine get_default_c_compiler + function get_compiler_id(compiler) result(id) character(len=*), intent(in) :: compiler integer(kind=compiler_enum) :: id + character(len=:), allocatable :: command, output + integer :: stat, io + + ! Check whether we are dealing with an MPI compiler wrapper first + if (check_compiler(compiler, "mpifort") & + & .or. check_compiler(compiler, "mpif90") & + & .or. check_compiler(compiler, "mpif77")) then + output = get_temp_filename() + call run(compiler//" -showme:command > "//output//" 2>&1", & + & echo=.false., exitstat=stat) + if (stat == 0) then + open(file=output, newunit=io, iostat=stat) + if (stat == 0) call getline(io, command, stat) + close(io, iostat=stat) + + ! If we get a command from the wrapper, we will try to identify it + if (allocated(command)) then + id = get_id(command) + if (id /= id_unknown) return + end if + end if + end if + + id = get_id(compiler) + +end function get_compiler_id + +function get_id(compiler) result(id) + character(len=*), intent(in) :: compiler + integer(kind=compiler_enum) :: id + + integer :: stat + if (check_compiler(compiler, "gfortran")) then id = id_gcc return @@ -380,26 +499,22 @@ function get_compiler_id(compiler) result(id) if (check_compiler(compiler, "ifort")) then select case (get_os_type()) - case (OS_LINUX, OS_SOLARIS, OS_FREEBSD) + case default id = id_intel_classic_nix case (OS_MACOS) id = id_intel_classic_mac case (OS_WINDOWS, OS_CYGWIN) id = id_intel_classic_windows - case default - id = id_intel_classic_unknown end select return end if if (check_compiler(compiler, "ifx")) then select case (get_os_type()) - case (OS_LINUX, OS_SOLARIS, OS_FREEBSD) + case default id = id_intel_llvm_nix case (OS_WINDOWS, OS_CYGWIN) id = id_intel_llvm_windows - case default - id = id_intel_llvm_unknown end select return end if @@ -448,7 +563,7 @@ function get_compiler_id(compiler) result(id) id = id_unknown -end function get_compiler_id +end function get_id function check_compiler(compiler, expected) result(match) character(len=*), intent(in) :: compiler @@ -460,29 +575,165 @@ 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 + +pure function is_unknown(self) + class(compiler_t), intent(in) :: self logical :: is_unknown - is_unknown = get_compiler_id(compiler) == id_unknown -end function is_unknown_compiler + is_unknown = self%id == id_unknown +end function is_unknown + + +!> Create new compiler instance +subroutine new_compiler(self, fc) + !> Fortran compiler name or path + character(len=*), intent(in) :: fc + !> New instance of the compiler + type(compiler_t), intent(out) :: self + character(len=*), parameter :: cc_env = "FPM_C_COMPILER" -function get_archiver() result(archiver) - character(:), allocatable :: archiver + self%id = get_compiler_id(fc) + + self%fc = fc + call get_default_c_compiler(self%fc, self%cc) + self%cc = get_env(cc_env, self%cc) +end subroutine new_compiler + + +!> Create new archiver instance +subroutine new_archiver(self) + !> New instance of the archiver + type(archiver_t), intent(out) :: 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 subroutine 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 |