From c6f0ec64b8060523beaf828ceae32fa3827f65fb Mon Sep 17 00:00:00 2001 From: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> Date: Fri, 30 Jul 2021 19:59:26 +0200 Subject: Move default flags fetching and build name generation to model --- src/fpm.f90 | 39 +++++++------- src/fpm_command_line.f90 | 19 +------ src/fpm_compiler.f90 | 131 ++++++++++++++++++++++++++++++----------------- 3 files changed, 107 insertions(+), 82 deletions(-) (limited to 'src') diff --git a/src/fpm.f90 b/src/fpm.f90 index 465d16e..53c5767 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, & - archiver_t +use fpm_compiler, only: new_compiler, new_archiver use fpm_sources, only: add_executable_sources, add_sources_from_dir @@ -43,10 +42,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 @@ -58,27 +58,30 @@ subroutine build_model(model, settings, package, error) call model%deps%add(package, error) if (allocated(error)) return - if(settings%compiler.eq.'')then - model%compiler%fc = "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%compiler%fc = 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 = archiver_t() - call get_default_c_compiler(model%compiler%fc, model%compiler%cc) - model%compiler%cc = get_env('FPM_C_COMPILER',model%compiler%cc) + write(build_name, '(z16.16)') fnv_1a(flags) - if (is_unknown_compiler(model%compiler%fc)) then + if (model%compiler%is_unknown()) then write(*, '(*(a:,1x))') & "", "Unknown compiler", model%compiler%fc, "requested!", & "Defaults for this compiler might be incorrect" end if - model%output_directory = join_path('build',basename(model%compiler%fc)//'_'//settings%build_name) + model%output_directory = join_path('build',basename(model%compiler%fc)//'_'//build_name) - 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 + model%fortran_compile_flags = flags // " " // & + & model%compiler%get_module_flag(join_path(model%output_directory, model%package_name)) allocate(model%packages(model%deps%ndep)) @@ -186,7 +189,7 @@ subroutine build_model(model, settings, package, error) if (allocated(error)) return if (settings%verbose) then - write(*,*)' BUILD_NAME: ',settings%build_name + write(*,*)' BUILD_NAME: ',build_name write(*,*)' COMPILER: ',model%compiler%fc write(*,*)' C COMPILER: ',model%compiler%cc write(*,*)' COMPILER OPTIONS: ', model%fortran_compile_flags diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 86e6d5d..90d7198 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 b432f11..a6d9871 100644 --- a/src/fpm_compiler.f90 +++ b/src/fpm_compiler.f90 @@ -28,6 +28,7 @@ module fpm_compiler use fpm_environment, only: & run, & + get_env, & get_os_type, & OS_LINUX, & OS_MACOS, & @@ -40,13 +41,7 @@ use fpm_environment, only: & 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 :: compiler_t, archiver_t +public :: compiler_t, new_compiler, archiver_t, new_archiver public :: debug enum, bind(C) @@ -76,6 +71,8 @@ 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 @@ -83,12 +80,20 @@ type :: compiler_t !> 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 @@ -106,12 +111,6 @@ contains 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 @@ -121,20 +120,19 @@ end interface debug contains -subroutine get_default_compile_flags(compiler, release, flags) - character(len=*), intent(in) :: compiler + +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 @@ -343,42 +341,63 @@ subroutine get_debug_compile_flags(id, flags) 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 - id = get_compiler_id(compiler) + select case(self%id) + case default + flags = "-I "//path - select case(id) + 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_classic_unknown, & + & id_intel_llvm_nix, id_intel_llvm_unknown, id_lahey, id_nag, & + & id_ibmxl) + flags = "-I "//path + + 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_classic_unknown, & + & id_intel_llvm_nix, id_intel_llvm_unknown) + 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 @@ -408,10 +427,13 @@ 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 + integer :: stat + if (check_compiler(compiler, "gfortran")) then id = id_gcc return @@ -510,17 +532,34 @@ function check_compiler(compiler, expected) result(match) 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" + + 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 -function new_archiver() result(self) +!> Create new archiver instance +subroutine new_archiver(self) !> New instance of the archiver - type(archiver_t) :: self + type(archiver_t), intent(out) :: self integer :: estat, os_type os_type = get_os_type() @@ -537,7 +576,7 @@ function new_archiver() result(self) end if self%use_response_file = os_type == OS_WINDOWS self%echo = .true. -end function new_archiver +end subroutine new_archiver !> Compile a Fortran object -- cgit v1.2.3