From ee0d46c85819ba345714df724556aaae6d72c2cf Mon Sep 17 00:00:00 2001 From: kubajj Date: Mon, 31 May 2021 18:04:25 +0200 Subject: [PATCH 01/32] Initial branch commit - new_package subroutine parses TOML and loads in all fully defined profiles and stores them in a list --- src/fpm/manifest/package.f90 | 21 ++- src/fpm/manifest/profiles.f90 | 270 ++++++++++++++++++++++++++++++++++ 2 files changed, 290 insertions(+), 1 deletion(-) create mode 100644 src/fpm/manifest/profiles.f90 diff --git a/src/fpm/manifest/package.f90 b/src/fpm/manifest/package.f90 index bbaa51d9e8..e7af0c46f1 100644 --- a/src/fpm/manifest/package.f90 +++ b/src/fpm/manifest/package.f90 @@ -33,6 +33,7 @@ module fpm_manifest_package use fpm_manifest_build, only: build_config_t, new_build_config use fpm_manifest_dependency, only : dependency_config_t, new_dependencies + use fpm_manifest_profile, only : profile_config_t, new_profiles use fpm_manifest_example, only : example_config_t, new_example use fpm_manifest_executable, only : executable_config_t, new_executable use fpm_manifest_library, only : library_config_t, new_library @@ -81,6 +82,9 @@ module fpm_manifest_package !> Development dependency meta data type(dependency_config_t), allocatable :: dev_dependency(:) + !> Profiles meta data + type(profile_config_t), allocatable :: profiles(:) + !> Example meta data type(example_config_t), allocatable :: example(:) @@ -177,6 +181,12 @@ subroutine new_package(self, table, error) call new_library(self%library, child, error) if (allocated(error)) return end if + + call get_value(table, "profiles", child, requested=.false.) + if (associated(child)) then + call new_profiles(self%profiles, child, error) + if (allocated(error)) return + end if call get_value(table, "executable", children, requested=.false.) if (associated(children)) then @@ -276,7 +286,7 @@ subroutine check(table, error) case("version", "license", "author", "maintainer", "copyright", & & "description", "keywords", "categories", "homepage", "build", & - & "dependencies", "dev-dependencies", "test", "executable", & + & "dependencies", "dev-dependencies", "profiles", "test", "executable", & & "example", "library", "install") continue @@ -373,6 +383,15 @@ subroutine info(self, unit, verbosity) call self%dev_dependency(ii)%info(unit, pr - 1) end do end if + + if (allocated(self%profiles)) then + if (size(self%profiles) > 1 .or. pr > 2) then + write(unit, fmti) "- profiles", size(self%profiles) + end if + do ii = 1, size(self%profiles) + call self%profiles(ii)%info(unit, pr - 1) + end do + end if end subroutine info diff --git a/src/fpm/manifest/profiles.f90 b/src/fpm/manifest/profiles.f90 new file mode 100644 index 0000000000..328c0aeafb --- /dev/null +++ b/src/fpm/manifest/profiles.f90 @@ -0,0 +1,270 @@ +module fpm_manifest_profile + use fpm_error, only : error_t, syntax_error + use fpm_git, only : git_target_t, git_target_tag, git_target_branch, & + & git_target_revision, git_target_default + use fpm_toml, only : toml_table, toml_key, toml_stat, get_value + implicit none + private + + public :: profile_config_t, new_profile, new_profiles + + !> Configuration meta data for a profile + type :: profile_config_t + !> Name of the profile + character(len=:), allocatable :: profile_name + + !> Name of the compiler + character(len=:), allocatable :: compiler + + !> Name of the OS + character(len=:), allocatable :: os + + !> Compiler flags + character(len=:), allocatable :: compiler_flags + + contains + + !> Print information on this instance + procedure :: info + end type profile_config_t + + contains + + !> Construct a new profile configuration from a TOML data structure + subroutine new_profile(self, profile_name, compiler, os, compiler_flags, error) + type(profile_config_t), intent(out) :: self + + !> Name of the profile + character(len=:), allocatable, intent(in) :: profile_name + + !> Name of the compiler + character(len=:), allocatable, intent(in) :: compiler + + !> Name of the OS + character(len=:), allocatable, intent(in) :: os + + !> Compiler flags + character(len=:), allocatable, intent(in) :: compiler_flags + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + self%profile_name = profile_name + self%compiler = compiler + self%os = os + self%compiler_flags = compiler_flags + end subroutine new_profile + + !> Check if compiler name is a valid compiler name + subroutine validate_compiler_name(compiler_name, is_valid) + character(len=:), allocatable, intent(in) :: compiler_name + logical, intent(out) :: is_valid + select case(compiler_name) + case("gfortran", "ifort", "ifx", "pgfortran", "nvfrotran", "flang", & + &"lfortran", "lfc", "nagfor", "crayftn", "xlf90", "ftn95") + is_valid = .true. + case default + is_valid = .false. + end select + end subroutine validate_compiler_name + + !> Traverse operating system tables + subroutine traverse_oss(profile_name, compiler_name, os_list, table, error, profiles_size, profiles, profindex) + + !> Name of profile + character(len=:), allocatable, intent(in) :: profile_name + + !> Name of compiler + character(len=:), allocatable, intent(in) :: compiler_name + + !> List of OSs in table with profile name and compiler name given + type(toml_key), allocatable, intent(in) :: os_list(:) + + !> Table containing OS tables + type(toml_table), pointer, intent(in) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + !> Number of profiles in list of profiles + integer, intent(inout), optional :: profiles_size + + !> List of profiles + type(profile_config_t), allocatable, intent(inout), optional :: profiles(:) + + !> Index in the list of profiles + integer, intent(inout), optional :: profindex + + character(len=:), allocatable :: os_name + type(toml_table), pointer :: os_node + character(len=:), allocatable :: compiler_flags + integer :: ios, stat + + if (size(os_list)<1) return + do ios = 1, size(os_list) + if (present(profiles_size)) then + profiles_size = profiles_size + 1 + else + if (.not.(present(profiles).and.present(profindex))) then + print *,"Error in traverse_oss" + return + end if + os_name = os_list(ios)%key + call get_value(table, os_name, os_node, stat=stat) + if (stat /= toml_stat%success) then + call syntax_error(error, "OS "//os_list(ios)%key//" must be a table entry") + exit + end if + call get_value(os_node, 'flags', compiler_flags, stat=stat) + if (stat /= toml_stat%success) then + call syntax_error(error, "Compiler flags "//compiler_flags//" must be a table entry") + exit + end if + call new_profile(profiles(profindex), profile_name, compiler_name, os_name, compiler_flags, error) + profindex = profindex + 1 + end if + end do + end subroutine traverse_oss + + !> Traverse compiler tables + subroutine traverse_compilers(profile_name, comp_list, table, error, profiles_size, profiles, profindex) + + !> Name of profile + character(len=:), allocatable, intent(in) :: profile_name + + !> List of OSs in table with profile name given + type(toml_key), allocatable, intent(in) :: comp_list(:) + + !> Table containing compiler tables + type(toml_table), pointer, intent(in) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + !> Number of profiles in list of profiles + integer, intent(inout), optional :: profiles_size + + !> List of profiles + type(profile_config_t), allocatable, intent(inout), optional :: profiles(:) + + !> Index in the list of profiles + integer, intent(inout), optional :: profindex + + character(len=:), allocatable :: compiler_name + type(toml_table), pointer :: comp_node + type(toml_key), allocatable :: os_list(:) + integer :: icomp, stat + logical :: is_valid + + if (size(comp_list)<1) return + do icomp = 1, size(comp_list) + call validate_compiler_name(comp_list(icomp)%key, is_valid) + if (is_valid) then + compiler_name = comp_list(icomp)%key + call get_value(table, compiler_name, comp_node, stat=stat) + if (stat /= toml_stat%success) then + call syntax_error(error, "Compiler "//comp_list(icomp)%key//" must be a table entry") + exit + end if + call comp_node%get_keys(os_list) + if (present(profiles_size)) then + call traverse_oss(profile_name, compiler_name, os_list, comp_node, error, profiles_size=profiles_size) + else + if (.not.(present(profiles).and.present(profindex))) then + print *,"Error in traverse_compilers" + return + end if + call traverse_oss(profile_name, compiler_name, os_list, comp_node, & + & error, profiles=profiles, profindex=profindex) + end if + end if + end do + end subroutine traverse_compilers + + !> Construct new profiles array from a TOML data structure + subroutine new_profiles(profiles, table, error) + + !> Instance of the dependency configuration + type(profile_config_t), allocatable, intent(out) :: profiles(:) + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table), pointer :: prof_node + type(toml_key), allocatable :: prof_list(:) + type(toml_key), allocatable :: comp_list(:) + character(len=:), allocatable :: profile_name + integer :: profiles_size, iprof, stat, profindex + + call table%get_keys(prof_list) + + if (size(prof_list) < 1) return + + profiles_size = 0 + + do iprof = 1, size(prof_list) + profile_name = prof_list(iprof)%key + call get_value(table, profile_name, prof_node, stat=stat) + if (stat /= toml_stat%success) then + call syntax_error(error, "Profile "//prof_list(iprof)%key//" must be a table entry") + exit + end if + call prof_node%get_keys(comp_list) + call traverse_compilers(profile_name, comp_list, prof_node, error, profiles_size=profiles_size) + end do + + allocate(profiles(profiles_size)) + + profindex = 1 + + do iprof = 1, size(prof_list) + profile_name = prof_list(iprof)%key + call get_value(table, profile_name, prof_node, stat=stat) + call prof_node%get_keys(comp_list) + call traverse_compilers(profile_name, comp_list, prof_node, error, profiles=profiles, profindex=profindex) + end do + end subroutine new_profiles + + !> Write information on instance + subroutine info(self, unit, verbosity) + + !> Instance of the profile configuration + class(profile_config_t), intent(in) :: self + + !> Unit for IO + integer, intent(in) :: unit + + !> Verbosity of the printout + integer, intent(in), optional :: verbosity + + integer :: pr + character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)' + + if (present(verbosity)) then + pr = verbosity + else + pr = 1 + end if + + write(unit, fmt) "Profile" + if (allocated(self%profile_name)) then + write(unit, fmt) "- profile name", self%profile_name + end if + + if (allocated(self%compiler)) then + write(unit, fmt) "- compiler", self%compiler + end if + + if (allocated(self%os)) then + write(unit, fmt) "- os", self%os + end if + + if (allocated(self%compiler_flags)) then + write(unit, fmt) "- compiler flags", self%compiler_flags + end if + + end subroutine info +end module fpm_manifest_profile From a978be3d82cbecf7959f49f6d38669b8b7e7f71d Mon Sep 17 00:00:00 2001 From: kubajj Date: Tue, 1 Jun 2021 13:35:17 +0200 Subject: [PATCH 02/32] Add support for profiles defined with missing values --- src/fpm/manifest/profiles.f90 | 88 +++++++++++++++++++++++++---------- 1 file changed, 64 insertions(+), 24 deletions(-) diff --git a/src/fpm/manifest/profiles.f90 b/src/fpm/manifest/profiles.f90 index 328c0aeafb..bd12f940c5 100644 --- a/src/fpm/manifest/profiles.f90 +++ b/src/fpm/manifest/profiles.f90 @@ -53,6 +53,7 @@ subroutine new_profile(self, profile_name, compiler, os, compiler_flags, error) self%compiler = compiler self%os = os self%compiler_flags = compiler_flags + print *,self%profile_name//" "//self%compiler//" "//self%os//" "//self%compiler_flags end subroutine new_profile !> Check if compiler name is a valid compiler name @@ -106,22 +107,29 @@ subroutine traverse_oss(profile_name, compiler_name, os_list, table, error, prof profiles_size = profiles_size + 1 else if (.not.(present(profiles).and.present(profindex))) then - print *,"Error in traverse_oss" - return + print *,"Error in traverse_oss" + return end if os_name = os_list(ios)%key call get_value(table, os_name, os_node, stat=stat) if (stat /= toml_stat%success) then - call syntax_error(error, "OS "//os_list(ios)%key//" must be a table entry") - exit - end if - call get_value(os_node, 'flags', compiler_flags, stat=stat) - if (stat /= toml_stat%success) then - call syntax_error(error, "Compiler flags "//compiler_flags//" must be a table entry") - exit + call get_value(table, 'flags', compiler_flags, stat=stat) + if (stat /= toml_stat%success) then + call syntax_error(error, "Compiler flags "//compiler_flags//" must be a table entry") + exit + end if + os_name = "all" + call new_profile(profiles(profindex), profile_name, compiler_name, os_name, compiler_flags, error) + profindex = profindex + 1 + else + call get_value(os_node, 'flags', compiler_flags, stat=stat) + if (stat /= toml_stat%success) then + call syntax_error(error, "Compiler flags "//compiler_flags//" must be a table entry") + compiler_flags="did not work" + end if + call new_profile(profiles(profindex), profile_name, compiler_name, os_name, compiler_flags, error) + profindex = profindex + 1 end if - call new_profile(profiles(profindex), profile_name, compiler_name, os_name, compiler_flags, error) - profindex = profindex + 1 end if end do end subroutine traverse_oss @@ -171,12 +179,26 @@ subroutine traverse_compilers(profile_name, comp_list, table, error, profiles_si call traverse_oss(profile_name, compiler_name, os_list, comp_node, error, profiles_size=profiles_size) else if (.not.(present(profiles).and.present(profindex))) then - print *,"Error in traverse_compilers" - return + print *,"Error in traverse_compilers" + return end if call traverse_oss(profile_name, compiler_name, os_list, comp_node, & & error, profiles=profiles, profindex=profindex) end if + else + os_list = comp_list(icomp:icomp) + compiler_name = "default" + + if (present(profiles_size)) then + call traverse_oss(profile_name, compiler_name, os_list, table, error, profiles_size=profiles_size) + else + if (.not.(present(profiles).and.present(profindex))) then + print *,"Error in traverse_compilers" + return + end if + call traverse_oss(profile_name, compiler_name, os_list, table, & + & error, profiles=profiles, profindex=profindex) + end if end if end do end subroutine traverse_compilers @@ -188,7 +210,7 @@ subroutine new_profiles(profiles, table, error) type(profile_config_t), allocatable, intent(out) :: profiles(:) !> Instance of the TOML data structure - type(toml_table), intent(inout) :: table + type(toml_table), target, intent(inout) :: table !> Error handling type(error_t), allocatable, intent(out) :: error @@ -198,6 +220,7 @@ subroutine new_profiles(profiles, table, error) type(toml_key), allocatable :: comp_list(:) character(len=:), allocatable :: profile_name integer :: profiles_size, iprof, stat, profindex + logical :: is_valid call table%get_keys(prof_list) @@ -207,24 +230,41 @@ subroutine new_profiles(profiles, table, error) do iprof = 1, size(prof_list) profile_name = prof_list(iprof)%key - call get_value(table, profile_name, prof_node, stat=stat) - if (stat /= toml_stat%success) then - call syntax_error(error, "Profile "//prof_list(iprof)%key//" must be a table entry") - exit + call validate_compiler_name(profile_name, is_valid) + if (is_valid) then + profile_name = "all" + comp_list = prof_list(iprof:iprof) + prof_node=>table + call traverse_compilers(profile_name, comp_list, prof_node, error, profiles_size=profiles_size) + else + call get_value(table, profile_name, prof_node, stat=stat) + if (stat /= toml_stat%success) then + call syntax_error(error, "Profile "//prof_list(iprof)%key//" must be a table entry") + exit + end if + call prof_node%get_keys(comp_list) + call traverse_compilers(profile_name, comp_list, prof_node, error, profiles_size=profiles_size) end if - call prof_node%get_keys(comp_list) - call traverse_compilers(profile_name, comp_list, prof_node, error, profiles_size=profiles_size) end do - + + print *,"profiles_size is ", profiles_size allocate(profiles(profiles_size)) profindex = 1 do iprof = 1, size(prof_list) profile_name = prof_list(iprof)%key - call get_value(table, profile_name, prof_node, stat=stat) - call prof_node%get_keys(comp_list) - call traverse_compilers(profile_name, comp_list, prof_node, error, profiles=profiles, profindex=profindex) + call validate_compiler_name(profile_name, is_valid) + if (is_valid) then + profile_name = "all" + comp_list = prof_list(iprof:iprof) + prof_node=>table + call traverse_compilers(profile_name, comp_list, prof_node, error, profiles=profiles, profindex=profindex) + else + call get_value(table, profile_name, prof_node, stat=stat) + call prof_node%get_keys(comp_list) + call traverse_compilers(profile_name, comp_list, prof_node, error, profiles=profiles, profindex=profindex) + end if end do end subroutine new_profiles From 648764c4819749374e4e9ec4ef61113f1e661bc1 Mon Sep 17 00:00:00 2001 From: kubajj Date: Thu, 3 Jun 2021 10:01:26 +0200 Subject: [PATCH 03/32] Add first implementation of find_profile subroutine --- src/fpm/manifest/profiles.f90 | 82 ++++++++++++++++++++++++++++++++--- 1 file changed, 76 insertions(+), 6 deletions(-) diff --git a/src/fpm/manifest/profiles.f90 b/src/fpm/manifest/profiles.f90 index bd12f940c5..21c42f372a 100644 --- a/src/fpm/manifest/profiles.f90 +++ b/src/fpm/manifest/profiles.f90 @@ -1,12 +1,13 @@ module fpm_manifest_profile use fpm_error, only : error_t, syntax_error - use fpm_git, only : git_target_t, git_target_tag, git_target_branch, & - & git_target_revision, git_target_default use fpm_toml, only : toml_table, toml_key, toml_stat, get_value + use fpm_strings, only: lower + use fpm_environment, only: get_os_type, OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, & + OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD implicit none private - public :: profile_config_t, new_profile, new_profiles + public :: profile_config_t, new_profile, new_profiles, find_profile !> Configuration meta data for a profile type :: profile_config_t @@ -53,7 +54,6 @@ subroutine new_profile(self, profile_name, compiler, os, compiler_flags, error) self%compiler = compiler self%os = os self%compiler_flags = compiler_flags - print *,self%profile_name//" "//self%compiler//" "//self%os//" "//self%compiler_flags end subroutine new_profile !> Check if compiler name is a valid compiler name @@ -68,6 +68,18 @@ subroutine validate_compiler_name(compiler_name, is_valid) is_valid = .false. end select end subroutine validate_compiler_name + + subroutine validate_os_name(os_name, is_valid) + character(len=:), allocatable, intent(in) :: os_name + logical, intent(out) :: is_valid + select case (os_name) + case ("linux", "macos", "windows", "cygwin", "solaris", "freebsd", & + & "openbsd", "unknown", "UNKNOWN") + is_valid = .true. + case default + is_valid = .false. + end select + end subroutine validate_os_name !> Traverse operating system tables subroutine traverse_oss(profile_name, compiler_name, os_list, table, error, profiles_size, profiles, profindex) @@ -110,8 +122,9 @@ subroutine traverse_oss(profile_name, compiler_name, os_list, table, error, prof print *,"Error in traverse_oss" return end if - os_name = os_list(ios)%key + os_name = os_list(ios)%key call get_value(table, os_name, os_node, stat=stat) + os_name = lower(os_name) if (stat /= toml_stat%success) then call get_value(table, 'flags', compiler_flags, stat=stat) if (stat /= toml_stat%success) then @@ -247,7 +260,6 @@ subroutine new_profiles(profiles, table, error) end if end do - print *,"profiles_size is ", profiles_size allocate(profiles(profiles_size)) profindex = 1 @@ -307,4 +319,62 @@ subroutine info(self, unit, verbosity) end if end subroutine info + + subroutine find_profile(profiles, profile_name, compiler, compiler_flags) + type(profile_config_t), allocatable, intent(in) :: profiles(:) + character(:), allocatable, intent(in) :: profile_name + character(:), allocatable, intent(in) :: compiler + character(:), allocatable, intent(out) :: compiler_flags + character(:), allocatable :: curr_profile_name + character(:), allocatable :: curr_compiler + character(:), allocatable :: curr_os + character(len=:),allocatable :: os_type + type(profile_config_t) :: chosen_profile + integer :: i, priority, curr_priority + + select case (get_os_type()) + case (OS_LINUX); os_type = "linux" + case (OS_MACOS); os_type = "macos" + case (OS_WINDOWS); os_type = "windows" + case (OS_CYGWIN); os_type = "cygwin" + case (OS_SOLARIS); os_type = "solaris" + case (OS_FREEBSD); os_type = "freebsd" + case (OS_OPENBSD); os_type = "openbsd" + case (OS_UNKNOWN); os_type = "unknown" + case default ; os_type = "UNKNOWN" + end select + + print *, os_type + priority = 0 + print *,profile_name,compiler,os_type + do i=1,size(profiles) + curr_priority = 0 + curr_profile_name = profiles(i)%profile_name + curr_compiler = profiles(i)%compiler + curr_os = profiles(i)%os + if (curr_profile_name.eq.profile_name.or.curr_profile_name.eq.'all') then + if (curr_profile_name.eq.'all') then + curr_priority= curr_priority + 4 + end if + if (curr_compiler.eq.compiler.or.curr_compiler.eq.'default') then + if (curr_compiler.eq.'default') then + curr_priority = curr_priority + 2 + end if + if (curr_os.eq.os_type.or.curr_os.eq.'all') then + if (curr_os.eq.'all') then + curr_priority = curr_priority + 1 + end if + print *,"found matching profile with priority ",curr_priority, curr_profile_name//" "//curr_compiler & + &//" "//curr_os//" "//profiles(i)%compiler_flags + if (curr_priority > priority) then + chosen_profile = profiles(i) + priority = curr_priority + print *, priority + end if + end if + end if + end if + end do + compiler_flags = chosen_profile%compiler_flags + end subroutine find_profile end module fpm_manifest_profile From e8ea4498afccc9608aa500daef274370fe3a96df Mon Sep 17 00:00:00 2001 From: kubajj Date: Thu, 3 Jun 2021 10:03:04 +0200 Subject: [PATCH 04/32] Temporary solution of adding compiler flags from profile to model --- src/fpm.f90 | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 5854cfb56b..b11758f493 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -23,6 +23,7 @@ module fpm & stdout=>output_unit, & & stderr=>error_unit use fpm_manifest_dependency, only: dependency_config_t +use fpm_manifest_profile, only: profile_config_t, find_profile use, intrinsic :: iso_fortran_env, only: error_unit implicit none private @@ -42,7 +43,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 :: manifest, lib_dir, compiler_flags logical :: duplicates_found = .false. type(string_t) :: include_dir @@ -63,6 +64,10 @@ subroutine build_model(model, settings, package, error) model%fortran_compiler = settings%compiler endif + if (allocated(package%profiles)) then + call find_profile(package%profiles, settings%profile, model%fortran_compiler, compiler_flags) + print *,"found profile has the following flags: "//compiler_flags + 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) @@ -77,7 +82,11 @@ subroutine build_model(model, settings, package, error) 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 + if (allocated(compiler_flags)) then + model%fortran_compile_flags = " "//compiler_flags // settings%flag // model%fortran_compile_flags + else + model%fortran_compile_flags = settings%flag // model%fortran_compile_flags + end if allocate(model%packages(model%deps%ndep)) From 020c34a9157fc3a629dd1f009e95b1c7395cf865 Mon Sep 17 00:00:00 2001 From: kubajj Date: Fri, 4 Jun 2021 15:08:07 +0200 Subject: [PATCH 05/32] Added built in profiles support, updated find_profile decision making --- src/fpm.f90 | 19 +- src/fpm/manifest/package.f90 | 5 +- src/fpm/manifest/profiles.f90 | 393 ++++++++++++++++++++++++++++------ src/fpm_command_line.f90 | 18 +- 4 files changed, 353 insertions(+), 82 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index b11758f493..b4ac1d73e7 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -4,7 +4,7 @@ module fpm use fpm_command_line, only: fpm_build_settings, fpm_new_settings, & fpm_run_settings, fpm_install_settings, fpm_test_settings use fpm_dependency, only : new_dependency_tree -use fpm_environment, only: run, get_env, get_archiver +use fpm_environment, only: run, get_env, get_archiver, get_os_type use fpm_filesystem, only: is_dir, join_path, number_of_rows, list_files, exists, basename use fpm_model, only: fpm_model_t, srcfile_t, show_model, & FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, FPM_SCOPE_DEP, & @@ -23,7 +23,7 @@ module fpm & stdout=>output_unit, & & stderr=>error_unit use fpm_manifest_dependency, only: dependency_config_t -use fpm_manifest_profile, only: profile_config_t, find_profile +use fpm_manifest_profile, only: profile_config_t, find_profile, DEFAULT_COMPILER use, intrinsic :: iso_fortran_env, only: error_unit implicit none private @@ -43,7 +43,7 @@ subroutine build_model(model, settings, package, error) integer :: i, j type(package_config_t) :: dependency - character(len=:), allocatable :: manifest, lib_dir, compiler_flags + character(len=:), allocatable :: manifest, lib_dir, profile, compiler_flags logical :: duplicates_found = .false. type(string_t) :: include_dir @@ -59,13 +59,20 @@ subroutine build_model(model, settings, package, error) if (allocated(error)) return if(settings%compiler.eq.'')then - model%fortran_compiler = 'gfortran' + model%fortran_compiler = DEFAULT_COMPILER else model%fortran_compiler = settings%compiler endif - if (allocated(package%profiles)) then - call find_profile(package%profiles, settings%profile, model%fortran_compiler, compiler_flags) + if(settings%profile.eq.'')then + if (trim(settings%flag).eq.'') then + profile = 'debug' + end if + else + profile = settings%profile + endif + if (allocated(package%profiles).and.allocated(profile)) then + call find_profile(package%profiles, profile, model%fortran_compiler, get_os_type(), compiler_flags) print *,"found profile has the following flags: "//compiler_flags end if model%archiver = get_archiver() diff --git a/src/fpm/manifest/package.f90 b/src/fpm/manifest/package.f90 index e7af0c46f1..7a73113b45 100644 --- a/src/fpm/manifest/package.f90 +++ b/src/fpm/manifest/package.f90 @@ -33,7 +33,7 @@ module fpm_manifest_package use fpm_manifest_build, only: build_config_t, new_build_config use fpm_manifest_dependency, only : dependency_config_t, new_dependencies - use fpm_manifest_profile, only : profile_config_t, new_profiles + use fpm_manifest_profile, only : profile_config_t, new_profiles, NO_DEF_PROF, get_default_profiles use fpm_manifest_example, only : example_config_t, new_example use fpm_manifest_executable, only : executable_config_t, new_executable use fpm_manifest_library, only : library_config_t, new_library @@ -186,6 +186,9 @@ subroutine new_package(self, table, error) if (associated(child)) then call new_profiles(self%profiles, child, error) if (allocated(error)) return + else + allocate(self%profiles(NO_DEF_PROF)) + call get_default_profiles(self%profiles) end if call get_value(table, "executable", children, requested=.false.) diff --git a/src/fpm/manifest/profiles.f90 b/src/fpm/manifest/profiles.f90 index 21c42f372a..5dee0f82d5 100644 --- a/src/fpm/manifest/profiles.f90 +++ b/src/fpm/manifest/profiles.f90 @@ -6,9 +6,11 @@ module fpm_manifest_profile OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD implicit none private + public :: profile_config_t, new_profile, new_profiles, get_default_profiles, & + & find_profile, DEFAULT_COMPILER, NO_DEF_PROF - public :: profile_config_t, new_profile, new_profiles, find_profile - + character(len=*), parameter :: DEFAULT_COMPILER = 'gfortran' + integer, parameter :: NO_DEF_PROF = 18 ! Number of default profiles !> Configuration meta data for a profile type :: profile_config_t !> Name of the profile @@ -16,9 +18,9 @@ module fpm_manifest_profile !> Name of the compiler character(len=:), allocatable :: compiler - - !> Name of the OS - character(len=:), allocatable :: os + + !> Value repesenting OS + integer :: os_type !> Compiler flags character(len=:), allocatable :: compiler_flags @@ -32,7 +34,7 @@ module fpm_manifest_profile contains !> Construct a new profile configuration from a TOML data structure - subroutine new_profile(self, profile_name, compiler, os, compiler_flags, error) + subroutine new_profile(self, profile_name, compiler, os_type, compiler_flags) type(profile_config_t), intent(out) :: self !> Name of the profile @@ -41,19 +43,17 @@ subroutine new_profile(self, profile_name, compiler, os, compiler_flags, error) !> Name of the compiler character(len=:), allocatable, intent(in) :: compiler - !> Name of the OS - character(len=:), allocatable, intent(in) :: os + !> Type of the OS + integer, intent(in) :: os_type !> Compiler flags character(len=:), allocatable, intent(in) :: compiler_flags - - !> Error handling - type(error_t), allocatable, intent(out) :: error self%profile_name = profile_name self%compiler = compiler - self%os = os + self%os_type = os_type self%compiler_flags = compiler_flags + ! print *,profile_name," ",compiler," ",self%os_type," ",compiler_flags end subroutine new_profile !> Check if compiler name is a valid compiler name @@ -61,7 +61,7 @@ subroutine validate_compiler_name(compiler_name, is_valid) character(len=:), allocatable, intent(in) :: compiler_name logical, intent(out) :: is_valid select case(compiler_name) - case("gfortran", "ifort", "ifx", "pgfortran", "nvfrotran", "flang", & + case("gfortran", "ifort", "ifx", "pgfortran", "nvfrotran", "flang", "caf", & &"lfortran", "lfc", "nagfor", "crayftn", "xlf90", "ftn95") is_valid = .true. case default @@ -81,6 +81,22 @@ subroutine validate_os_name(os_name, is_valid) end select end subroutine validate_os_name + subroutine match_os_type(os_name, os_type) + character(len=:), allocatable, intent(in) :: os_name + integer, intent(out) :: os_type + select case (os_name) + case ("linux"); os_type = OS_LINUX + case ("macos"); os_type = OS_WINDOWS + case ("cygwin"); os_type = OS_CYGWIN + case ("solaris"); os_type = OS_SOLARIS + case ("freebsd"); os_type = OS_FREEBSD + case ("openbsd"); os_type = OS_OPENBSD + case ("all"); os_type = -1 + case default; os_type = OS_UNKNOWN + end select + end subroutine match_os_type + + !> Traverse operating system tables subroutine traverse_oss(profile_name, compiler_name, os_list, table, error, profiles_size, profiles, profindex) @@ -111,7 +127,7 @@ subroutine traverse_oss(profile_name, compiler_name, os_list, table, error, prof character(len=:), allocatable :: os_name type(toml_table), pointer :: os_node character(len=:), allocatable :: compiler_flags - integer :: ios, stat + integer :: ios, stat, os_type if (size(os_list)<1) return do ios = 1, size(os_list) @@ -127,20 +143,22 @@ subroutine traverse_oss(profile_name, compiler_name, os_list, table, error, prof os_name = lower(os_name) if (stat /= toml_stat%success) then call get_value(table, 'flags', compiler_flags, stat=stat) - if (stat /= toml_stat%success) then - call syntax_error(error, "Compiler flags "//compiler_flags//" must be a table entry") - exit - end if +! if (stat /= toml_stat%success) then +! call syntax_error(error, "Compiler flags "//compiler_flags//" must be a table entry") +! exit +! end if os_name = "all" - call new_profile(profiles(profindex), profile_name, compiler_name, os_name, compiler_flags, error) + call match_os_type(os_name, os_type) + call new_profile(profiles(profindex), profile_name, compiler_name, os_type, compiler_flags) profindex = profindex + 1 else call get_value(os_node, 'flags', compiler_flags, stat=stat) - if (stat /= toml_stat%success) then - call syntax_error(error, "Compiler flags "//compiler_flags//" must be a table entry") - compiler_flags="did not work" - end if - call new_profile(profiles(profindex), profile_name, compiler_name, os_name, compiler_flags, error) +! if (stat /= toml_stat%success) then +! call syntax_error(error, "Compiler flags "//compiler_flags//" must be a table entry") +! compiler_flags="did not work" +! end if + call match_os_type(os_name, os_type) + call new_profile(profiles(profindex), profile_name, compiler_name, os_type, compiler_flags) profindex = profindex + 1 end if end if @@ -200,7 +218,7 @@ subroutine traverse_compilers(profile_name, comp_list, table, error, profiles_si end if else os_list = comp_list(icomp:icomp) - compiler_name = "default" + compiler_name = DEFAULT_COMPILER if (present(profiles_size)) then call traverse_oss(profile_name, compiler_name, os_list, table, error, profiles_size=profiles_size) @@ -235,6 +253,7 @@ subroutine new_profiles(profiles, table, error) integer :: profiles_size, iprof, stat, profindex logical :: is_valid + ! call get defaults call table%get_keys(prof_list) if (size(prof_list) < 1) return @@ -259,10 +278,12 @@ subroutine new_profiles(profiles, table, error) call traverse_compilers(profile_name, comp_list, prof_node, error, profiles_size=profiles_size) end if end do - + + profiles_size=profiles_size+NO_DEF_PROF allocate(profiles(profiles_size)) - profindex = 1 + call get_default_profiles(profiles) + profindex = 1 + NO_DEF_PROF do iprof = 1, size(prof_list) profile_name = prof_list(iprof)%key @@ -278,8 +299,233 @@ subroutine new_profiles(profiles, table, error) call traverse_compilers(profile_name, comp_list, prof_node, error, profiles=profiles, profindex=profindex) end if end do + + do iprof = 1,size(profiles) + if (profiles(iprof)%profile_name.eq.'all') then + do profindex = 1,size(profiles) + if (.not.(profiles(profindex)%profile_name.eq.'all') & + & .and.(profiles(profindex)%compiler.eq.profiles(iprof)%compiler) & + & .and.((profiles(profindex)%os_type.eq.profiles(iprof)%os_type) & + & .or.(profiles(profindex)%os_type.eq.-1))) then + profiles(profindex)%compiler_flags=profiles(profindex)%compiler_flags// & + & " "//profiles(iprof)%compiler_flags + end if + end do + end if + end do end subroutine new_profiles + subroutine get_default_profiles(profiles) + type(profile_config_t), allocatable, intent(inout) :: profiles(:) + character(len=:), allocatable :: profile_name + character(len=:), allocatable :: compiler + character(len=:), allocatable :: flags + integer :: os_type, i + + do i=1,NO_DEF_PROF + if (i.le.9) then + profile_name = 'release' + else + profile_name = 'debug' + end if + + os_type = -1 + select case(i) + ! release profiles + case(1) !caf + compiler='caf' + flags='& + & -O3& + & -Wimplicit-interface& + & -fPIC& + & -fmax-errors=1& + & -funroll-loops& + &' + case(2) !gcc + compiler='gfortran' + flags='& + & -O3& + & -Wimplicit-interface& + & -fPIC& + & -fmax-errors=1& + & -funroll-loops& + & -fcoarray=single& + &' + case(3) !f95 + flags='& + & -O3& + & -Wimplicit-interface& + & -fPIC& + & -fmax-errors=1& + & -ffast-math& + & -funroll-loops& + &' + case(4) !nvhpc + compiler='nvfrotran' + flags = '& + & -Mbackslash& + &' + case(5) !intel_classic + compiler='ifort' + flags = '& + & -fp-model precise& + & -pc64& + & -align all& + & -error-limit 1& + & -reentrancy threaded& + & -nogen-interfaces& + & -assume byterecl& + &' + case(6) !intel_classic_windows + compiler='ifort' + os_type=OS_WINDOWS + flags = '& + & /fp:precise& + & /align:all& + & /error-limit:1& + & /reentrancy:threaded& + & /nogen-interfaces& + & /assume:byterecl& + &' + case(7) !intel_llvm + compiler='ifx' + flags = '& + & -fp-model=precise& + & -pc64& + & -align all& + & -error-limit 1& + & -reentrancy threaded& + & -nogen-interfaces& + & -assume byterecl& + &' + case(8) !intel_llvm_windows + compiler='ifx' + os_type = OS_WINDOWS + flags = '& + & /fp:precise& + & /align:all& + & /error-limit:1& + & /reentrancy:threaded& + & /nogen-interfaces& + & /assume:byterecl& + &' + case(9) !nag + compiler='nagfor' + flags = ' & + & -O4& + & -coarray=single& + & -PIC& + &' + + ! debug profiles + case(10) !caf + compiler='caf' + flags = '& + & -Wall& + & -Wextra& + & -Wimplicit-interface& + & -fPIC -fmax-errors=1& + & -g& + & -fcheck=bounds& + & -fcheck=array-temps& + & -fbacktrace& + &' + case(11) !gcc + compiler='gfortran' + flags = '& + & -Wall& + & -Wextra& + & -Wimplicit-interface& + & -fPIC -fmax-errors=1& + & -g& + & -fcheck=bounds& + & -fcheck=array-temps& + & -fbacktrace& + & -fcoarray=single& + &' + case(12) !f95 + flags = '& + & -Wall& + & -Wextra& + & -Wimplicit-interface& + & -fPIC -fmax-errors=1& + & -g& + & -fcheck=bounds& + & -fcheck=array-temps& + & -Wno-maybe-uninitialized -Wno-uninitialized& + & -fbacktrace& + &' + case(13) !nvhpc + compiler='nvfrotran' + flags = '& + & -Minform=inform& + & -Mbackslash& + & -g& + & -Mbounds& + & -Mchkptr& + & -Mchkstk& + & -traceback& + &' + case(14) !intel_classic + compiler='ifort' + flags = '& + & -warn all& + & -check all& + & -error-limit 1& + & -O0& + & -g& + & -assume byterecl& + & -traceback& + &' + case(15) !intel_classic_windows + compiler='ifort' + os_type=OS_WINDOWS + flags = '& + & /warn:all& + & /check:all& + & /error-limit:1& + & /Od& + & /Z7& + & /assume:byterecl& + & /traceback& + &' + case(16) !intel_llvm + compiler='ifx' + flags = '& + & -warn all& + & -check all& + & -error-limit 1& + & -O0& + & -g& + & -assume byterecl& + & -traceback& + &' + case(17) !intel_llvm_windows + compiler='ifx' + os_type=OS_WINDOWS + flags = '& + & /warn:all& + & /check:all& + & /error-limit:1& + & /Od& + & /Z7& + & /assume:byterecl& + &' + case(18) !nag + compiler='nagfor' + flags = '& + & -g& + & -C=all& + & -O0& + & -gline& + & -coarray=single& + & -PIC& + &' + end select + call new_profile(profiles(i), profile_name, compiler, os_type, flags) + end do + end subroutine get_default_profiles + !> Write information on instance subroutine info(self, unit, verbosity) @@ -310,9 +556,7 @@ subroutine info(self, unit, verbosity) write(unit, fmt) "- compiler", self%compiler end if - if (allocated(self%os)) then - write(unit, fmt) "- os", self%os - end if + write(unit, fmt) "- os", self%os_type if (allocated(self%compiler_flags)) then write(unit, fmt) "- compiler flags", self%compiler_flags @@ -320,61 +564,78 @@ subroutine info(self, unit, verbosity) end subroutine info - subroutine find_profile(profiles, profile_name, compiler, compiler_flags) + subroutine find_profile(profiles, profile_name, compiler, os_type, compiler_flags) type(profile_config_t), allocatable, intent(in) :: profiles(:) character(:), allocatable, intent(in) :: profile_name character(:), allocatable, intent(in) :: compiler + integer, intent(in) :: os_type character(:), allocatable, intent(out) :: compiler_flags character(:), allocatable :: curr_profile_name character(:), allocatable :: curr_compiler - character(:), allocatable :: curr_os - character(len=:),allocatable :: os_type + integer :: curr_os type(profile_config_t) :: chosen_profile integer :: i, priority, curr_priority - - select case (get_os_type()) - case (OS_LINUX); os_type = "linux" - case (OS_MACOS); os_type = "macos" - case (OS_WINDOWS); os_type = "windows" - case (OS_CYGWIN); os_type = "cygwin" - case (OS_SOLARIS); os_type = "solaris" - case (OS_FREEBSD); os_type = "freebsd" - case (OS_OPENBSD); os_type = "openbsd" - case (OS_UNKNOWN); os_type = "unknown" - case default ; os_type = "UNKNOWN" - end select + logical :: found_matching - print *, os_type - priority = 0 - print *,profile_name,compiler,os_type + found_matching = .false. do i=1,size(profiles) - curr_priority = 0 curr_profile_name = profiles(i)%profile_name curr_compiler = profiles(i)%compiler - curr_os = profiles(i)%os - if (curr_profile_name.eq.profile_name.or.curr_profile_name.eq.'all') then - if (curr_profile_name.eq.'all') then - curr_priority= curr_priority + 4 + curr_os = profiles(i)%os_type + if (curr_profile_name.eq.profile_name) then + if (curr_compiler.eq.compiler) then + if (curr_os.eq.os_type) then + chosen_profile = profiles(i) + found_matching = .true. + end if end if - if (curr_compiler.eq.compiler.or.curr_compiler.eq.'default') then - if (curr_compiler.eq.'default') then - curr_priority = curr_priority + 2 + end if + end do + if (.not. found_matching) then + do i=1,size(profiles) + curr_profile_name = profiles(i)%profile_name + curr_compiler = profiles(i)%compiler + curr_os = profiles(i)%os_type + if (curr_profile_name.eq.profile_name) then + if (curr_compiler.eq.compiler) then + if (curr_os.eq.-1) then + chosen_profile = profiles(i) + found_matching = .true. + end if end if - if (curr_os.eq.os_type.or.curr_os.eq.'all') then - if (curr_os.eq.'all') then - curr_priority = curr_priority + 1 + end if + end do + end if + if (.not. found_matching) then + do i=1,size(profiles) + curr_profile_name = profiles(i)%profile_name + curr_compiler = profiles(i)%compiler + curr_os = profiles(i)%os_type + if (curr_profile_name.eq.'all') then + if (curr_compiler.eq.compiler) then + if (curr_os.eq.os_type) then + chosen_profile = profiles(i) + found_matching = .true. end if - print *,"found matching profile with priority ",curr_priority, curr_profile_name//" "//curr_compiler & - &//" "//curr_os//" "//profiles(i)%compiler_flags - if (curr_priority > priority) then + end if + end if + end do + end if + if (.not. found_matching) then + do i=1,size(profiles) + curr_profile_name = profiles(i)%profile_name + curr_compiler = profiles(i)%compiler + curr_os = profiles(i)%os_type + if (curr_profile_name.eq.'all') then + if (curr_compiler.eq.compiler) then + if (curr_os.eq.-1) then chosen_profile = profiles(i) - priority = curr_priority - print *, priority + found_matching = .true. end if end if end if - end if - end do + end do + end if compiler_flags = chosen_profile%compiler_flags end subroutine find_profile end module fpm_manifest_profile diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 2a2ecf5b09..917352cce6 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -474,15 +474,15 @@ subroutine check_build_vals() 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 +! 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) From 1caa897f3c58cfec19aed8b22d646f5b077381a8 Mon Sep 17 00:00:00 2001 From: kubajj Date: Tue, 8 Jun 2021 13:00:25 +0200 Subject: [PATCH 06/32] Add error handling and basic testing for profiles --- src/fpm/manifest/profiles.f90 | 312 +++++++++++++++++++++++--------- test/fpm_test/test_manifest.f90 | 103 +++++++++++ 2 files changed, 326 insertions(+), 89 deletions(-) diff --git a/src/fpm/manifest/profiles.f90 b/src/fpm/manifest/profiles.f90 index 5dee0f82d5..700ad43ac4 100644 --- a/src/fpm/manifest/profiles.f90 +++ b/src/fpm/manifest/profiles.f90 @@ -1,5 +1,5 @@ module fpm_manifest_profile - use fpm_error, only : error_t, syntax_error + use fpm_error, only : error_t, syntax_error, fatal_error use fpm_toml, only : toml_table, toml_key, toml_stat, get_value use fpm_strings, only: lower use fpm_environment, only: get_os_type, OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, & @@ -11,6 +11,7 @@ module fpm_manifest_profile character(len=*), parameter :: DEFAULT_COMPILER = 'gfortran' integer, parameter :: NO_DEF_PROF = 18 ! Number of default profiles + integer, parameter :: OS_ALL = -1 !> Configuration meta data for a profile type :: profile_config_t !> Name of the profile @@ -22,8 +23,14 @@ module fpm_manifest_profile !> Value repesenting OS integer :: os_type - !> Compiler flags - character(len=:), allocatable :: compiler_flags + !> Fortran compiler flags + character(len=:), allocatable :: flags + + !> C compiler flags + character(len=:), allocatable :: c_flags + + !> Link time compiler flags + character(len=:), allocatable :: link_time_flags contains @@ -34,7 +41,7 @@ module fpm_manifest_profile contains !> Construct a new profile configuration from a TOML data structure - subroutine new_profile(self, profile_name, compiler, os_type, compiler_flags) + subroutine new_profile(self, profile_name, compiler, os_type, flags, c_flags, link_time_flags) type(profile_config_t), intent(out) :: self !> Name of the profile @@ -46,14 +53,35 @@ subroutine new_profile(self, profile_name, compiler, os_type, compiler_flags) !> Type of the OS integer, intent(in) :: os_type - !> Compiler flags - character(len=:), allocatable, intent(in) :: compiler_flags + !> Fortran compiler flags + character(len=:), allocatable, optional, intent(in) :: flags + + !> C compiler flags + character(len=:), allocatable, optional, intent(in) :: c_flags + + !> Link time compiler flags + character(len=:), allocatable, optional, intent(in) :: link_time_flags self%profile_name = profile_name self%compiler = compiler self%os_type = os_type - self%compiler_flags = compiler_flags - ! print *,profile_name," ",compiler," ",self%os_type," ",compiler_flags + if (present(flags)) then + self%flags = flags + else + self%flags = "" + end if + if (present(c_flags)) then + self%c_flags = c_flags + else + self%c_flags = "" + end if + if (present(link_time_flags)) then + self%link_time_flags = link_time_flags + else + self%link_time_flags = "" + end if +! print *,profile_name," ",compiler," ",os_type," ",flags +! print *,profile_name," ",compiler," ",os_type," ",flags, " ",c_flags," ", link_time_flags end subroutine new_profile !> Check if compiler name is a valid compiler name @@ -62,7 +90,7 @@ subroutine validate_compiler_name(compiler_name, is_valid) logical, intent(out) :: is_valid select case(compiler_name) case("gfortran", "ifort", "ifx", "pgfortran", "nvfrotran", "flang", "caf", & - &"lfortran", "lfc", "nagfor", "crayftn", "xlf90", "ftn95") + & "f95", "lfortran", "lfc", "nagfor", "crayftn", "xlf90", "ftn95") is_valid = .true. case default is_valid = .false. @@ -81,6 +109,17 @@ subroutine validate_os_name(os_name, is_valid) end select end subroutine validate_os_name + subroutine validate_key_name(key_name, is_valid) + character(len=:), allocatable, intent(in) :: key_name + logical, intent(out) :: is_valid + select case (key_name) + case ("flags", "c_flags", "link_time_flags") + is_valid = .true. + case default + is_valid = .false. + end select + end subroutine validate_key_name + subroutine match_os_type(os_name, os_type) character(len=:), allocatable, intent(in) :: os_name integer, intent(out) :: os_type @@ -91,11 +130,78 @@ subroutine match_os_type(os_name, os_type) case ("solaris"); os_type = OS_SOLARIS case ("freebsd"); os_type = OS_FREEBSD case ("openbsd"); os_type = OS_OPENBSD - case ("all"); os_type = -1 + case ("all"); os_type = OS_ALL case default; os_type = OS_UNKNOWN end select end subroutine match_os_type + subroutine get_flags(profile_name, compiler_name, os_type, key_list, table, profiles, profindex, error) + + !> Name of profile + character(len=:), allocatable, intent(in) :: profile_name + + !> Name of compiler + character(len=:), allocatable, intent(in) :: compiler_name + + !> OS type + integer, intent(in) :: os_type + + !> List of keys in the table + type(toml_key), allocatable, intent(in) :: key_list(:) + + !> Table containing OS tables + type(toml_table), pointer, intent(in) :: table + + !> List of profiles + type(profile_config_t), allocatable, intent(inout) :: profiles(:) + + !> Index in the list of profiles + integer, intent(inout) :: profindex + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + character(len=:), allocatable :: flags, c_flags, link_time_flags, key_name + integer :: ikey, stat + logical :: is_valid + + if (size(key_list).ge.1) then + do ikey=1,size(key_list) + key_name = key_list(ikey)%key +! call validate_key_name(key_name, is_valid) +! if (.not. is_valid) then +! call syntax_error(error, "Only flags, c_flags and link_time_flags are valid keys in profiles table") +! return +! end if + if (key_name.eq.'flags') then + call get_value(table, 'flags', flags, stat=stat) + if (stat /= toml_stat%success) then + call syntax_error(error, "flags has to be a key-value pair") + return + end if + else if (key_name.eq.'c_flags') then + call get_value(table, 'c_flags', c_flags, stat=stat) + if (stat /= toml_stat%success) then + call syntax_error(error, "c_flags has to be a key-value pair") + return + end if + else + call get_value(table, 'link_time_flags', link_time_flags, stat=stat) + if (stat /= toml_stat%success) then + call syntax_error(error, "link_time_flags has to be a key-value pair") + return + end if + end if + end do + end if + + if (.not.allocated(flags)) flags='' + if (.not.allocated(c_flags)) c_flags='' + if (.not.allocated(link_time_flags)) link_time_flags='' + + call new_profile(profiles(profindex), profile_name, compiler_name, os_type, flags, c_flags, link_time_flags) + profindex = profindex + 1 + end subroutine get_flags !> Traverse operating system tables subroutine traverse_oss(profile_name, compiler_name, os_list, table, error, profiles_size, profiles, profindex) @@ -124,42 +230,62 @@ subroutine traverse_oss(profile_name, compiler_name, os_list, table, error, prof !> Index in the list of profiles integer, intent(inout), optional :: profindex + type(toml_key), allocatable :: key_list(:) character(len=:), allocatable :: os_name type(toml_table), pointer :: os_node - character(len=:), allocatable :: compiler_flags + character(len=:), allocatable :: flags integer :: ios, stat, os_type + logical :: is_valid, key_val_added, is_key_val if (size(os_list)<1) return + key_val_added = .false. do ios = 1, size(os_list) - if (present(profiles_size)) then - profiles_size = profiles_size + 1 - else - if (.not.(present(profiles).and.present(profindex))) then - print *,"Error in traverse_oss" - return + os_name = lower(os_list(ios)%key) + call validate_os_name(os_name, is_valid) + if (is_valid) then + if (present(profiles_size)) then + profiles_size = profiles_size + 1 + else + if (.not.(present(profiles).and.present(profindex))) then + call fatal_error(error, "Both profiles and profindex have to be present") + return + end if + os_name = os_list(ios)%key + call get_value(table, os_name, os_node, stat=stat) + os_name = lower(os_name) + if (stat /= toml_stat%success) then + call syntax_error(error, "os "//os_name//" has to be a table") + return + end if + call match_os_type(os_name, os_type) + call os_node%get_keys(key_list) + call get_flags(profile_name, compiler_name, os_type, key_list, os_node, profiles, profindex, error) + if (allocated(error)) return end if + else + is_key_val = .false. os_name = os_list(ios)%key call get_value(table, os_name, os_node, stat=stat) - os_name = lower(os_name) if (stat /= toml_stat%success) then - call get_value(table, 'flags', compiler_flags, stat=stat) -! if (stat /= toml_stat%success) then -! call syntax_error(error, "Compiler flags "//compiler_flags//" must be a table entry") -! exit -! end if - os_name = "all" - call match_os_type(os_name, os_type) - call new_profile(profiles(profindex), profile_name, compiler_name, os_type, compiler_flags) - profindex = profindex + 1 + is_key_val = .true. + end if + if (present(profiles_size)) then + if (is_key_val.and..not.key_val_added) then + key_val_added = .true. + is_key_val = .false. + profiles_size = profiles_size + 1 + else if (.not.is_key_val) then + profiles_size = profiles_size + 1 + end if else - call get_value(os_node, 'flags', compiler_flags, stat=stat) -! if (stat /= toml_stat%success) then -! call syntax_error(error, "Compiler flags "//compiler_flags//" must be a table entry") -! compiler_flags="did not work" -! end if - call match_os_type(os_name, os_type) - call new_profile(profiles(profindex), profile_name, compiler_name, os_type, compiler_flags) - profindex = profindex + 1 + if (.not.(present(profiles).and.present(profindex))) then + call fatal_error(error, "Both profiles and profindex have to be present") + return + end if + os_type = OS_ALL + os_node=>table + call get_flags(profile_name, compiler_name, os_type, os_list, os_node, profiles, profindex, error) + if (allocated(error)) return end if end if end do @@ -208,13 +334,15 @@ subroutine traverse_compilers(profile_name, comp_list, table, error, profiles_si call comp_node%get_keys(os_list) if (present(profiles_size)) then call traverse_oss(profile_name, compiler_name, os_list, comp_node, error, profiles_size=profiles_size) + if (allocated(error)) return else if (.not.(present(profiles).and.present(profindex))) then - print *,"Error in traverse_compilers" + call fatal_error(error, "Both profiles and profindex have to be present") return end if call traverse_oss(profile_name, compiler_name, os_list, comp_node, & & error, profiles=profiles, profindex=profindex) + if (allocated(error)) return end if else os_list = comp_list(icomp:icomp) @@ -222,13 +350,15 @@ subroutine traverse_compilers(profile_name, comp_list, table, error, profiles_si if (present(profiles_size)) then call traverse_oss(profile_name, compiler_name, os_list, table, error, profiles_size=profiles_size) + if (allocated(error)) return else if (.not.(present(profiles).and.present(profindex))) then - print *,"Error in traverse_compilers" + call fatal_error(error, "Both profiles and profindex have to be present") return end if call traverse_oss(profile_name, compiler_name, os_list, table, & & error, profiles=profiles, profindex=profindex) + if (allocated(error)) return end if end if end do @@ -249,7 +379,8 @@ subroutine new_profiles(profiles, table, error) type(toml_table), pointer :: prof_node type(toml_key), allocatable :: prof_list(:) type(toml_key), allocatable :: comp_list(:) - character(len=:), allocatable :: profile_name + type(toml_key), allocatable :: os_list(:) + character(len=:), allocatable :: profile_name, compiler_name integer :: profiles_size, iprof, stat, profindex logical :: is_valid @@ -268,14 +399,25 @@ subroutine new_profiles(profiles, table, error) comp_list = prof_list(iprof:iprof) prof_node=>table call traverse_compilers(profile_name, comp_list, prof_node, error, profiles_size=profiles_size) + if (allocated(error)) return else - call get_value(table, profile_name, prof_node, stat=stat) - if (stat /= toml_stat%success) then - call syntax_error(error, "Profile "//prof_list(iprof)%key//" must be a table entry") - exit + call validate_os_name(profile_name, is_valid) + if (is_valid) then + os_list = prof_list(iprof:iprof) + profile_name = 'all' + compiler_name = DEFAULT_COMPILER + call traverse_oss(profile_name, compiler_name, os_list, table, error, profiles_size=profiles_size) + if (allocated(error)) return + else + call get_value(table, profile_name, prof_node, stat=stat) + if (stat /= toml_stat%success) then + call syntax_error(error, "Profile "//prof_list(iprof)%key//" must be a table entry") + exit + end if + call prof_node%get_keys(comp_list) + call traverse_compilers(profile_name, comp_list, prof_node, error, profiles_size=profiles_size) + if (allocated(error)) return end if - call prof_node%get_keys(comp_list) - call traverse_compilers(profile_name, comp_list, prof_node, error, profiles_size=profiles_size) end if end do @@ -293,22 +435,38 @@ subroutine new_profiles(profiles, table, error) comp_list = prof_list(iprof:iprof) prof_node=>table call traverse_compilers(profile_name, comp_list, prof_node, error, profiles=profiles, profindex=profindex) + if (allocated(error)) return else - call get_value(table, profile_name, prof_node, stat=stat) - call prof_node%get_keys(comp_list) - call traverse_compilers(profile_name, comp_list, prof_node, error, profiles=profiles, profindex=profindex) + call validate_os_name(profile_name, is_valid) + if (is_valid) then + os_list = prof_list(iprof:iprof) + profile_name = 'all' + compiler_name = DEFAULT_COMPILER + prof_node=>table + call traverse_oss(profile_name, compiler_name, os_list, prof_node, error, profiles=profiles, profindex=profindex) + if (allocated(error)) return + else + call get_value(table, profile_name, prof_node, stat=stat) + call prof_node%get_keys(comp_list) + call traverse_compilers(profile_name, comp_list, prof_node, error, profiles=profiles, profindex=profindex) + if (allocated(error)) return + end if end if end do + ! Apply profiles with profile name 'all' to matching profiles do iprof = 1,size(profiles) if (profiles(iprof)%profile_name.eq.'all') then do profindex = 1,size(profiles) if (.not.(profiles(profindex)%profile_name.eq.'all') & & .and.(profiles(profindex)%compiler.eq.profiles(iprof)%compiler) & - & .and.((profiles(profindex)%os_type.eq.profiles(iprof)%os_type) & - & .or.(profiles(profindex)%os_type.eq.-1))) then - profiles(profindex)%compiler_flags=profiles(profindex)%compiler_flags// & - & " "//profiles(iprof)%compiler_flags + & .and.(profiles(profindex)%os_type.eq.profiles(iprof)%os_type)) then + profiles(profindex)%flags=profiles(profindex)%flags// & + & " "//profiles(iprof)%flags + profiles(profindex)%c_flags=profiles(profindex)%c_flags// & + & " "//profiles(iprof)%c_flags + profiles(profindex)%link_time_flags=profiles(profindex)%link_time_flags// & + & " "//profiles(iprof)%link_time_flags end if end do end if @@ -323,13 +481,13 @@ subroutine get_default_profiles(profiles) integer :: os_type, i do i=1,NO_DEF_PROF - if (i.le.9) then + if (i.le.(9)) then profile_name = 'release' else profile_name = 'debug' end if - os_type = -1 + os_type = OS_ALL select case(i) ! release profiles case(1) !caf @@ -352,6 +510,7 @@ subroutine get_default_profiles(profiles) & -fcoarray=single& &' case(3) !f95 + compiler='f95' flags='& & -O3& & -Wimplicit-interface& @@ -444,6 +603,7 @@ subroutine get_default_profiles(profiles) & -fcoarray=single& &' case(12) !f95 + compiler='f95' flags = '& & -Wall& & -Wextra& @@ -558,18 +718,20 @@ subroutine info(self, unit, verbosity) write(unit, fmt) "- os", self%os_type - if (allocated(self%compiler_flags)) then - write(unit, fmt) "- compiler flags", self%compiler_flags + if (allocated(self%flags)) then + write(unit, fmt) "- compiler flags", self%flags end if end subroutine info - subroutine find_profile(profiles, profile_name, compiler, os_type, compiler_flags) + subroutine find_profile(profiles, profile_name, compiler, os_type, flags, c_flags, link_time_flags) type(profile_config_t), allocatable, intent(in) :: profiles(:) character(:), allocatable, intent(in) :: profile_name character(:), allocatable, intent(in) :: compiler integer, intent(in) :: os_type - character(:), allocatable, intent(out) :: compiler_flags + character(:), allocatable, intent(out), optional :: flags + character(:), allocatable, intent(out), optional :: c_flags + character(:), allocatable, intent(out), optional :: link_time_flags character(:), allocatable :: curr_profile_name character(:), allocatable :: curr_compiler integer :: curr_os @@ -598,37 +760,7 @@ subroutine find_profile(profiles, profile_name, compiler, os_type, compiler_flag curr_os = profiles(i)%os_type if (curr_profile_name.eq.profile_name) then if (curr_compiler.eq.compiler) then - if (curr_os.eq.-1) then - chosen_profile = profiles(i) - found_matching = .true. - end if - end if - end if - end do - end if - if (.not. found_matching) then - do i=1,size(profiles) - curr_profile_name = profiles(i)%profile_name - curr_compiler = profiles(i)%compiler - curr_os = profiles(i)%os_type - if (curr_profile_name.eq.'all') then - if (curr_compiler.eq.compiler) then - if (curr_os.eq.os_type) then - chosen_profile = profiles(i) - found_matching = .true. - end if - end if - end if - end do - end if - if (.not. found_matching) then - do i=1,size(profiles) - curr_profile_name = profiles(i)%profile_name - curr_compiler = profiles(i)%compiler - curr_os = profiles(i)%os_type - if (curr_profile_name.eq.'all') then - if (curr_compiler.eq.compiler) then - if (curr_os.eq.-1) then + if (curr_os.eq.OS_ALL) then chosen_profile = profiles(i) found_matching = .true. end if @@ -636,6 +768,8 @@ subroutine find_profile(profiles, profile_name, compiler, os_type, compiler_flag end if end do end if - compiler_flags = chosen_profile%compiler_flags + if (present(flags)) flags = chosen_profile%flags + if (present(c_flags)) c_flags = chosen_profile%c_flags + if (present(link_time_flags)) link_time_flags = chosen_profile%link_time_flags end subroutine find_profile end module fpm_manifest_profile diff --git a/test/fpm_test/test_manifest.f90 b/test/fpm_test/test_manifest.f90 index 94e5e07702..93150d3749 100644 --- a/test/fpm_test/test_manifest.f90 +++ b/test/fpm_test/test_manifest.f90 @@ -4,6 +4,7 @@ module test_manifest use testsuite, only : new_unittest, unittest_t, error_t, test_failed, & & check_string use fpm_manifest + use fpm_manifest_profile, only: find_profile use fpm_strings, only: operator(.in.) implicit none private @@ -33,6 +34,8 @@ subroutine collect_manifest(testsuite) & new_unittest("dependency-wrongkey", test_dependency_wrongkey, should_fail=.true.), & & new_unittest("dependencies-empty", test_dependencies_empty), & & new_unittest("dependencies-typeerror", test_dependencies_typeerror, should_fail=.true.), & + & new_unittest("profiles", test_profiles), & + & new_unittest("profiles-keyvalue-table", test_profiles_keyvalue_table, should_fail=.true.), & & new_unittest("executable-empty", test_executable_empty, should_fail=.true.), & & new_unittest("executable-typeerror", test_executable_typeerror, should_fail=.true.), & & new_unittest("executable-noname", test_executable_noname, should_fail=.true.), & @@ -391,6 +394,106 @@ subroutine test_dependencies_typeerror(error) end subroutine test_dependencies_typeerror + subroutine test_profiles(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_config_t) :: package + character(len=*), parameter :: manifest = 'fpm-profiles.toml' + integer :: unit + character(:), allocatable :: profile_name, compiler, flags + + open(file=manifest, newunit=unit) + write(unit, '(a)') & + & 'name = "example"', & + & '[profiles.release.gfortran.linux]', & + & 'flags = "1" #release.gfortran.linux', & + & '[profiles.release.gfortran]', & + & 'flags = "2" #release.gfortran.all', & + & '[profiles.gfortran.linux]', & + & 'flags = "3" #all.gfortran.linux', & + & '[profiles.release.linux]', & + & 'flags = "4" #release.gfortran.linux', & + & '[profiles.release]', & + & 'flags = "5" #release.gfortran.all', & + & '[profiles.gfortran]', & + & 'flags = "6" #all.gfortran.all', & + & '[profiles.linux]', & + & 'flags = "7" #all.gfortran.linux', & + & '[profiles.release.ifort]', & + & 'flags = "8" #release.ifort.all' + close(unit) + + call get_package_data(package, manifest, error) + + open(file=manifest, newunit=unit) + close(unit, status='delete') + + if (allocated(error)) return + + profile_name = 'release' + compiler = 'gfortran' + call find_profile(package%profiles, profile_name, compiler, 1, flags) + if (.not.flags.eq.'4 3 7') then + call test_failed(error, "Failed to append flags from profiles named 'all'") + return + end if + + profile_name = 'release' + compiler = 'gfortran' + call find_profile(package%profiles, profile_name, compiler, 3, flags) + if (.not.flags.eq.'5 6') then + call test_failed(error, "Failed to choose profile with OS 'all'") + return + end if + + profile_name = 'publish' + compiler = 'gfortran' + call find_profile(package%profiles, profile_name, compiler, 1, flags) + if (.not.flags.eq.'') then + call test_failed(error, "Profile named "//profile_name//" should not exist") + return + end if + + profile_name = 'debug' + compiler = 'ifort' + call find_profile(package%profiles, profile_name, compiler, 3, flags) + if (.not.flags.eq.' /warn:all /check:all /error-limit:1 /Od /Z7 /assume:byterecl /traceback') then + call test_failed(error, "Failed to load built-in profile"//flags) + return + end if + + profile_name = 'release' + compiler = 'ifort' + call find_profile(package%profiles, profile_name, compiler, 1, flags) + if (.not.flags.eq.'8') then + call test_failed(error, "Failed to overwrite built-in profile") + return + end if + end subroutine test_profiles + + subroutine test_profiles_keyvalue_table(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_config_t) :: package + character(len=*), parameter :: manifest = 'fpm-profiles-error.toml' + integer :: unit + character(:), allocatable :: profile_name, compiler, flags + + open(file=manifest, newunit=unit) + write(unit, '(a)') & + & 'name = "example"', & + & '[profiles.linux.flags]' + close(unit) + + call get_package_data(package, manifest, error) + + open(file=manifest, newunit=unit) + close(unit, status='delete') + end subroutine test_profiles_keyvalue_table !> Executables cannot be created from empty tables subroutine test_executable_empty(error) From 507d634a84b32cabc5606075b861aa9ce387a248 Mon Sep 17 00:00:00 2001 From: kubajj Date: Fri, 11 Jun 2021 17:14:40 +0200 Subject: [PATCH 07/32] Simplify profiles handling before implementing package scope --- src/fpm.f90 | 65 +++---- src/fpm/manifest/package.f90 | 6 +- src/fpm/manifest/profiles.f90 | 311 ++++++++-------------------------- src/fpm_model.f90 | 13 ++ 4 files changed, 125 insertions(+), 270 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index a9a13c515f..7d054c4b7c 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -65,37 +65,6 @@ subroutine build_model(model, settings, package, error) model%fortran_compiler = settings%compiler endif - if(settings%profile.eq.'')then - if (trim(settings%flag).eq.'') then - profile = 'debug' - end if - else - profile = settings%profile - endif - if (allocated(package%profiles).and.allocated(profile)) then - call find_profile(package%profiles, profile, model%fortran_compiler, get_os_type(), compiler_flags) - print *,"found profile has the following flags: "//compiler_flags - 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) - - if (is_unknown_compiler(model%fortran_compiler)) then - write(*, '(*(a:,1x))') & - "", "Unknown compiler", model%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) - - call get_module_flags(model%fortran_compiler, & - & join_path(model%output_directory,model%package_name), & - & model%fortran_compile_flags) - if (allocated(compiler_flags)) then - model%fortran_compile_flags = " "//compiler_flags // settings%flag // model%fortran_compile_flags - else - model%fortran_compile_flags = settings%flag // model%fortran_compile_flags - end if - allocate(model%packages(model%deps%ndep)) ! Add sources from executable directories @@ -166,6 +135,7 @@ subroutine build_model(model, settings, package, error) if (allocated(error)) exit model%packages(i)%name = dependency%name + model%packages(i)%profiles = dependency%profiles if (.not.allocated(model%packages(i)%sources)) allocate(model%packages(i)%sources(0)) if (allocated(dependency%library)) then @@ -214,6 +184,39 @@ subroutine build_model(model, settings, package, error) if (duplicates_found) then error stop 'Error: One or more duplicate module names found.' end if + + ! Compiler flags logic + if(settings%profile.eq.'')then + if (trim(settings%flag).eq.'') then + profile = 'debug' + end if + else + profile = settings%profile + endif + if (allocated(package%profiles).and.allocated(profile)) then + call find_profile(package%profiles, profile, model%fortran_compiler, get_os_type(), compiler_flags) + print *,"Matching profile has the following flags: "//compiler_flags + 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) + + if (is_unknown_compiler(model%fortran_compiler)) then + write(*, '(*(a:,1x))') & + "", "Unknown compiler", model%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) + + call get_module_flags(model%fortran_compiler, & + & join_path(model%output_directory,model%package_name), & + & model%fortran_compile_flags) + if (allocated(compiler_flags)) then + model%fortran_compile_flags = " "//compiler_flags // settings%flag // model%fortran_compile_flags + else + model%fortran_compile_flags = settings%flag // model%fortran_compile_flags + end if + end subroutine build_model ! Check for duplicate modules diff --git a/src/fpm/manifest/package.f90 b/src/fpm/manifest/package.f90 index 7a73113b45..72bca47a2f 100644 --- a/src/fpm/manifest/package.f90 +++ b/src/fpm/manifest/package.f90 @@ -33,7 +33,7 @@ module fpm_manifest_package use fpm_manifest_build, only: build_config_t, new_build_config use fpm_manifest_dependency, only : dependency_config_t, new_dependencies - use fpm_manifest_profile, only : profile_config_t, new_profiles, NO_DEF_PROF, get_default_profiles + use fpm_manifest_profile, only : profile_config_t, new_profiles, get_default_profiles use fpm_manifest_example, only : example_config_t, new_example use fpm_manifest_executable, only : executable_config_t, new_executable use fpm_manifest_library, only : library_config_t, new_library @@ -187,8 +187,8 @@ subroutine new_package(self, table, error) call new_profiles(self%profiles, child, error) if (allocated(error)) return else - allocate(self%profiles(NO_DEF_PROF)) - call get_default_profiles(self%profiles) + self%profiles = get_default_profiles(error) + if (allocated(error)) return end if call get_value(table, "executable", children, requested=.false.) diff --git a/src/fpm/manifest/profiles.f90 b/src/fpm/manifest/profiles.f90 index 700ad43ac4..fe5f066e7b 100644 --- a/src/fpm/manifest/profiles.f90 +++ b/src/fpm/manifest/profiles.f90 @@ -7,10 +7,9 @@ module fpm_manifest_profile implicit none private public :: profile_config_t, new_profile, new_profiles, get_default_profiles, & - & find_profile, DEFAULT_COMPILER, NO_DEF_PROF + & find_profile, DEFAULT_COMPILER character(len=*), parameter :: DEFAULT_COMPILER = 'gfortran' - integer, parameter :: NO_DEF_PROF = 18 ! Number of default profiles integer, parameter :: OS_ALL = -1 !> Configuration meta data for a profile type :: profile_config_t @@ -41,48 +40,49 @@ module fpm_manifest_profile contains !> Construct a new profile configuration from a TOML data structure - subroutine new_profile(self, profile_name, compiler, os_type, flags, c_flags, link_time_flags) - type(profile_config_t), intent(out) :: self + function new_profile(profile_name, compiler, os_type, flags, c_flags, link_time_flags) result(profile) !> Name of the profile - character(len=:), allocatable, intent(in) :: profile_name + character(len=*), intent(in) :: profile_name !> Name of the compiler - character(len=:), allocatable, intent(in) :: compiler + character(len=*), intent(in) :: compiler !> Type of the OS integer, intent(in) :: os_type !> Fortran compiler flags - character(len=:), allocatable, optional, intent(in) :: flags + character(len=*), optional, intent(in) :: flags !> C compiler flags - character(len=:), allocatable, optional, intent(in) :: c_flags + character(len=*), optional, intent(in) :: c_flags !> Link time compiler flags - character(len=:), allocatable, optional, intent(in) :: link_time_flags + character(len=*), optional, intent(in) :: link_time_flags - self%profile_name = profile_name - self%compiler = compiler - self%os_type = os_type + type(profile_config_t) :: profile + + profile%profile_name = profile_name + profile%compiler = compiler + profile%os_type = os_type if (present(flags)) then - self%flags = flags + profile%flags = flags else - self%flags = "" + profile%flags = "" end if if (present(c_flags)) then - self%c_flags = c_flags + profile%c_flags = c_flags else - self%c_flags = "" + profile%c_flags = "" end if if (present(link_time_flags)) then - self%link_time_flags = link_time_flags + profile%link_time_flags = link_time_flags else - self%link_time_flags = "" + profile%link_time_flags = "" end if ! print *,profile_name," ",compiler," ",os_type," ",flags ! print *,profile_name," ",compiler," ",os_type," ",flags, " ",c_flags," ", link_time_flags - end subroutine new_profile + end function new_profile !> Check if compiler name is a valid compiler name subroutine validate_compiler_name(compiler_name, is_valid) @@ -199,7 +199,8 @@ subroutine get_flags(profile_name, compiler_name, os_type, key_list, table, prof if (.not.allocated(c_flags)) c_flags='' if (.not.allocated(link_time_flags)) link_time_flags='' - call new_profile(profiles(profindex), profile_name, compiler_name, os_type, flags, c_flags, link_time_flags) +! call new_profile(profiles(profindex), profile_name, compiler_name, os_type, flags, c_flags, link_time_flags) + profiles(profindex) = new_profile(profile_name, compiler_name, os_type, flags, c_flags, link_time_flags) profindex = profindex + 1 end subroutine get_flags @@ -383,8 +384,10 @@ subroutine new_profiles(profiles, table, error) character(len=:), allocatable :: profile_name, compiler_name integer :: profiles_size, iprof, stat, profindex logical :: is_valid + type(profile_config_t), allocatable :: default_profiles(:) - ! call get defaults + default_profiles = get_default_profiles(error) + if (allocated(error)) return call table%get_keys(prof_list) if (size(prof_list) < 1) return @@ -421,11 +424,12 @@ subroutine new_profiles(profiles, table, error) end if end do - profiles_size=profiles_size+NO_DEF_PROF + profiles_size=profiles_size+size(default_profiles) allocate(profiles(profiles_size)) - call get_default_profiles(profiles) - profindex = 1 + NO_DEF_PROF + do profindex=1, size(default_profiles) + profiles(profindex) = default_profiles(profindex) + end do do iprof = 1, size(prof_list) profile_name = prof_list(iprof)%key @@ -472,219 +476,54 @@ subroutine new_profiles(profiles, table, error) end if end do end subroutine new_profiles - - subroutine get_default_profiles(profiles) - type(profile_config_t), allocatable, intent(inout) :: profiles(:) - character(len=:), allocatable :: profile_name - character(len=:), allocatable :: compiler - character(len=:), allocatable :: flags - integer :: os_type, i - do i=1,NO_DEF_PROF - if (i.le.(9)) then - profile_name = 'release' - else - profile_name = 'debug' - end if - - os_type = OS_ALL - select case(i) - ! release profiles - case(1) !caf - compiler='caf' - flags='& - & -O3& - & -Wimplicit-interface& - & -fPIC& - & -fmax-errors=1& - & -funroll-loops& - &' - case(2) !gcc - compiler='gfortran' - flags='& - & -O3& - & -Wimplicit-interface& - & -fPIC& - & -fmax-errors=1& - & -funroll-loops& - & -fcoarray=single& - &' - case(3) !f95 - compiler='f95' - flags='& - & -O3& - & -Wimplicit-interface& - & -fPIC& - & -fmax-errors=1& - & -ffast-math& - & -funroll-loops& - &' - case(4) !nvhpc - compiler='nvfrotran' - flags = '& - & -Mbackslash& - &' - case(5) !intel_classic - compiler='ifort' - flags = '& - & -fp-model precise& - & -pc64& - & -align all& - & -error-limit 1& - & -reentrancy threaded& - & -nogen-interfaces& - & -assume byterecl& - &' - case(6) !intel_classic_windows - compiler='ifort' - os_type=OS_WINDOWS - flags = '& - & /fp:precise& - & /align:all& - & /error-limit:1& - & /reentrancy:threaded& - & /nogen-interfaces& - & /assume:byterecl& - &' - case(7) !intel_llvm - compiler='ifx' - flags = '& - & -fp-model=precise& - & -pc64& - & -align all& - & -error-limit 1& - & -reentrancy threaded& - & -nogen-interfaces& - & -assume byterecl& - &' - case(8) !intel_llvm_windows - compiler='ifx' - os_type = OS_WINDOWS - flags = '& - & /fp:precise& - & /align:all& - & /error-limit:1& - & /reentrancy:threaded& - & /nogen-interfaces& - & /assume:byterecl& - &' - case(9) !nag - compiler='nagfor' - flags = ' & - & -O4& - & -coarray=single& - & -PIC& - &' - - ! debug profiles - case(10) !caf - compiler='caf' - flags = '& - & -Wall& - & -Wextra& - & -Wimplicit-interface& - & -fPIC -fmax-errors=1& - & -g& - & -fcheck=bounds& - & -fcheck=array-temps& - & -fbacktrace& - &' - case(11) !gcc - compiler='gfortran' - flags = '& - & -Wall& - & -Wextra& - & -Wimplicit-interface& - & -fPIC -fmax-errors=1& - & -g& - & -fcheck=bounds& - & -fcheck=array-temps& - & -fbacktrace& - & -fcoarray=single& - &' - case(12) !f95 - compiler='f95' - flags = '& - & -Wall& - & -Wextra& - & -Wimplicit-interface& - & -fPIC -fmax-errors=1& - & -g& - & -fcheck=bounds& - & -fcheck=array-temps& - & -Wno-maybe-uninitialized -Wno-uninitialized& - & -fbacktrace& - &' - case(13) !nvhpc - compiler='nvfrotran' - flags = '& - & -Minform=inform& - & -Mbackslash& - & -g& - & -Mbounds& - & -Mchkptr& - & -Mchkstk& - & -traceback& - &' - case(14) !intel_classic - compiler='ifort' - flags = '& - & -warn all& - & -check all& - & -error-limit 1& - & -O0& - & -g& - & -assume byterecl& - & -traceback& - &' - case(15) !intel_classic_windows - compiler='ifort' - os_type=OS_WINDOWS - flags = '& - & /warn:all& - & /check:all& - & /error-limit:1& - & /Od& - & /Z7& - & /assume:byterecl& - & /traceback& - &' - case(16) !intel_llvm - compiler='ifx' - flags = '& - & -warn all& - & -check all& - & -error-limit 1& - & -O0& - & -g& - & -assume byterecl& - & -traceback& - &' - case(17) !intel_llvm_windows - compiler='ifx' - os_type=OS_WINDOWS - flags = '& - & /warn:all& - & /check:all& - & /error-limit:1& - & /Od& - & /Z7& - & /assume:byterecl& - &' - case(18) !nag - compiler='nagfor' - flags = '& - & -g& - & -C=all& - & -O0& - & -gline& - & -coarray=single& - & -PIC& - &' - end select - call new_profile(profiles(i), profile_name, compiler, os_type, flags) - end do - end subroutine get_default_profiles + function get_default_profiles(error) result(default_profiles) + type(error_t), allocatable, intent(out) :: error + type(profile_config_t), allocatable :: default_profiles(:) + default_profiles = [ & + & new_profile('release', 'caf', OS_ALL, flags=' -O3 -Wimplicit-interface& + & -fPIC -fmax-errors=1 -funroll-loops'), & + & new_profile('release', 'gfortran', OS_ALL, flags=' -O3 -Wimplicit-interface -fPIC& + & -fmax-errors=1 -funroll-loops -fcoarray=single'), & + & new_profile('release', 'f95', OS_ALL, flags=' -O3 -Wimplicit-interface -fPIC& + & -fmax-errors=1 -ffast-math -funroll-loops'), & + & new_profile('release', 'nvfortran', OS_ALL, flags = ' -Mbackslash'), & + & new_profile('release', 'ifort', OS_ALL, flags = ' -fp-model precise -pc64 -align all& + & -error-limit 1 -reentrancy threaded& + & -nogen-interfaces -assume byterecl'), & + & new_profile('release', 'ifort', OS_WINDOWS, flags = ' /fp:precise /align:all& + & /error-limit:1 /reentrancy:threaded& + & /nogen-interfaces /assume:byterecl'), & + & new_profile('release', 'ifx', OS_ALL, flags = ' -fp-model=precise -pc64& + & -align all -error-limit 1 -reentrancy threaded& + & -nogen-interfaces -assume byterecl'), & + & new_profile('release', 'ifx', OS_WINDOWS, flags = ' /fp:precise /align:all& + & /error-limit:1 /reentrancy:threaded& + & /nogen-interfaces /assume:byterecl'), & + & new_profile('release', 'nagfor', OS_ALL, flags = ' -O4 -coarray=single -PIC'), & + & new_profile('debug', 'caf', OS_ALL, flags = ' -Wall -Wextra -Wimplicit-interface& + & -fPIC -fmax-errors=1 -g -fcheck=bounds& + & -fcheck=array-temps -fbacktrace'), & + & new_profile('debug', 'gfortran', OS_ALL, flags = ' -Wall -Wextra -Wimplicit-interface& + & -fPIC -fmax-errors=1 -g -fcheck=bounds& + & -fcheck=array-temps -fbacktrace -fcoarray=single'), & + & new_profile('debug', 'f95', OS_ALL, flags = ' -Wall -Wextra -Wimplicit-interface& + & -fPIC -fmax-errors=1 -g -fcheck=bounds& + & -fcheck=array-temps -Wno-maybe-uninitialized& + & -Wno-uninitialized -fbacktrace'), & + & new_profile('debug', 'nvfortran', OS_ALL, flags = ' -Minform=inform -Mbackslash -g& + & -Mbounds -Mchkptr -Mchkstk -traceback'), & + & new_profile('debug', 'ifort', OS_ALL, flags = ' -warn all -check all -error-limit 1& + & -O0 -g -assume byterecl -traceback'), & + & new_profile('debug', 'ifort', OS_WINDOWS, flags = ' /warn:all /check:all /error-limit:1& + & /Od /Z7 /assume:byterecl /traceback'), & + & new_profile('debug', 'ifx', OS_ALL, flags = ' -warn all -check all -error-limit 1& + & -O0 -g -assume byterecl -traceback'), & + & new_profile('debug', 'ifx', OS_WINDOWS, flags = ' /warn:all /check:all /error-limit:1& + & /Od /Z7 /assume:byterecl'), & + & new_profile('debug', 'nagfor', OS_ALL, flags = ' -g -C=all -O0 -gline -coarray=single -PIC') & + &] + end function get_default_profiles !> Write information on instance subroutine info(self, unit, verbosity) diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index 9746e5f031..10c3e51b6b 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -21,6 +21,7 @@ module fpm_model use iso_fortran_env, only: int64 use fpm_strings, only: string_t, str use fpm_dependency, only: dependency_tree_t +use fpm_manifest_profile, only: profile_config_t implicit none private @@ -86,6 +87,15 @@ module fpm_model !> Native libraries to link against type(string_t), allocatable :: link_libraries(:) + !> Fortran compiler flags + character(len=:), allocatable :: flags + + !> C compiler flags + character(len=:), allocatable :: c_flags + + !> Link time compiler flags + character(len=:), allocatable :: link_time_flags + !> Current hash integer(int64) :: digest @@ -101,6 +111,9 @@ module fpm_model !> Array of sources type(srcfile_t), allocatable :: sources(:) + !> Array of compiler profiles + type(profile_config_t), allocatable :: profiles(:) + end type package_t From 5550bf782eb344ffad8e8ea184a3b9bcce3ca955 Mon Sep 17 00:00:00 2001 From: kubajj Date: Tue, 15 Jun 2021 13:27:41 +0200 Subject: [PATCH 08/32] Initial implementation of package scope compiler profiles --- src/fpm.f90 | 45 +++++++++++-------- src/fpm/manifest/profiles.f90 | 14 ++---- src/fpm_backend.f90 | 6 +-- src/fpm_model.f90 | 1 + src/fpm_targets.f90 | 80 +++++++++++++++++++++++++-------- test/fpm_test/test_manifest.f90 | 24 +++++----- 6 files changed, 109 insertions(+), 61 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 7d054c4b7c..fa104c3d07 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -44,9 +44,10 @@ subroutine build_model(model, settings, package, error) integer :: i, j type(package_config_t) :: dependency + type(profile_config_t) :: primary_pkg_profile, current_pkg_profile character(len=:), allocatable :: manifest, lib_dir, profile, compiler_flags - logical :: duplicates_found = .false. + logical :: duplicates_found = .false., profile_found type(string_t) :: include_dir model%package_name = package%name @@ -182,21 +183,37 @@ subroutine build_model(model, settings, package, error) ! Check for duplicate modules call check_modules_for_duplicates(model, duplicates_found) if (duplicates_found) then - error stop 'Error: One or more duplicate module names found.' + error stop 'Error: One or more duplicate module names found.' end if ! Compiler flags logic if(settings%profile.eq.'')then - if (trim(settings%flag).eq.'') then - profile = 'debug' - end if + if (trim(settings%flag).eq.'') then + profile = 'debug' + end if else - profile = settings%profile + profile = settings%profile endif - if (allocated(package%profiles).and.allocated(profile)) then - call find_profile(package%profiles, profile, model%fortran_compiler, get_os_type(), compiler_flags) - print *,"Matching profile has the following flags: "//compiler_flags + + if (allocated(profile)) then + do i=1,size(model%packages) + associate(pkg => model%packages(i)) + if (allocated(pkg%profiles)) then + call find_profile(pkg%profiles, profile, model%fortran_compiler, & + & get_os_type(), profile_found, current_pkg_profile) + if (.not.profile_found .and. i.gt.1) then + current_pkg_profile = primary_pkg_profile + else if (i.eq.1) then + primary_pkg_profile = current_pkg_profile + end if + else + current_pkg_profile = primary_pkg_profile + end if + pkg%chosen_profile = current_pkg_profile + end associate + end do 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) @@ -206,16 +223,6 @@ subroutine build_model(model, settings, package, error) "", "Unknown compiler", model%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) - - call get_module_flags(model%fortran_compiler, & - & join_path(model%output_directory,model%package_name), & - & model%fortran_compile_flags) - if (allocated(compiler_flags)) then - model%fortran_compile_flags = " "//compiler_flags // settings%flag // model%fortran_compile_flags - else - model%fortran_compile_flags = settings%flag // model%fortran_compile_flags - end if end subroutine build_model diff --git a/src/fpm/manifest/profiles.f90 b/src/fpm/manifest/profiles.f90 index fe5f066e7b..4f339bfbdf 100644 --- a/src/fpm/manifest/profiles.f90 +++ b/src/fpm/manifest/profiles.f90 @@ -563,21 +563,18 @@ subroutine info(self, unit, verbosity) end subroutine info - subroutine find_profile(profiles, profile_name, compiler, os_type, flags, c_flags, link_time_flags) + subroutine find_profile(profiles, profile_name, compiler, os_type, found_matching, chosen_profile) type(profile_config_t), allocatable, intent(in) :: profiles(:) character(:), allocatable, intent(in) :: profile_name character(:), allocatable, intent(in) :: compiler integer, intent(in) :: os_type - character(:), allocatable, intent(out), optional :: flags - character(:), allocatable, intent(out), optional :: c_flags - character(:), allocatable, intent(out), optional :: link_time_flags + logical, intent(out) :: found_matching + type(profile_config_t), intent(out) :: chosen_profile character(:), allocatable :: curr_profile_name character(:), allocatable :: curr_compiler integer :: curr_os - type(profile_config_t) :: chosen_profile integer :: i, priority, curr_priority - logical :: found_matching - + found_matching = .false. do i=1,size(profiles) curr_profile_name = profiles(i)%profile_name @@ -607,8 +604,5 @@ subroutine find_profile(profiles, profile_name, compiler, os_type, flags, c_flag end if end do end if - if (present(flags)) flags = chosen_profile%flags - if (present(c_flags)) c_flags = chosen_profile%c_flags - if (present(link_time_flags)) link_time_flags = chosen_profile%link_time_flags end subroutine find_profile end module fpm_manifest_profile diff --git a/src/fpm_backend.f90 b/src/fpm_backend.f90 index 99b6be8aa2..bc9db4e946 100644 --- a/src/fpm_backend.f90 +++ b/src/fpm_backend.f90 @@ -51,9 +51,9 @@ subroutine build_package(targets,model) integer, allocatable :: schedule_ptr(:) ! Need to make output directory for include (mod) files - if (.not.exists(join_path(model%output_directory,model%package_name))) then - call mkdir(join_path(model%output_directory,model%package_name)) - end if +! if (.not.exists(join_path(model%output_directory,model%package_name))) then +! call mkdir(join_path(model%output_directory,model%package_name)) +! end if ! Perform depth-first topological sort of targets do i=1,size(targets) diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index 10c3e51b6b..8ab314f23c 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -114,6 +114,7 @@ module fpm_model !> Array of compiler profiles type(profile_config_t), allocatable :: profiles(:) + type(profile_config_t) :: chosen_profile end type package_t diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index c247232b6d..1bb651a574 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -28,8 +28,9 @@ module fpm_targets use fpm_error, only: error_t, fatal_error use fpm_model use fpm_environment, only: get_os_type, OS_WINDOWS -use fpm_filesystem, only: dirname, join_path, canon_path -use fpm_strings, only: string_t, operator(.in.), string_cat +use fpm_filesystem, only: basename, dirname, join_path, canon_path +use fpm_strings, only: string_t, operator(.in.), string_cat, fnv_1a, string_t +use fpm_compiler, only: get_module_flags implicit none private @@ -183,18 +184,22 @@ subroutine build_target_list(targets,model) j=1,size(model%packages))]) if (with_lib) call add_target(targets,type = FPM_TARGET_ARCHIVE,& - output_file = join_path(model%output_directory,& + output_file = join_path('build_libs',& model%package_name,'lib'//model%package_name//'.a')) do j=1,size(model%packages) - - associate(sources=>model%packages(j)%sources) + associate(package=>model%packages(j)) + associate(sources=>package%sources) do i=1,size(sources) select case (sources(i)%unit_type) case (FPM_UNIT_MODULE,FPM_UNIT_SUBMODULE,FPM_UNIT_SUBPROGRAM,FPM_UNIT_CSOURCE) - + if (sources(i)%unit_type.eq.FPM_UNIT_CSOURCE) then + sources(i)%c_flags=package%chosen_profile%c_flags + else + sources(i)%flags=package%chosen_profile%flags + end if call add_target(targets,source = sources(i), & type = merge(FPM_TARGET_C_OBJECT,FPM_TARGET_OBJECT,& sources(i)%unit_type==FPM_UNIT_CSOURCE), & @@ -206,6 +211,8 @@ subroutine build_target_list(targets,model) end if case (FPM_UNIT_PROGRAM) + sources(i)%flags=package%chosen_profile%flags + sources(i)%link_time_flags=package%chosen_profile%link_time_flags call add_target(targets,type = FPM_TARGET_OBJECT,& output_file = get_object_name(sources(i)), & @@ -228,7 +235,7 @@ subroutine build_target_list(targets,model) call add_target(targets,type = FPM_TARGET_EXECUTABLE,& link_libraries = sources(i)%link_libraries, & - output_file = join_path(model%output_directory,exe_dir, & + output_file = join_path(get_output_directory(sources(i)),exe_dir, & sources(i)%exe_name//xsuffix)) ! Executable depends on object @@ -244,6 +251,7 @@ subroutine build_target_list(targets,model) end do end associate + end associate end do @@ -253,15 +261,25 @@ function get_object_name(source) result(object_file) ! Generate object target path from source name and model params ! ! - type(srcfile_t), intent(in) :: source + type(srcfile_t), intent(inout) :: source character(:), allocatable :: object_file integer :: i character(1), parameter :: filesep = '/' - character(:), allocatable :: dir + character(:), allocatable :: dir, out_dir, module_flags object_file = canon_path(source%file_name) + out_dir = get_output_directory(source) + + call get_module_flags(model%fortran_compiler, out_dir, module_flags) + + if (allocated(source%flags)) then + source%flags = source%flags // module_flags + else if (allocated(source%c_flags)) then + source%c_flags = source%c_flags // module_flags + end if + ! Convert any remaining directory separators to underscores i = index(object_file,filesep) do while(i > 0) @@ -269,10 +287,30 @@ function get_object_name(source) result(object_file) i = index(object_file,filesep) end do - object_file = join_path(model%output_directory,model%package_name,object_file)//'.o' + object_file = join_path(out_dir,model%package_name, object_file)//'.o' end function get_object_name + function get_output_directory(source) result(out_dir) + type(srcfile_t), intent(in) :: source + character(len=16) :: build_name + character(:), allocatable :: out_dir + type(string_t) :: include_dir + + if (allocated(source%flags)) then + write(build_name, '(z16.16)') fnv_1a(source%flags) + else if (allocated(source%c_flags)) then + write(build_name, '(z16.16)') fnv_1a(source%c_flags) + end if + out_dir = join_path('build',basename(model%fortran_compiler)//'_'//build_name) + include_dir = string_t(out_dir) + if (.not. allocated(model%include_dirs)) then + model%include_dirs = [include_dir] + else if (.not. (out_dir.in.model%include_dirs)) then + model%include_dirs = [model%include_dirs, include_dir] + end if + end function get_output_directory + end subroutine build_target_list @@ -307,7 +345,12 @@ subroutine add_target(targets,type,output_file,source,link_libraries) allocate(new_target) new_target%target_type = type new_target%output_file = output_file - if (present(source)) new_target%source = source + if (present(source)) then + new_target%source = source + if (allocated(source%flags)) new_target%compile_flags = " "//source%flags + if (allocated(source%c_flags)) new_target%compile_flags = " "//source%c_flags + if (allocated(source%link_time_flags)) new_target%link_flags = " "//source%link_time_flags//" " + end if if (present(link_libraries)) new_target%link_libraries = link_libraries allocate(new_target%dependencies(0)) @@ -471,7 +514,7 @@ subroutine resolve_target_linking(targets, model) if (allocated(model%include_dirs)) then if (size(model%include_dirs) > 0) then global_include_flags = global_include_flags // & - & " -I" // string_cat(model%include_dirs," -I") + & " -I " // string_cat(model%include_dirs," -I ") end if end if @@ -479,11 +522,12 @@ 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 - else - target%compile_flags = global_include_flags - end if +! if (target%target_type /= FPM_TARGET_C_OBJECT) then +! target%compile_flags = model%fortran_compile_flags//" "//global_include_flags +! else +! target%compile_flags = global_include_flags +! end if + target%compile_flags = target%compile_flags // global_include_flags allocate(target%link_objects(0)) @@ -497,7 +541,7 @@ subroutine resolve_target_linking(targets, model) call get_link_objects(target%link_objects,target,is_exe=.true.) - target%link_flags = string_cat(target%link_objects," ") + target%link_flags = target%link_flags // string_cat(target%link_objects," ") if (allocated(target%link_libraries)) then if (size(target%link_libraries) > 0) then diff --git a/test/fpm_test/test_manifest.f90 b/test/fpm_test/test_manifest.f90 index 93150d3749..8c477a7536 100644 --- a/test/fpm_test/test_manifest.f90 +++ b/test/fpm_test/test_manifest.f90 @@ -4,7 +4,7 @@ module test_manifest use testsuite, only : new_unittest, unittest_t, error_t, test_failed, & & check_string use fpm_manifest - use fpm_manifest_profile, only: find_profile + use fpm_manifest_profile, only: profile_config_t, find_profile use fpm_strings, only: operator(.in.) implicit none private @@ -403,6 +403,8 @@ subroutine test_profiles(error) character(len=*), parameter :: manifest = 'fpm-profiles.toml' integer :: unit character(:), allocatable :: profile_name, compiler, flags + logical :: profile_found + type(profile_config_t) :: chosen_profile open(file=manifest, newunit=unit) write(unit, '(a)') & @@ -434,40 +436,40 @@ subroutine test_profiles(error) profile_name = 'release' compiler = 'gfortran' - call find_profile(package%profiles, profile_name, compiler, 1, flags) - if (.not.flags.eq.'4 3 7') then + call find_profile(package%profiles, profile_name, compiler, 1, profile_found, chosen_profile) + if (.not.(chosen_profile%flags.eq.'4 3 7')) then call test_failed(error, "Failed to append flags from profiles named 'all'") return end if profile_name = 'release' compiler = 'gfortran' - call find_profile(package%profiles, profile_name, compiler, 3, flags) - if (.not.flags.eq.'5 6') then + call find_profile(package%profiles, profile_name, compiler, 3, profile_found, chosen_profile) + if (.not.(chosen_profile%flags.eq.'5 6')) then call test_failed(error, "Failed to choose profile with OS 'all'") return end if profile_name = 'publish' compiler = 'gfortran' - call find_profile(package%profiles, profile_name, compiler, 1, flags) - if (.not.flags.eq.'') then + call find_profile(package%profiles, profile_name, compiler, 1, profile_found, chosen_profile) + if (allocated(chosen_profile%flags)) then call test_failed(error, "Profile named "//profile_name//" should not exist") return end if profile_name = 'debug' compiler = 'ifort' - call find_profile(package%profiles, profile_name, compiler, 3, flags) - if (.not.flags.eq.' /warn:all /check:all /error-limit:1 /Od /Z7 /assume:byterecl /traceback') then + call find_profile(package%profiles, profile_name, compiler, 3, profile_found, chosen_profile) + if (.not.(chosen_profile%flags.eq.' /warn:all /check:all /error-limit:1 /Od /Z7 /assume:byterecl /traceback')) then call test_failed(error, "Failed to load built-in profile"//flags) return end if profile_name = 'release' compiler = 'ifort' - call find_profile(package%profiles, profile_name, compiler, 1, flags) - if (.not.flags.eq.'8') then + call find_profile(package%profiles, profile_name, compiler, 1, profile_found, chosen_profile) + if (.not.(chosen_profile%flags.eq.'8')) then call test_failed(error, "Failed to overwrite built-in profile") return end if From 941c23ba3582c460e782acf9c00a784a4774d158 Mon Sep 17 00:00:00 2001 From: kubajj Date: Fri, 18 Jun 2021 15:29:13 +0200 Subject: [PATCH 09/32] Add file scope flags and representation of profiles as string for show_model --- manifest-reference.md | 32 ++++++ src/fpm.f90 | 18 +++- src/fpm/manifest.f90 | 12 ++- src/fpm/manifest/package.f90 | 12 ++- src/fpm/manifest/profiles.f90 | 178 ++++++++++++++++++++++++++++------ src/fpm_backend.f90 | 7 ++ src/fpm_command_line.f90 | 17 ---- src/fpm_compiler.f90 | 16 +-- src/fpm_model.f90 | 57 +++++++---- src/fpm_targets.f90 | 68 ++++++++++--- 10 files changed, 322 insertions(+), 95 deletions(-) diff --git a/manifest-reference.md b/manifest-reference.md index cd79b0be0e..44c93b4ad8 100644 --- a/manifest-reference.md +++ b/manifest-reference.md @@ -47,6 +47,7 @@ Every manifest file consists of the following sections: Project library dependencies - [*dev-dependencies*](#development-dependencies): Dependencies only needed for tests +- [*compiler profiles*](#compiler-flags-profiles): - [*install*](#installation-configuration): Installation configuration @@ -459,6 +460,37 @@ rev = "2f5eaba864ff630ba0c3791126a3f811b6e437f3" Development dependencies allow to declare *dev-dependencies* in the manifest root, which are available to all tests but not exported with the project. +## Compiler flags profiles +Compiler flags profiles can be declared in the *profiles* table. They are organised into subtables in the following order: + +| Subtable | Profile name | Compiler | Operating system | +|---|:---:|:---:|:---:| +| Example | `debug` | `gfortran` | `linux` | + +There are 4 fields that can be specified for each of the profiles: +- `'flags'` - Fortran compiler flags +- `'c_flags'` - C compiler flags +- `'link_time_flags'` - Compiler flags applied at linking time to executables +- `'files'` - A subtable containing file name-flags pairs with flags applied to single source files (these overwrite profile flags) + +An example of a complete table follows: +```toml +[profiles.debug.gfortran.linux] +flags = '-g -Wall' +files={"source/greet_m.f90"="-Wall -g -fcheck=all", "source/farewell_m.f90"="-Og"} +``` + +All the subtables can be omitted in the definition. In such case the following behaviour is applied: +- *Profile name* is omitted - Fields of this subtable are added to fields of all profiles with matching compiler and OS definitions (this is not the case for `files` field) +- *Compiler* is omitted - Compiler is set to *default* value (currently `gfortran`) +- *Operating system* is omitted - Fields of this subtable are used if and only if there is no profile with perfectly matching OS definition + +Example: +- The flags field of the following profile is appended to flags fields of all profiles using `gfortran` on `linux` OS +```toml +[profiles.linux] +flags = '-g -Wall' +``` ## Installation configuration diff --git a/src/fpm.f90 b/src/fpm.f90 index fa104c3d07..93607c5dc8 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -132,7 +132,7 @@ subroutine build_model(model, settings, package, error) manifest = join_path(dep%proj_dir, "fpm.toml") call get_package_data(dependency, manifest, error, & - apply_defaults=.true.) + apply_defaults=.true., proj_dir=dep%proj_dir) if (allocated(error)) exit model%packages(i)%name = dependency%name @@ -172,12 +172,17 @@ subroutine build_model(model, settings, package, error) end do if (allocated(error)) return + if (.not.(trim(settings%flag).eq.'')) then + model%cmd_compile_flags = settings%flag + else + model%cmd_compile_flags = '' + end if + 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(*,*)' INCLUDE DIRECTORIES: [', string_cat(model%include_dirs,','),']' + write(*,*)' COMMAND LINE COMPILER OPTIONS: ', model%cmd_compile_flags +! write(*,*)' INCLUDE DIRECTORIES: [', string_cat(model%include_dirs,','),']' end if ! Check for duplicate modules @@ -189,7 +194,7 @@ subroutine build_model(model, settings, package, error) ! Compiler flags logic if(settings%profile.eq.'')then if (trim(settings%flag).eq.'') then - profile = 'debug' + profile = 'debug' end if else profile = settings%profile @@ -204,6 +209,9 @@ subroutine build_model(model, settings, package, error) if (.not.profile_found .and. i.gt.1) then current_pkg_profile = primary_pkg_profile else if (i.eq.1) then + if (.not.profile_found) then + error stop 'Error: primary package does not have given profile.' + end if primary_pkg_profile = current_pkg_profile end if else diff --git a/src/fpm/manifest.f90 b/src/fpm/manifest.f90 index 4170b9177f..38972097f7 100644 --- a/src/fpm/manifest.f90 +++ b/src/fpm/manifest.f90 @@ -88,7 +88,7 @@ end subroutine default_test !> Obtain package meta data from a configuation file - subroutine get_package_data(package, file, error, apply_defaults) + subroutine get_package_data(package, file, error, apply_defaults, proj_dir) !> Parsed package meta data type(package_config_t), intent(out) :: package @@ -102,6 +102,9 @@ subroutine get_package_data(package, file, error, apply_defaults) !> Apply package defaults (uses file system operations) logical, intent(in), optional :: apply_defaults + !> Path to project directory of the current package + character(len=*), intent(in), optional :: proj_dir + type(toml_table), allocatable :: table character(len=:), allocatable :: root @@ -112,8 +115,11 @@ subroutine get_package_data(package, file, error, apply_defaults) call fatal_error(error, "Unclassified error while reading: '"//file//"'") return end if - - call new_package(package, table, error) + if (present(proj_dir)) then + call new_package(package, table, error, proj_dir) + else + call new_package(package, table, error) + end if if (allocated(error)) return if (present(apply_defaults)) then diff --git a/src/fpm/manifest/package.f90 b/src/fpm/manifest/package.f90 index 72bca47a2f..8b928fa32f 100644 --- a/src/fpm/manifest/package.f90 +++ b/src/fpm/manifest/package.f90 @@ -43,6 +43,7 @@ module fpm_manifest_package use fpm_toml, only : toml_table, toml_array, toml_key, toml_stat, get_value, & & len use fpm_versioning, only : version_t, new_version + use fpm_filesystem, only: join_path implicit none private @@ -103,7 +104,7 @@ module fpm_manifest_package !> Construct a new package configuration from a TOML data structure - subroutine new_package(self, table, error) + subroutine new_package(self, table, error, proj_dir) !> Instance of the package configuration type(package_config_t), intent(out) :: self @@ -114,13 +115,16 @@ subroutine new_package(self, table, error) !> Error handling type(error_t), allocatable, intent(out) :: error + !> Path to project directory of the current package + character(len=*), intent(in), optional :: proj_dir + ! Backspace (8), tabulator (9), newline (10), formfeed (12) and carriage ! return (13) are invalid in package names character(len=*), parameter :: invalid_chars = & achar(8) // achar(9) // achar(10) // achar(12) // achar(13) type(toml_table), pointer :: child, node type(toml_array), pointer :: children - character(len=:), allocatable :: version + character(len=:), allocatable :: version, file_scope_path integer :: ii, nn, stat call check(table, error) @@ -183,8 +187,10 @@ subroutine new_package(self, table, error) end if call get_value(table, "profiles", child, requested=.false.) + file_scope_path = "" if (associated(child)) then - call new_profiles(self%profiles, child, error) + if (present(proj_dir)) file_scope_path = proj_dir + call new_profiles(self%profiles, child, error, file_scope_path) if (allocated(error)) return else self%profiles = get_default_profiles(error) diff --git a/src/fpm/manifest/profiles.f90 b/src/fpm/manifest/profiles.f90 index 4f339bfbdf..ac47689466 100644 --- a/src/fpm/manifest/profiles.f90 +++ b/src/fpm/manifest/profiles.f90 @@ -1,16 +1,69 @@ +!> Implementation of the meta data for compiler flag profiles. +!> +!> A profiles table can currently have the following subtables: +!> Profile names - any string, if omitted, flags are appended to all matching profiles +!> Compiler - any from the following list, if omitted, `DEFAULT_COMPILER` is used +!> - "gfortran" +!> - "ifort" +!> - "ifx" +!> - "pgfortran" +!> - "nvfrotran" +!> - "flang" +!> - "caf" +!> - "f95" +!> - "lfortran" +!> - "lfc" +!> - "nagfor" +!> - "crayftn" +!> - "xlf90" +!> - "ftn95" +!> OS - any from the following list, if omitted, the profile is used if and only +!> if there is no profile perfectly matching the current configuration +!> - "linux" +!> - "macos" +!> - "windows" +!> - "cygwin" +!> - "solaris" +!> - "freebsd" +!> - "openbsd" +!> - "unknown" +!> - "UNKNOWN" +!> +!> Each of the subtables currently supports the following fields: +!>```toml +!>[profile.debug.gfortran.linux] +!> flags="-Wall -g -Og" +!> c_flags="-g O1" +!> link_time_flags="-xlinkopt" +!> files={"hello_world.f90"="-Wall -O3"} +!>``` +!> module fpm_manifest_profile use fpm_error, only : error_t, syntax_error, fatal_error use fpm_toml, only : toml_table, toml_key, toml_stat, get_value use fpm_strings, only: lower use fpm_environment, only: get_os_type, OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, & OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD + use fpm_filesystem, only: join_path implicit none private public :: profile_config_t, new_profile, new_profiles, get_default_profiles, & - & find_profile, DEFAULT_COMPILER + & info_profile, find_profile, DEFAULT_COMPILER character(len=*), parameter :: DEFAULT_COMPILER = 'gfortran' integer, parameter :: OS_ALL = -1 + character(len=:), allocatable :: path + + !> Type storing file name - file scope compiler flags pairs + type :: file_scope_flag + + !> Name of the file + character(len=:), allocatable :: file_name + + !> File scope flags + character(len=:), allocatable :: flags + end type file_scope_flag + !> Configuration meta data for a profile type :: profile_config_t !> Name of the profile @@ -31,16 +84,20 @@ module fpm_manifest_profile !> Link time compiler flags character(len=:), allocatable :: link_time_flags + !> File scope flags + type(file_scope_flag), allocatable :: file_scope_flags(:) + contains !> Print information on this instance procedure :: info + end type profile_config_t contains !> Construct a new profile configuration from a TOML data structure - function new_profile(profile_name, compiler, os_type, flags, c_flags, link_time_flags) result(profile) + function new_profile(profile_name, compiler, os_type, flags, c_flags, link_time_flags, file_scope_flags) result(profile) !> Name of the profile character(len=*), intent(in) :: profile_name @@ -59,7 +116,10 @@ function new_profile(profile_name, compiler, os_type, flags, c_flags, link_time_ !> Link time compiler flags character(len=*), optional, intent(in) :: link_time_flags - + + !> File scope flags + type(file_scope_flag), optional, intent(in) :: file_scope_flags(:) + type(profile_config_t) :: profile profile%profile_name = profile_name @@ -80,8 +140,9 @@ function new_profile(profile_name, compiler, os_type, flags, c_flags, link_time_ else profile%link_time_flags = "" end if -! print *,profile_name," ",compiler," ",os_type," ",flags -! print *,profile_name," ",compiler," ",os_type," ",flags, " ",c_flags," ", link_time_flags + if (present(file_scope_flags)) then + profile%file_scope_flags = file_scope_flags + end if end function new_profile !> Check if compiler name is a valid compiler name @@ -109,17 +170,6 @@ subroutine validate_os_name(os_name, is_valid) end select end subroutine validate_os_name - subroutine validate_key_name(key_name, is_valid) - character(len=:), allocatable, intent(in) :: key_name - logical, intent(out) :: is_valid - select case (key_name) - case ("flags", "c_flags", "link_time_flags") - is_valid = .true. - case default - is_valid = .false. - end select - end subroutine validate_key_name - subroutine match_os_type(os_name, os_type) character(len=:), allocatable, intent(in) :: os_name integer, intent(out) :: os_type @@ -161,18 +211,16 @@ subroutine get_flags(profile_name, compiler_name, os_type, key_list, table, prof !> Error handling type(error_t), allocatable, intent(out) :: error - character(len=:), allocatable :: flags, c_flags, link_time_flags, key_name - integer :: ikey, stat + character(len=:), allocatable :: flags, c_flags, link_time_flags, key_name, file_name, file_flags + type(toml_table), pointer :: files + type(toml_key), allocatable :: file_list(:) + type(file_scope_flag), allocatable :: file_scope_flags(:) + integer :: ikey, ifile, stat logical :: is_valid if (size(key_list).ge.1) then do ikey=1,size(key_list) key_name = key_list(ikey)%key -! call validate_key_name(key_name, is_valid) -! if (.not. is_valid) then -! call syntax_error(error, "Only flags, c_flags and link_time_flags are valid keys in profiles table") -! return -! end if if (key_name.eq.'flags') then call get_value(table, 'flags', flags, stat=stat) if (stat /= toml_stat%success) then @@ -185,12 +233,33 @@ subroutine get_flags(profile_name, compiler_name, os_type, key_list, table, prof call syntax_error(error, "c_flags has to be a key-value pair") return end if - else + else if (key_name.eq.'link_time_flags') then call get_value(table, 'link_time_flags', link_time_flags, stat=stat) if (stat /= toml_stat%success) then call syntax_error(error, "link_time_flags has to be a key-value pair") return end if + else if (key_name.eq.'files') then + call get_value(table, 'files', files, stat=stat) + if (stat /= toml_stat%success) then + call syntax_error(error, "files has to be a table") + return + end if + call files%get_keys(file_list) + allocate(file_scope_flags(size(file_list))) + do ifile=1,size(file_list) + file_name = file_list(ifile)%key + call get_value(files, file_name, file_flags, stat=stat) + if (stat /= toml_stat%success) then + call syntax_error(error, "file scope flags has to be a key-value pair") + return + end if + associate(cur_file=>file_scope_flags(ifile)) + if (.not.(path.eq."")) file_name = join_path(path, file_name) + cur_file%file_name = file_name + cur_file%flags = file_flags + end associate + end do end if end do end if @@ -199,8 +268,12 @@ subroutine get_flags(profile_name, compiler_name, os_type, key_list, table, prof if (.not.allocated(c_flags)) c_flags='' if (.not.allocated(link_time_flags)) link_time_flags='' -! call new_profile(profiles(profindex), profile_name, compiler_name, os_type, flags, c_flags, link_time_flags) - profiles(profindex) = new_profile(profile_name, compiler_name, os_type, flags, c_flags, link_time_flags) + if (allocated(file_scope_flags)) then + profiles(profindex) = new_profile(profile_name, compiler_name, os_type, & + & flags, c_flags, link_time_flags, file_scope_flags) + else + profiles(profindex) = new_profile(profile_name, compiler_name, os_type, flags, c_flags, link_time_flags) + end if profindex = profindex + 1 end subroutine get_flags @@ -366,7 +439,7 @@ subroutine traverse_compilers(profile_name, comp_list, table, error, profiles_si end subroutine traverse_compilers !> Construct new profiles array from a TOML data structure - subroutine new_profiles(profiles, table, error) + subroutine new_profiles(profiles, table, error, file_scope_path) !> Instance of the dependency configuration type(profile_config_t), allocatable, intent(out) :: profiles(:) @@ -377,6 +450,9 @@ subroutine new_profiles(profiles, table, error) !> Error handling type(error_t), allocatable, intent(out) :: error + !> Path to project directory of the current package + character(len=*), intent(in), optional :: file_scope_path + type(toml_table), pointer :: prof_node type(toml_key), allocatable :: prof_list(:) type(toml_key), allocatable :: comp_list(:) @@ -386,6 +462,11 @@ subroutine new_profiles(profiles, table, error) logical :: is_valid type(profile_config_t), allocatable :: default_profiles(:) + if (present(file_scope_path)) then + path = file_scope_path + else + path = '' + end if default_profiles = get_default_profiles(error) if (allocated(error)) return call table%get_keys(prof_list) @@ -563,6 +644,49 @@ subroutine info(self, unit, verbosity) end subroutine info + function info_profile(profile) result(s) + ! Prints a representation of profile_config_t + type(profile_config_t), intent(in) :: profile + character(:), allocatable :: s + integer :: i + s = "profile_config_t(" + s = s // 'profile_name="' // profile%profile_name // '"' + s = s // ', compiler="' // profile%compiler // '"' + s = s // ", os_type=" + select case(profile%os_type) + case (OS_UNKNOWN) + s = s // "OS_UNKNOWN" + case (OS_LINUX) + s = s // "OS_LINUX" + case (OS_MACOS) + s = s // "OS_MACOS" + case (OS_WINDOWS) + s = s // "OS_WINDOWS" + case (OS_CYGWIN) + s = s // "OS_CYGWIN" + case (OS_SOLARIS) + s = s // "OS_SOLARIS" + case (OS_FREEBSD) + s = s // "OS_FREEBSD" + case (OS_OPENBSD) + s = s // "OS_OPENBSD" + case (OS_ALL) + s = s // "OS_ALL" + case default + s = s // "INVALID" + end select + if (allocated(profile%flags)) s = s // ', flags="' // profile%flags // '"' + if (allocated(profile%c_flags)) s = s // ', c_flags="' // profile%c_flags // '"' + if (allocated(profile%link_time_flags)) s = s // ', link_time_flags="' // profile%link_time_flags // '"' + if (allocated(profile%file_scope_flags)) then + do i=1,size(profile%file_scope_flags) + s = s // ', flags for '//profile%file_scope_flags(i)%file_name// & + & ' ="' // profile%file_scope_flags(i)%flags // '"' + end do + end if + s = s // ")" + end function info_profile + subroutine find_profile(profiles, profile_name, compiler, os_type, found_matching, chosen_profile) type(profile_config_t), allocatable, intent(in) :: profiles(:) character(:), allocatable, intent(in) :: profile_name diff --git a/src/fpm_backend.f90 b/src/fpm_backend.f90 index bc9db4e946..b2caf7ae09 100644 --- a/src/fpm_backend.f90 +++ b/src/fpm_backend.f90 @@ -65,6 +65,13 @@ subroutine build_package(targets,model) ! Construct build schedule queue call schedule_targets(queue, schedule_ptr, targets) + ! Create all build directories + if (allocated(model%include_dirs)) then + do i=1,size(model%include_dirs) + call mkdir(model%include_dirs(i)%s) + end do + end if + ! Loop over parallel schedule regions do i=1,size(schedule_ptr)-1 diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 41575faced..938791cedd 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -69,7 +69,6 @@ module fpm_command_line logical :: show_model=.false. character(len=:),allocatable :: compiler character(len=:),allocatable :: profile - character(len=:),allocatable :: build_name character(len=:),allocatable :: flag end type @@ -198,7 +197,6 @@ subroutine get_command_line_settings(cmd_settings) 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, & @@ -222,7 +220,6 @@ subroutine get_command_line_settings(cmd_settings) allocate( fpm_build_settings :: cmd_settings ) cmd_settings=fpm_build_settings( & - & build_name=val_build,& & profile=val_profile,& & compiler=val_compiler, & & flag=val_flag, & @@ -362,7 +359,6 @@ subroutine get_command_line_settings(cmd_settings) allocate(install_settings) install_settings = fpm_install_settings(& list=lget('list'), & - build_name=val_build, & profile=val_profile,& compiler=val_compiler, & flag=val_flag, & @@ -418,7 +414,6 @@ subroutine get_command_line_settings(cmd_settings) 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, & @@ -479,7 +474,6 @@ subroutine get_command_line_settings(cmd_settings) contains subroutine check_build_vals() - character(len=:), allocatable :: flags val_compiler=sget('compiler') if(val_compiler.eq.'') then @@ -488,17 +482,6 @@ subroutine check_build_vals() 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 b3e3a56157..ea6954fc73 100644 --- a/src/fpm_compiler.f90 +++ b/src/fpm_compiler.f90 @@ -304,28 +304,28 @@ subroutine get_module_flags(compiler, modpath, flags) select case(id) case default - flags=' -module '//modpath//' -I '//modpath + flags=' -module '//modpath case(id_caf, id_gcc, id_f95, id_cray) - flags=' -J '//modpath//' -I '//modpath + flags=' -J '//modpath case(id_nvhpc, id_pgi, id_flang) - flags=' -module '//modpath//' -I '//modpath + flags=' -module '//modpath 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 + flags=' -module '//modpath case(id_intel_classic_windows, id_intel_llvm_windows) - flags=' /module:'//modpath//' /I'//modpath + flags=' /module:'//modpath case(id_lahey) - flags=' -M '//modpath//' -I '//modpath + flags=' -M '//modpath case(id_nag) - flags=' -mdir '//modpath//' -I '//modpath ! + flags=' -mdir '//modpath ! case(id_ibmxl) - flags=' -qmoddir '//modpath//' -I '//modpath + flags=' -qmoddir '//modpath end select diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index 8ab314f23c..df53c62f13 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -21,7 +21,7 @@ module fpm_model use iso_fortran_env, only: int64 use fpm_strings, only: string_t, str use fpm_dependency, only: dependency_tree_t -use fpm_manifest_profile, only: profile_config_t +use fpm_manifest_profile, only: profile_config_t, info_profile implicit none private @@ -114,6 +114,7 @@ module fpm_model !> Array of compiler profiles type(profile_config_t), allocatable :: profiles(:) + !> Chosen compiler profile type(profile_config_t) :: chosen_profile end type package_t @@ -137,8 +138,8 @@ module fpm_model !> Command line name to invoke c compiler character(:), allocatable :: c_compiler - !> Command line flags passed to fortran for compilation - character(:), allocatable :: fortran_compile_flags + !> Command line flags passed for compilation + character(:), allocatable :: cmd_compile_flags !> Base directory for build character(:), allocatable :: output_directory @@ -175,6 +176,14 @@ function info_package(p) result(s) if (i < size(p%sources)) s = s // ", " end do s = s // "]" + if (allocated(p%profiles)) then + s = s // ', profiles=[' + do i=1,size(p%profiles) + s = s // info_profile(p%profiles(i)) + if (i < size(p%profiles)) s = s // ", " + end do + s = s // "]" + end if s = s // ")" end function info_package @@ -209,10 +218,12 @@ function info_srcfile(source) result(s) end select ! type(string_t), allocatable :: modules_provided(:) s = s // ", modules_provided=[" - do i = 1, size(source%modules_provided) - s = s // '"' // source%modules_provided(i)%s // '"' - if (i < size(source%modules_provided)) s = s // ", " - end do + if (allocated(source%modules_provided)) then + do i = 1, size(source%modules_provided) + s = s // '"' // source%modules_provided(i)%s // '"' + if (i < size(source%modules_provided)) s = s // ", " + end do + end if s = s // "]" ! integer :: unit_type = FPM_UNIT_UNKNOWN s = s // ", unit_type=" @@ -236,24 +247,30 @@ function info_srcfile(source) result(s) end select ! type(string_t), allocatable :: modules_used(:) s = s // ", modules_used=[" - do i = 1, size(source%modules_used) - s = s // '"' // source%modules_used(i)%s // '"' - if (i < size(source%modules_used)) s = s // ", " - end do + if (allocated(source%modules_used)) then + do i = 1, size(source%modules_used) + s = s // '"' // source%modules_used(i)%s // '"' + if (i < size(source%modules_used)) s = s // ", " + end do + end if s = s // "]" ! type(string_t), allocatable :: include_dependencies(:) s = s // ", include_dependencies=[" - do i = 1, size(source%include_dependencies) - s = s // '"' // source%include_dependencies(i)%s // '"' - if (i < size(source%include_dependencies)) s = s // ", " - end do + if (allocated(source%include_dependencies)) then + do i = 1, size(source%include_dependencies) + s = s // '"' // source%include_dependencies(i)%s // '"' + if (i < size(source%include_dependencies)) s = s // ", " + end do + end if s = s // "]" ! type(string_t), allocatable :: link_libraries(:) s = s // ", link_libraries=[" - do i = 1, size(source%link_libraries) - s = s // '"' // source%link_libraries(i)%s // '"' - if (i < size(source%link_libraries)) s = s // ", " - end do + if (allocated(source%link_libraries)) then + do i = 1, size(source%link_libraries) + s = s // '"' // source%link_libraries(i)%s // '"' + if (i < size(source%link_libraries)) s = s // ", " + end do + end if s = s // "]" ! integer(int64) :: digest s = s // ", digest=" // str(source%digest) @@ -289,7 +306,7 @@ function info_model(model) result(s) ! character(:), allocatable :: fortran_compiler s = s // ', fortran_compiler="' // model%fortran_compiler // '"' ! character(:), allocatable :: fortran_compile_flags - s = s // ', fortran_compile_flags="' // model%fortran_compile_flags // '"' + s = s // ', cmd_compile_flags="' // model%cmd_compile_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 1bb651a574..12c84f3f0e 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -31,6 +31,7 @@ module fpm_targets use fpm_filesystem, only: basename, dirname, join_path, canon_path use fpm_strings, only: string_t, operator(.in.), string_cat, fnv_1a, string_t use fpm_compiler, only: get_module_flags +use fpm_manifest_profile, only: profile_config_t implicit none private @@ -160,7 +161,8 @@ subroutine build_target_list(targets,model) type(fpm_model_t), intent(inout), target :: model integer :: i, j, n_source - character(:), allocatable :: xsuffix, exe_dir + character(:), allocatable :: xsuffix, exe_dir, file_scope_flag, flags_for_archive + character(len=16) :: build_name type(build_target_t), pointer :: dep logical :: with_lib @@ -183,22 +185,38 @@ subroutine build_target_list(targets,model) i=1,size(model%packages(j)%sources)), & j=1,size(model%packages))]) - if (with_lib) call add_target(targets,type = FPM_TARGET_ARCHIVE,& - output_file = join_path('build_libs',& - model%package_name,'lib'//model%package_name//'.a')) + if (with_lib) then + if (allocated(model%packages(1)%profiles)) then + flags_for_archive = model%cmd_compile_flags//" "//model%packages(1)%chosen_profile%flags + else + flags_for_archive = model%cmd_compile_flags + end if + write(build_name, '(z16.16)') fnv_1a(flags_for_archive) + call add_target(targets,type = FPM_TARGET_ARCHIVE,& + output_file = join_path('build',basename(model%fortran_compiler)//'_'// & + & build_name, model%package_name, 'lib'//model%package_name//'.a')) + end if do j=1,size(model%packages) - associate(package=>model%packages(j)) - associate(sources=>package%sources) - + associate(package=>model%packages(j), sources=>model%packages(j)%sources, profile=>model%packages(j)%chosen_profile) do i=1,size(sources) select case (sources(i)%unit_type) case (FPM_UNIT_MODULE,FPM_UNIT_SUBMODULE,FPM_UNIT_SUBPROGRAM,FPM_UNIT_CSOURCE) + ! make file scope flag override flags, use just one or the other + file_scope_flag = get_file_scope_flags(sources(i), profile) if (sources(i)%unit_type.eq.FPM_UNIT_CSOURCE) then - sources(i)%c_flags=package%chosen_profile%c_flags + if (file_scope_flag.eq."") then + sources(i)%c_flags=model%cmd_compile_flags//" "//profile%c_flags + else + sources(i)%c_flags=model%cmd_compile_flags//" "//file_scope_flag + end if else - sources(i)%flags=package%chosen_profile%flags + if (file_scope_flag.eq."") then + sources(i)%flags=model%cmd_compile_flags//" "//profile%flags + else + sources(i)%flags=model%cmd_compile_flags//" "//file_scope_flag + end if end if call add_target(targets,source = sources(i), & type = merge(FPM_TARGET_C_OBJECT,FPM_TARGET_OBJECT,& @@ -211,8 +229,8 @@ subroutine build_target_list(targets,model) end if case (FPM_UNIT_PROGRAM) - sources(i)%flags=package%chosen_profile%flags - sources(i)%link_time_flags=package%chosen_profile%link_time_flags + sources(i)%flags=model%cmd_compile_flags//" "//get_file_scope_flags(sources(i), profile)//profile%flags + sources(i)%link_time_flags=profile%link_time_flags call add_target(targets,type = FPM_TARGET_OBJECT,& output_file = get_object_name(sources(i)), & @@ -251,12 +269,34 @@ subroutine build_target_list(targets,model) end do end associate - end associate end do contains + function get_file_scope_flags(source, profile) result(file_scope_flag) + ! Try to match source%file_name in profile%file_scope_flags + ! + ! + type(srcfile_t), intent(in) :: source + type(profile_config_t), intent(in) :: profile + + character(:), allocatable :: file_scope_flag, current + integer :: i + + file_scope_flag = "" + + if (allocated(profile%file_scope_flags)) then + associate(fflags=>profile%file_scope_flags) + do i=1,size(fflags) + if (source%file_name.eq.fflags(i)%file_name) then + file_scope_flag = fflags(i)%flags//" " + end if + end do + end associate + end if + end function get_file_scope_flags + function get_object_name(source) result(object_file) ! Generate object target path from source name and model params ! @@ -292,7 +332,11 @@ function get_object_name(source) result(object_file) end function get_object_name function get_output_directory(source) result(out_dir) + ! Generate build directory name by hashing the flags of the source + ! + ! type(srcfile_t), intent(in) :: source + character(len=16) :: build_name character(:), allocatable :: out_dir type(string_t) :: include_dir From a1a503c6423edf429de1a2101c65eb6f6c5c7c11 Mon Sep 17 00:00:00 2001 From: kubajj Date: Mon, 21 Jun 2021 11:03:12 +0200 Subject: [PATCH 10/32] Change _ to - in toml fields names, minor changes in get_flags subroutine --- manifest-reference.md | 4 ++-- src/fpm/manifest/profiles.f90 | 26 +++++++++----------------- 2 files changed, 11 insertions(+), 19 deletions(-) diff --git a/manifest-reference.md b/manifest-reference.md index 44c93b4ad8..148a063dda 100644 --- a/manifest-reference.md +++ b/manifest-reference.md @@ -469,8 +469,8 @@ Compiler flags profiles can be declared in the *profiles* table. They are organi There are 4 fields that can be specified for each of the profiles: - `'flags'` - Fortran compiler flags -- `'c_flags'` - C compiler flags -- `'link_time_flags'` - Compiler flags applied at linking time to executables +- `'c-flags'` - C compiler flags +- `'link-time-flags'` - Compiler flags applied at linking time to executables - `'files'` - A subtable containing file name-flags pairs with flags applied to single source files (these overwrite profile flags) An example of a complete table follows: diff --git a/src/fpm/manifest/profiles.f90 b/src/fpm/manifest/profiles.f90 index ac47689466..4595a7b3e7 100644 --- a/src/fpm/manifest/profiles.f90 +++ b/src/fpm/manifest/profiles.f90 @@ -33,8 +33,8 @@ !>```toml !>[profile.debug.gfortran.linux] !> flags="-Wall -g -Og" -!> c_flags="-g O1" -!> link_time_flags="-xlinkopt" +!> c-flags="-g O1" +!> link-time-flags="-xlinkopt" !> files={"hello_world.f90"="-Wall -O3"} !>``` !> @@ -227,16 +227,16 @@ subroutine get_flags(profile_name, compiler_name, os_type, key_list, table, prof call syntax_error(error, "flags has to be a key-value pair") return end if - else if (key_name.eq.'c_flags') then - call get_value(table, 'c_flags', c_flags, stat=stat) + else if (key_name.eq.'c-flags') then + call get_value(table, 'c-flags', c_flags, stat=stat) if (stat /= toml_stat%success) then - call syntax_error(error, "c_flags has to be a key-value pair") + call syntax_error(error, "c-flags has to be a key-value pair") return end if - else if (key_name.eq.'link_time_flags') then - call get_value(table, 'link_time_flags', link_time_flags, stat=stat) + else if (key_name.eq.'link-time-flags') then + call get_value(table, 'link-time-flags', link_time_flags, stat=stat) if (stat /= toml_stat%success) then - call syntax_error(error, "link_time_flags has to be a key-value pair") + call syntax_error(error, "link-time-flags has to be a key-value pair") return end if else if (key_name.eq.'files') then @@ -264,16 +264,8 @@ subroutine get_flags(profile_name, compiler_name, os_type, key_list, table, prof end do end if - if (.not.allocated(flags)) flags='' - if (.not.allocated(c_flags)) c_flags='' - if (.not.allocated(link_time_flags)) link_time_flags='' - - if (allocated(file_scope_flags)) then - profiles(profindex) = new_profile(profile_name, compiler_name, os_type, & + profiles(profindex) = new_profile(profile_name, compiler_name, os_type, & & flags, c_flags, link_time_flags, file_scope_flags) - else - profiles(profindex) = new_profile(profile_name, compiler_name, os_type, flags, c_flags, link_time_flags) - end if profindex = profindex + 1 end subroutine get_flags From 298999798b9aa5380de9b9e24f6b20dc56eb9ca4 Mon Sep 17 00:00:00 2001 From: kubajj Date: Mon, 28 Jun 2021 10:57:38 +0200 Subject: [PATCH 11/32] Add example pacakges with compiler profiles, remove c_flags from srcfile_t --- .../program_with_compiler_profiles/.gitignore | 1 + .../app/main.f90 | 3 ++ .../program_with_compiler_profiles/fpm.toml | 17 +++++++++ .../.gitignore | 1 + .../apps/say_goodbye/say_goodbye.f90 | 7 ++++ .../apps/say_hello/say_Hello.f90 | 7 ++++ .../program_with_free_form_in_dot_f/fpm.toml | 36 +++++++++++++++++++ .../source/farewell_m.f | 14 ++++++++ .../source/greet_m.f | 14 ++++++++ .../source/subdir/constants.f90 | 7 ++++ .../tests/farewell/farewell_test.f90 | 18 ++++++++++ .../tests/greet/greet_test.f90 | 18 ++++++++++ .../hello_complex/.gitignore | 1 + .../apps/say_goodbye/say_goodbye.f90 | 7 ++++ .../apps/say_hello/say_Hello.f90 | 7 ++++ .../hello_complex/fpm.toml | 29 +++++++++++++++ .../hello_complex/source/farewell_m.f90 | 14 ++++++++ .../hello_complex/source/greet_m.f90 | 14 ++++++++ .../hello_complex/source/subdir/constants.f90 | 7 ++++ .../tests/farewell/farewell_test.f90 | 18 ++++++++++ .../hello_complex/tests/greet/greet_test.f90 | 18 ++++++++++ .../primary_package/.gitignore | 1 + .../primary_package/app/main.f90 | 4 +++ .../primary_package/fpm.toml | 20 +++++++++++ src/fpm_model.f90 | 3 -- src/fpm_targets.f90 | 16 ++++----- 26 files changed, 291 insertions(+), 11 deletions(-) create mode 100644 example_packages/program_with_compiler_profiles/.gitignore create mode 100644 example_packages/program_with_compiler_profiles/app/main.f90 create mode 100644 example_packages/program_with_compiler_profiles/fpm.toml create mode 100644 example_packages/program_with_free_form_in_dot_f/.gitignore create mode 100644 example_packages/program_with_free_form_in_dot_f/apps/say_goodbye/say_goodbye.f90 create mode 100644 example_packages/program_with_free_form_in_dot_f/apps/say_hello/say_Hello.f90 create mode 100644 example_packages/program_with_free_form_in_dot_f/fpm.toml create mode 100644 example_packages/program_with_free_form_in_dot_f/source/farewell_m.f create mode 100644 example_packages/program_with_free_form_in_dot_f/source/greet_m.f create mode 100644 example_packages/program_with_free_form_in_dot_f/source/subdir/constants.f90 create mode 100644 example_packages/program_with_free_form_in_dot_f/tests/farewell/farewell_test.f90 create mode 100644 example_packages/program_with_free_form_in_dot_f/tests/greet/greet_test.f90 create mode 100644 example_packages/program_with_profiles_scope/hello_complex/.gitignore create mode 100644 example_packages/program_with_profiles_scope/hello_complex/apps/say_goodbye/say_goodbye.f90 create mode 100644 example_packages/program_with_profiles_scope/hello_complex/apps/say_hello/say_Hello.f90 create mode 100644 example_packages/program_with_profiles_scope/hello_complex/fpm.toml create mode 100644 example_packages/program_with_profiles_scope/hello_complex/source/farewell_m.f90 create mode 100644 example_packages/program_with_profiles_scope/hello_complex/source/greet_m.f90 create mode 100644 example_packages/program_with_profiles_scope/hello_complex/source/subdir/constants.f90 create mode 100644 example_packages/program_with_profiles_scope/hello_complex/tests/farewell/farewell_test.f90 create mode 100644 example_packages/program_with_profiles_scope/hello_complex/tests/greet/greet_test.f90 create mode 100644 example_packages/program_with_profiles_scope/primary_package/.gitignore create mode 100644 example_packages/program_with_profiles_scope/primary_package/app/main.f90 create mode 100644 example_packages/program_with_profiles_scope/primary_package/fpm.toml diff --git a/example_packages/program_with_compiler_profiles/.gitignore b/example_packages/program_with_compiler_profiles/.gitignore new file mode 100644 index 0000000000..a007feab07 --- /dev/null +++ b/example_packages/program_with_compiler_profiles/.gitignore @@ -0,0 +1 @@ +build/* diff --git a/example_packages/program_with_compiler_profiles/app/main.f90 b/example_packages/program_with_compiler_profiles/app/main.f90 new file mode 100644 index 0000000000..d16022bcc8 --- /dev/null +++ b/example_packages/program_with_compiler_profiles/app/main.f90 @@ -0,0 +1,3 @@ +program hello_world + print *, "Hello, World!" +end program hello_world diff --git a/example_packages/program_with_compiler_profiles/fpm.toml b/example_packages/program_with_compiler_profiles/fpm.toml new file mode 100644 index 0000000000..938dbc4004 --- /dev/null +++ b/example_packages/program_with_compiler_profiles/fpm.toml @@ -0,0 +1,17 @@ +name = "hello_world" + +[profiles.debug] +flags="-Og" + +[profiles.debug.gfortran.linux] +flags="-g" + +[profiles.debug.ifort.linux] +flags="-g -traceback" + +[profiles.gfortran] +flags="-g -Wall" + +[profiles.gfortran.windows] +flags="/g" + diff --git a/example_packages/program_with_free_form_in_dot_f/.gitignore b/example_packages/program_with_free_form_in_dot_f/.gitignore new file mode 100644 index 0000000000..a007feab07 --- /dev/null +++ b/example_packages/program_with_free_form_in_dot_f/.gitignore @@ -0,0 +1 @@ +build/* diff --git a/example_packages/program_with_free_form_in_dot_f/apps/say_goodbye/say_goodbye.f90 b/example_packages/program_with_free_form_in_dot_f/apps/say_goodbye/say_goodbye.f90 new file mode 100644 index 0000000000..6966e790f6 --- /dev/null +++ b/example_packages/program_with_free_form_in_dot_f/apps/say_goodbye/say_goodbye.f90 @@ -0,0 +1,7 @@ +program say_goodbye + use farewell_m, only: make_farewell + + implicit none + + print *, make_farewell("World") +end program say_goodbye diff --git a/example_packages/program_with_free_form_in_dot_f/apps/say_hello/say_Hello.f90 b/example_packages/program_with_free_form_in_dot_f/apps/say_hello/say_Hello.f90 new file mode 100644 index 0000000000..cf4a7421d3 --- /dev/null +++ b/example_packages/program_with_free_form_in_dot_f/apps/say_hello/say_Hello.f90 @@ -0,0 +1,7 @@ +program say_Hello + use greet_m, only: make_greeting + + implicit none + + print *, make_greeting("World") +end program say_Hello diff --git a/example_packages/program_with_free_form_in_dot_f/fpm.toml b/example_packages/program_with_free_form_in_dot_f/fpm.toml new file mode 100644 index 0000000000..6bd3a70786 --- /dev/null +++ b/example_packages/program_with_free_form_in_dot_f/fpm.toml @@ -0,0 +1,36 @@ +name = "hello_complex" + +[library] +source-dir="source" + +[[executable]] +name="say_Hello" +source-dir="apps/say_hello" +main="say_Hello.f90" + +[[executable]] +name="say_goodbye" +source-dir="apps/say_goodbye" +main="say_goodbye.f90" + +[[test]] +name="greet_test" +source-dir="tests/greet" +main="greet_test.f90" + +[[test]] +name="farewell_test" +source-dir="tests/farewell" +main="farewell_test.f90" + +[profiles.debug.gfortran] +flags="-ffree-form" + +[profiles.debug.gfortran.windows] +flags="/ffree-form" + +[profiles.debug.ifort] +flags="-free" + +[profiles.debug.ifort.windows] +flags="/free" diff --git a/example_packages/program_with_free_form_in_dot_f/source/farewell_m.f b/example_packages/program_with_free_form_in_dot_f/source/farewell_m.f new file mode 100644 index 0000000000..fbc45edf22 --- /dev/null +++ b/example_packages/program_with_free_form_in_dot_f/source/farewell_m.f @@ -0,0 +1,14 @@ +module farewell_m + use subdir_constants, only: FAREWELL_STR + implicit none + private + + public :: make_farewell +contains + function make_farewell(name) result(greeting) + character(len=*), intent(in) :: name + character(len=:), allocatable :: greeting + + greeting = FAREWELL_STR // name // "!" + end function make_farewell +end module farewell_m diff --git a/example_packages/program_with_free_form_in_dot_f/source/greet_m.f b/example_packages/program_with_free_form_in_dot_f/source/greet_m.f new file mode 100644 index 0000000000..38afd08352 --- /dev/null +++ b/example_packages/program_with_free_form_in_dot_f/source/greet_m.f @@ -0,0 +1,14 @@ +module greet_m + use subdir_constants, only: GREET_STR + implicit none + private + + public :: make_greeting +contains + function make_greeting(name) result(greeting) + character(len=*), intent(in) :: name + character(len=:), allocatable :: greeting + + greeting = GREET_STR // name // "!" + end function make_greeting +end module greet_m diff --git a/example_packages/program_with_free_form_in_dot_f/source/subdir/constants.f90 b/example_packages/program_with_free_form_in_dot_f/source/subdir/constants.f90 new file mode 100644 index 0000000000..59d6e5fee6 --- /dev/null +++ b/example_packages/program_with_free_form_in_dot_f/source/subdir/constants.f90 @@ -0,0 +1,7 @@ +module subdir_constants +implicit none + +character(*), parameter :: GREET_STR = 'Hello, ' +character(*), parameter :: FAREWELL_STR = 'Goodbye, ' + +end module subdir_constants diff --git a/example_packages/program_with_free_form_in_dot_f/tests/farewell/farewell_test.f90 b/example_packages/program_with_free_form_in_dot_f/tests/farewell/farewell_test.f90 new file mode 100644 index 0000000000..0f21b18015 --- /dev/null +++ b/example_packages/program_with_free_form_in_dot_f/tests/farewell/farewell_test.f90 @@ -0,0 +1,18 @@ +program farewell_test + use farewell_m, only: make_farewell + use iso_fortran_env, only: error_unit, output_unit + + implicit none + + character(len=:), allocatable :: farewell + + allocate(character(len=0) :: farewell) + farewell = make_farewell("World") + + if (farewell == "Goodbye, World!") then + write(output_unit, *) "Passed" + else + write(error_unit, *) "Failed" + call exit(1) + end if +end program farewell_test diff --git a/example_packages/program_with_free_form_in_dot_f/tests/greet/greet_test.f90 b/example_packages/program_with_free_form_in_dot_f/tests/greet/greet_test.f90 new file mode 100644 index 0000000000..41fa50878e --- /dev/null +++ b/example_packages/program_with_free_form_in_dot_f/tests/greet/greet_test.f90 @@ -0,0 +1,18 @@ +program greet_test + use greet_m, only: make_greeting + use iso_fortran_env, only: error_unit, output_unit + + implicit none + + character(len=:), allocatable :: greeting + + allocate(character(len=0) :: greeting) + greeting = make_greeting("World") + + if (greeting == "Hello, World!") then + write(output_unit, *) "Passed" + else + write(error_unit, *) "Failed" + call exit(1) + end if +end program greet_test diff --git a/example_packages/program_with_profiles_scope/hello_complex/.gitignore b/example_packages/program_with_profiles_scope/hello_complex/.gitignore new file mode 100644 index 0000000000..a007feab07 --- /dev/null +++ b/example_packages/program_with_profiles_scope/hello_complex/.gitignore @@ -0,0 +1 @@ +build/* diff --git a/example_packages/program_with_profiles_scope/hello_complex/apps/say_goodbye/say_goodbye.f90 b/example_packages/program_with_profiles_scope/hello_complex/apps/say_goodbye/say_goodbye.f90 new file mode 100644 index 0000000000..6966e790f6 --- /dev/null +++ b/example_packages/program_with_profiles_scope/hello_complex/apps/say_goodbye/say_goodbye.f90 @@ -0,0 +1,7 @@ +program say_goodbye + use farewell_m, only: make_farewell + + implicit none + + print *, make_farewell("World") +end program say_goodbye diff --git a/example_packages/program_with_profiles_scope/hello_complex/apps/say_hello/say_Hello.f90 b/example_packages/program_with_profiles_scope/hello_complex/apps/say_hello/say_Hello.f90 new file mode 100644 index 0000000000..cf4a7421d3 --- /dev/null +++ b/example_packages/program_with_profiles_scope/hello_complex/apps/say_hello/say_Hello.f90 @@ -0,0 +1,7 @@ +program say_Hello + use greet_m, only: make_greeting + + implicit none + + print *, make_greeting("World") +end program say_Hello diff --git a/example_packages/program_with_profiles_scope/hello_complex/fpm.toml b/example_packages/program_with_profiles_scope/hello_complex/fpm.toml new file mode 100644 index 0000000000..33ea93da34 --- /dev/null +++ b/example_packages/program_with_profiles_scope/hello_complex/fpm.toml @@ -0,0 +1,29 @@ +name = "hello_complex" + +[library] +source-dir="source" + +[[executable]] +name="say_Hello" +source-dir="apps/say_hello" +main="say_Hello.f90" + +[[executable]] +name="say_goodbye" +source-dir="apps/say_goodbye" +main="say_goodbye.f90" + +[[test]] +name="greet_test" +source-dir="tests/greet" +main="greet_test.f90" + +[[test]] +name="farewell_test" +source-dir="tests/farewell" +main="farewell_test.f90" + +[profiles.debug.gfortran.linux] +flags = '-fcheck=bounds' +files={"source/greet_m.f90"="-Wall -g -fcheck=all", "source/farewell_m.f90"="-Og"} + diff --git a/example_packages/program_with_profiles_scope/hello_complex/source/farewell_m.f90 b/example_packages/program_with_profiles_scope/hello_complex/source/farewell_m.f90 new file mode 100644 index 0000000000..fbc45edf22 --- /dev/null +++ b/example_packages/program_with_profiles_scope/hello_complex/source/farewell_m.f90 @@ -0,0 +1,14 @@ +module farewell_m + use subdir_constants, only: FAREWELL_STR + implicit none + private + + public :: make_farewell +contains + function make_farewell(name) result(greeting) + character(len=*), intent(in) :: name + character(len=:), allocatable :: greeting + + greeting = FAREWELL_STR // name // "!" + end function make_farewell +end module farewell_m diff --git a/example_packages/program_with_profiles_scope/hello_complex/source/greet_m.f90 b/example_packages/program_with_profiles_scope/hello_complex/source/greet_m.f90 new file mode 100644 index 0000000000..38afd08352 --- /dev/null +++ b/example_packages/program_with_profiles_scope/hello_complex/source/greet_m.f90 @@ -0,0 +1,14 @@ +module greet_m + use subdir_constants, only: GREET_STR + implicit none + private + + public :: make_greeting +contains + function make_greeting(name) result(greeting) + character(len=*), intent(in) :: name + character(len=:), allocatable :: greeting + + greeting = GREET_STR // name // "!" + end function make_greeting +end module greet_m diff --git a/example_packages/program_with_profiles_scope/hello_complex/source/subdir/constants.f90 b/example_packages/program_with_profiles_scope/hello_complex/source/subdir/constants.f90 new file mode 100644 index 0000000000..59d6e5fee6 --- /dev/null +++ b/example_packages/program_with_profiles_scope/hello_complex/source/subdir/constants.f90 @@ -0,0 +1,7 @@ +module subdir_constants +implicit none + +character(*), parameter :: GREET_STR = 'Hello, ' +character(*), parameter :: FAREWELL_STR = 'Goodbye, ' + +end module subdir_constants diff --git a/example_packages/program_with_profiles_scope/hello_complex/tests/farewell/farewell_test.f90 b/example_packages/program_with_profiles_scope/hello_complex/tests/farewell/farewell_test.f90 new file mode 100644 index 0000000000..0f21b18015 --- /dev/null +++ b/example_packages/program_with_profiles_scope/hello_complex/tests/farewell/farewell_test.f90 @@ -0,0 +1,18 @@ +program farewell_test + use farewell_m, only: make_farewell + use iso_fortran_env, only: error_unit, output_unit + + implicit none + + character(len=:), allocatable :: farewell + + allocate(character(len=0) :: farewell) + farewell = make_farewell("World") + + if (farewell == "Goodbye, World!") then + write(output_unit, *) "Passed" + else + write(error_unit, *) "Failed" + call exit(1) + end if +end program farewell_test diff --git a/example_packages/program_with_profiles_scope/hello_complex/tests/greet/greet_test.f90 b/example_packages/program_with_profiles_scope/hello_complex/tests/greet/greet_test.f90 new file mode 100644 index 0000000000..41fa50878e --- /dev/null +++ b/example_packages/program_with_profiles_scope/hello_complex/tests/greet/greet_test.f90 @@ -0,0 +1,18 @@ +program greet_test + use greet_m, only: make_greeting + use iso_fortran_env, only: error_unit, output_unit + + implicit none + + character(len=:), allocatable :: greeting + + allocate(character(len=0) :: greeting) + greeting = make_greeting("World") + + if (greeting == "Hello, World!") then + write(output_unit, *) "Passed" + else + write(error_unit, *) "Failed" + call exit(1) + end if +end program greet_test diff --git a/example_packages/program_with_profiles_scope/primary_package/.gitignore b/example_packages/program_with_profiles_scope/primary_package/.gitignore new file mode 100644 index 0000000000..a007feab07 --- /dev/null +++ b/example_packages/program_with_profiles_scope/primary_package/.gitignore @@ -0,0 +1 @@ +build/* diff --git a/example_packages/program_with_profiles_scope/primary_package/app/main.f90 b/example_packages/program_with_profiles_scope/primary_package/app/main.f90 new file mode 100644 index 0000000000..9e532ca537 --- /dev/null +++ b/example_packages/program_with_profiles_scope/primary_package/app/main.f90 @@ -0,0 +1,4 @@ +program hello_world + use greet_m, only: make_greeting + print *, make_greeting("fpm developpers") +end program hello_world diff --git a/example_packages/program_with_profiles_scope/primary_package/fpm.toml b/example_packages/program_with_profiles_scope/primary_package/fpm.toml new file mode 100644 index 0000000000..861c78bc77 --- /dev/null +++ b/example_packages/program_with_profiles_scope/primary_package/fpm.toml @@ -0,0 +1,20 @@ +name = "hello_world" + +[profiles.debug] +flags="-Og" + +[profiles.debug.gfortran.linux] +flags="-g" + +[profiles.debug.ifort.linux] +flags="-g -traceback" + +[profiles.gfortran] +flags="-g -Wall" + +[profiles.gfortran.windows] +flags="/g" + +[dependencies] +"hello_complex" = {path = "../hello_complex"} + diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index df53c62f13..3c6e51ffe2 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -90,9 +90,6 @@ module fpm_model !> Fortran compiler flags character(len=:), allocatable :: flags - !> C compiler flags - character(len=:), allocatable :: c_flags - !> Link time compiler flags character(len=:), allocatable :: link_time_flags diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index 12c84f3f0e..dd1ae3a246 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -207,9 +207,9 @@ subroutine build_target_list(targets,model) file_scope_flag = get_file_scope_flags(sources(i), profile) if (sources(i)%unit_type.eq.FPM_UNIT_CSOURCE) then if (file_scope_flag.eq."") then - sources(i)%c_flags=model%cmd_compile_flags//" "//profile%c_flags + sources(i)%flags=model%cmd_compile_flags//" "//profile%c_flags else - sources(i)%c_flags=model%cmd_compile_flags//" "//file_scope_flag + sources(i)%flags=model%cmd_compile_flags//" "//file_scope_flag end if else if (file_scope_flag.eq."") then @@ -229,7 +229,12 @@ subroutine build_target_list(targets,model) end if case (FPM_UNIT_PROGRAM) - sources(i)%flags=model%cmd_compile_flags//" "//get_file_scope_flags(sources(i), profile)//profile%flags + file_scope_flag = get_file_scope_flags(sources(i), profile) + if (file_scope_flag.eq."") then + sources(i)%flags=model%cmd_compile_flags//" "//profile%flags + else + sources(i)%flags=model%cmd_compile_flags//" "//file_scope_flag + end if sources(i)%link_time_flags=profile%link_time_flags call add_target(targets,type = FPM_TARGET_OBJECT,& @@ -316,8 +321,6 @@ function get_object_name(source) result(object_file) if (allocated(source%flags)) then source%flags = source%flags // module_flags - else if (allocated(source%c_flags)) then - source%c_flags = source%c_flags // module_flags end if ! Convert any remaining directory separators to underscores @@ -343,8 +346,6 @@ function get_output_directory(source) result(out_dir) if (allocated(source%flags)) then write(build_name, '(z16.16)') fnv_1a(source%flags) - else if (allocated(source%c_flags)) then - write(build_name, '(z16.16)') fnv_1a(source%c_flags) end if out_dir = join_path('build',basename(model%fortran_compiler)//'_'//build_name) include_dir = string_t(out_dir) @@ -392,7 +393,6 @@ subroutine add_target(targets,type,output_file,source,link_libraries) if (present(source)) then new_target%source = source if (allocated(source%flags)) new_target%compile_flags = " "//source%flags - if (allocated(source%c_flags)) new_target%compile_flags = " "//source%c_flags if (allocated(source%link_time_flags)) new_target%link_flags = " "//source%link_time_flags//" " end if if (present(link_libraries)) new_target%link_libraries = link_libraries From 709ad3a1499269f7601507c0e15cc87e36204eda Mon Sep 17 00:00:00 2001 From: kubajj Date: Mon, 28 Jun 2021 14:17:29 +0200 Subject: [PATCH 12/32] Add an example project with c flags --- example_packages/profiles_with_c/.gitignore | 1 + example_packages/profiles_with_c/app/main.f90 | 10 +++++++ example_packages/profiles_with_c/fpm.toml | 4 +++ example_packages/profiles_with_c/src/c_code.c | 10 +++++++ .../profiles_with_c/src/with_c.f90 | 26 +++++++++++++++++++ 5 files changed, 51 insertions(+) create mode 100644 example_packages/profiles_with_c/.gitignore create mode 100644 example_packages/profiles_with_c/app/main.f90 create mode 100644 example_packages/profiles_with_c/fpm.toml create mode 100644 example_packages/profiles_with_c/src/c_code.c create mode 100644 example_packages/profiles_with_c/src/with_c.f90 diff --git a/example_packages/profiles_with_c/.gitignore b/example_packages/profiles_with_c/.gitignore new file mode 100644 index 0000000000..a007feab07 --- /dev/null +++ b/example_packages/profiles_with_c/.gitignore @@ -0,0 +1 @@ +build/* diff --git a/example_packages/profiles_with_c/app/main.f90 b/example_packages/profiles_with_c/app/main.f90 new file mode 100644 index 0000000000..4d3174b61e --- /dev/null +++ b/example_packages/profiles_with_c/app/main.f90 @@ -0,0 +1,10 @@ +program with_c_app +use with_c +implicit none + +write(*,*) "isdir('app') = ", system_isdir('app') +write(*,*) "isdir('src') = ", system_isdir('src') +write(*,*) "isdir('test') = ", system_isdir('test') +write(*,*) "isdir('bench') = ", system_isdir('bench') + +end program with_c_app \ No newline at end of file diff --git a/example_packages/profiles_with_c/fpm.toml b/example_packages/profiles_with_c/fpm.toml new file mode 100644 index 0000000000..d0487997d7 --- /dev/null +++ b/example_packages/profiles_with_c/fpm.toml @@ -0,0 +1,4 @@ +name = "with_c" + +[profiles.debug.gfortran.linux] +c-flags="-O1 -g" diff --git a/example_packages/profiles_with_c/src/c_code.c b/example_packages/profiles_with_c/src/c_code.c new file mode 100644 index 0000000000..44604f029c --- /dev/null +++ b/example_packages/profiles_with_c/src/c_code.c @@ -0,0 +1,10 @@ +#include +/* + * Decides whether a given file name is a directory. + * return 1 if file exists and is a directory + * Source (Public domain): https://github.com/urbanjost/M_system + */ +int my_isdir (const char *path) { + struct stat sb; + return stat(path, &sb) == 0 && S_ISDIR (sb.st_mode); +} \ No newline at end of file diff --git a/example_packages/profiles_with_c/src/with_c.f90 b/example_packages/profiles_with_c/src/with_c.f90 new file mode 100644 index 0000000000..edd839e3c4 --- /dev/null +++ b/example_packages/profiles_with_c/src/with_c.f90 @@ -0,0 +1,26 @@ +module with_c + use iso_c_binding, only: c_char, c_int, c_null_char + implicit none + +contains + + function system_isdir(dirname) + ! Source (Public domain): https://github.com/urbanjost/M_system + ! + implicit none + character(len=*),intent(in) :: dirname + logical :: system_isdir + + interface + function c_isdir(dirname) bind (C,name="my_isdir") result (c_ierr) + import c_char,c_int + character(kind=c_char,len=1),intent(in) :: dirname(*) + integer(kind=c_int) :: c_ierr + end function c_isdir + end interface + + system_isdir= c_isdir(trim(dirname)//c_null_char) == 1 + + end function system_isdir + +end module with_c \ No newline at end of file From 0997172e40907d81d5a578a08b4e8197364b3500 Mon Sep 17 00:00:00 2001 From: kubajj Date: Wed, 30 Jun 2021 12:10:15 +0200 Subject: [PATCH 13/32] Stop modifying model outside of build_model --- src/fpm.f90 | 76 ++++++++++++++++++--- src/fpm/manifest/profiles.f90 | 53 ++++++++++++++- src/fpm_backend.f90 | 15 +++-- src/fpm_targets.f90 | 123 +++++++++++++--------------------- 4 files changed, 175 insertions(+), 92 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 1a80a1b7b9..052cf08dee 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -6,9 +6,7 @@ module fpm use fpm_dependency, only : new_dependency_tree use fpm_environment, only: run, get_env, get_os_type use fpm_filesystem, only: is_dir, join_path, number_of_rows, list_files, exists, basename -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_model use fpm_compiler, only: get_module_flags, is_unknown_compiler, get_default_c_compiler, & get_archiver @@ -45,7 +43,7 @@ subroutine build_model(model, settings, package, error) integer :: i, j type(package_config_t) :: dependency type(profile_config_t) :: primary_pkg_profile, current_pkg_profile - character(len=:), allocatable :: manifest, lib_dir, profile, compiler_flags + character(len=:), allocatable :: manifest, lib_dir, profile, compiler_flags, file_scope_flag logical :: duplicates_found = .false., profile_found type(string_t) :: include_dir @@ -182,7 +180,7 @@ subroutine build_model(model, settings, package, error) write(*,*)' COMPILER: ',settings%compiler write(*,*)' C COMPILER: ',model%c_compiler write(*,*)' COMMAND LINE COMPILER OPTIONS: ', model%cmd_compile_flags -! write(*,*)' INCLUDE DIRECTORIES: [', string_cat(model%include_dirs,','),']' + write(*,*)' INCLUDE DIRECTORIES: [', string_cat(model%include_dirs,','),']' end if ! Check for duplicate modules @@ -232,6 +230,64 @@ subroutine build_model(model, settings, package, error) "Defaults for this compiler might be incorrect" end if + do j=1,size(model%packages) + associate(package=>model%packages(j), sources=>model%packages(j)%sources, profile=>model%packages(j)%chosen_profile) + do i=1,size(sources) + + select case (sources(i)%unit_type) + case (FPM_UNIT_MODULE,FPM_UNIT_SUBMODULE,FPM_UNIT_SUBPROGRAM,FPM_UNIT_CSOURCE) + file_scope_flag = get_file_scope_flags(sources(i), profile) + if (sources(i)%unit_type.eq.FPM_UNIT_CSOURCE) then + if (file_scope_flag.eq."") then + sources(i)%flags=model%cmd_compile_flags//" "//profile%c_flags + else + sources(i)%flags=model%cmd_compile_flags//" "//file_scope_flag + end if + else + if (file_scope_flag.eq."") then + sources(i)%flags=model%cmd_compile_flags//" "//profile%flags + else + sources(i)%flags=model%cmd_compile_flags//" "//file_scope_flag + end if + end if + case (FPM_UNIT_PROGRAM) + file_scope_flag = get_file_scope_flags(sources(i), profile) + if (file_scope_flag.eq."") then + sources(i)%flags=model%cmd_compile_flags//" "//profile%flags + else + sources(i)%flags=model%cmd_compile_flags//" "//file_scope_flag + end if + sources(i)%link_time_flags=profile%link_time_flags + end select + end do + end associate + end do + + contains + + function get_file_scope_flags(source, profile) result(file_scope_flag) + ! Try to match source%file_name in profile%file_scope_flags + ! + ! + type(srcfile_t), intent(in) :: source + type(profile_config_t), intent(in) :: profile + + character(:), allocatable :: file_scope_flag, current + integer :: i + + file_scope_flag = "" + + if (allocated(profile%file_scope_flags)) then + associate(fflags=>profile%file_scope_flags) + do i=1,size(fflags) + if (source%file_name.eq.fflags(i)%file_name) then + file_scope_flag = fflags(i)%flags//" " + end if + end do + end associate + end if + end function get_file_scope_flags + end subroutine build_model ! Check for duplicate modules @@ -284,6 +340,7 @@ subroutine cmd_build(settings) type(fpm_model_t) :: model type(build_target_ptr), allocatable :: targets(:) type(error_t), allocatable :: error +type(string_t), allocatable :: build_dirs(:) integer :: i @@ -299,7 +356,7 @@ subroutine cmd_build(settings) error stop 1 end if -call targets_from_sources(targets,model,error) +call targets_from_sources(targets,model,error,build_dirs) if (allocated(error)) then print '(a)', error%message error stop 1 @@ -312,7 +369,7 @@ subroutine cmd_build(settings) else if (settings%show_model) then call show_model(model) else - call build_package(targets,model) + call build_package(targets,model,build_dirs) endif end subroutine @@ -331,6 +388,7 @@ subroutine cmd_run(settings,test) type(string_t), allocatable :: executables(:) type(build_target_t), pointer :: exe_target type(srcfile_t), pointer :: exe_source + type(string_t), allocatable :: build_dirs(:) integer :: run_scope integer, allocatable :: stat(:) character(len=:),allocatable :: line @@ -348,7 +406,7 @@ subroutine cmd_run(settings,test) error stop 1 end if - call targets_from_sources(targets,model,error) + call targets_from_sources(targets,model,error,build_dirs) if (allocated(error)) then print '(a)', error%message error stop 1 @@ -447,7 +505,7 @@ subroutine cmd_run(settings,test) end if - call build_package(targets,model) + call build_package(targets,model,build_dirs) if (settings%list) then call compact_list() diff --git a/src/fpm/manifest/profiles.f90 b/src/fpm/manifest/profiles.f90 index 4595a7b3e7..18c1b34995 100644 --- a/src/fpm/manifest/profiles.f90 +++ b/src/fpm/manifest/profiles.f90 @@ -46,10 +46,10 @@ module fpm_manifest_profile OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD use fpm_filesystem, only: join_path implicit none - private public :: profile_config_t, new_profile, new_profiles, get_default_profiles, & & info_profile, find_profile, DEFAULT_COMPILER + !> Name of the default compiler character(len=*), parameter :: DEFAULT_COMPILER = 'gfortran' integer, parameter :: OS_ALL = -1 character(len=:), allocatable :: path @@ -62,6 +62,7 @@ module fpm_manifest_profile !> File scope flags character(len=:), allocatable :: flags + end type file_scope_flag !> Configuration meta data for a profile @@ -143,11 +144,16 @@ function new_profile(profile_name, compiler, os_type, flags, c_flags, link_time_ if (present(file_scope_flags)) then profile%file_scope_flags = file_scope_flags end if + end function new_profile !> Check if compiler name is a valid compiler name subroutine validate_compiler_name(compiler_name, is_valid) + + !> Name of a compiler character(len=:), allocatable, intent(in) :: compiler_name + + !> Boolean value of whether compiler_name is valid or not logical, intent(out) :: is_valid select case(compiler_name) case("gfortran", "ifort", "ifx", "pgfortran", "nvfrotran", "flang", "caf", & @@ -158,9 +164,15 @@ subroutine validate_compiler_name(compiler_name, is_valid) end select end subroutine validate_compiler_name + !> Check if os_name is a valid name of a supported OS subroutine validate_os_name(os_name, is_valid) + + !> Name of an operating system character(len=:), allocatable, intent(in) :: os_name + + !> Boolean value of whether os_name is valid or not logical, intent(out) :: is_valid + select case (os_name) case ("linux", "macos", "windows", "cygwin", "solaris", "freebsd", & & "openbsd", "unknown", "UNKNOWN") @@ -168,11 +180,18 @@ subroutine validate_os_name(os_name, is_valid) case default is_valid = .false. end select + end subroutine validate_os_name + !> Match os_type enum to a lowercase string with name of OS subroutine match_os_type(os_name, os_type) + + !> Name of operating system character(len=:), allocatable, intent(in) :: os_name + + !> Enum representing type of OS integer, intent(out) :: os_type + select case (os_name) case ("linux"); os_type = OS_LINUX case ("macos"); os_type = OS_WINDOWS @@ -183,8 +202,11 @@ subroutine match_os_type(os_name, os_type) case ("all"); os_type = OS_ALL case default; os_type = OS_UNKNOWN end select + end subroutine match_os_type + !> Look for flags, c-flags, link-time-flags key-val pairs + !> and files table in a given table and create new profiles subroutine get_flags(profile_name, compiler_name, os_type, key_list, table, profiles, profindex, error) !> Name of profile @@ -550,9 +572,14 @@ subroutine new_profiles(profiles, table, error, file_scope_path) end do end subroutine new_profiles + !> Construct an array of built-in profiles function get_default_profiles(error) result(default_profiles) + + !> Error handling type(error_t), allocatable, intent(out) :: error + type(profile_config_t), allocatable :: default_profiles(:) + default_profiles = [ & & new_profile('release', 'caf', OS_ALL, flags=' -O3 -Wimplicit-interface& & -fPIC -fmax-errors=1 -funroll-loops'), & @@ -636,11 +663,17 @@ subroutine info(self, unit, verbosity) end subroutine info + !> Print a representation of profile_config_t function info_profile(profile) result(s) - ! Prints a representation of profile_config_t + + !> Profile to be represented type(profile_config_t), intent(in) :: profile + + !> String representation of given profile character(:), allocatable :: s + integer :: i + s = "profile_config_t(" s = s // 'profile_name="' // profile%profile_name // '"' s = s // ', compiler="' // profile%compiler // '"' @@ -677,21 +710,37 @@ function info_profile(profile) result(s) end do end if s = s // ")" + end function info_profile + !> Look for profile with given configuration in array profiles subroutine find_profile(profiles, profile_name, compiler, os_type, found_matching, chosen_profile) + + !> Array of profiles type(profile_config_t), allocatable, intent(in) :: profiles(:) + + !> Name of profile character(:), allocatable, intent(in) :: profile_name + + !> Name of compiler character(:), allocatable, intent(in) :: compiler + + !> Type of operating system (enum) integer, intent(in) :: os_type + + !> Boolean value containing true if matching profile was found logical, intent(out) :: found_matching + + !> Last matching profile in the profiles array type(profile_config_t), intent(out) :: chosen_profile + character(:), allocatable :: curr_profile_name character(:), allocatable :: curr_compiler integer :: curr_os integer :: i, priority, curr_priority found_matching = .false. + if (size(profiles) < 1) return do i=1,size(profiles) curr_profile_name = profiles(i)%profile_name curr_compiler = profiles(i)%compiler diff --git a/src/fpm_backend.f90 b/src/fpm_backend.f90 index dcc23e2117..3bf728aaa8 100644 --- a/src/fpm_backend.f90 +++ b/src/fpm_backend.f90 @@ -42,20 +42,16 @@ module fpm_backend contains !> Top-level routine to build package described by `model` -subroutine build_package(targets,model) +subroutine build_package(targets,model,build_dirs) type(build_target_ptr), intent(inout) :: targets(:) type(fpm_model_t), intent(in) :: model + type(string_t), allocatable, intent(in), optional :: build_dirs(:) integer :: i, j type(build_target_ptr), allocatable :: queue(:) integer, allocatable :: schedule_ptr(:), stat(:) logical :: build_failed, skip_current - ! Need to make output directory for include (mod) files -! if (.not.exists(join_path(model%output_directory,model%package_name))) then -! call mkdir(join_path(model%output_directory,model%package_name)) -! end if - ! Perform depth-first topological sort of targets do i=1,size(targets) @@ -72,6 +68,13 @@ subroutine build_package(targets,model) call mkdir(model%include_dirs(i)%s) end do end if + if (present(build_dirs)) then + if (allocated(build_dirs)) then + do i=1,size(build_dirs) + call mkdir(build_dirs(i)%s) + end do + end if + end if ! Initialise build status flags allocate(stat(size(queue))) stat(:) = 0 diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index dd1ae3a246..6943bfa56f 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -112,7 +112,7 @@ module fpm_targets contains !> High-level wrapper to generate build target information -subroutine targets_from_sources(targets,model,error) +subroutine targets_from_sources(targets,model,error,build_dirs) !> The generated list of build targets type(build_target_ptr), intent(out), allocatable :: targets(:) @@ -120,15 +120,22 @@ subroutine targets_from_sources(targets,model,error) !> The package model from which to construct the target list type(fpm_model_t), intent(inout), target :: model + !> Include directories from sources + type(string_t), allocatable, intent(out), optional :: build_dirs(:) + !> Error structure type(error_t), intent(out), allocatable :: error - call build_target_list(targets,model) + type(string_t), allocatable :: build_dirs_array(:) + + call build_target_list(targets,model,build_dirs_array) call resolve_module_dependencies(targets,model%external_modules,error) if (allocated(error)) return - call resolve_target_linking(targets,model) + call resolve_target_linking(targets,model,build_dirs_array) + + if (present(build_dirs)) build_dirs = build_dirs_array end subroutine targets_from_sources @@ -152,7 +159,7 @@ end subroutine targets_from_sources !> is a library, then the executable target has an additional dependency on the library !> archive target. !> -subroutine build_target_list(targets,model) +subroutine build_target_list(targets,model, build_dirs) !> The generated list of build targets type(build_target_ptr), intent(out), allocatable :: targets(:) @@ -160,8 +167,11 @@ subroutine build_target_list(targets,model) !> The package model from which to construct the target list type(fpm_model_t), intent(inout), target :: model + !> Include dirs from sources + type(string_t), allocatable, intent(out) :: build_dirs(:) + integer :: i, j, n_source - character(:), allocatable :: xsuffix, exe_dir, file_scope_flag, flags_for_archive + character(:), allocatable :: xsuffix, exe_dir, flags_for_archive, output_file, module_flags character(len=16) :: build_name type(build_target_t), pointer :: dep logical :: with_lib @@ -198,30 +208,17 @@ subroutine build_target_list(targets,model) end if do j=1,size(model%packages) - associate(package=>model%packages(j), sources=>model%packages(j)%sources, profile=>model%packages(j)%chosen_profile) + associate(sources=>model%packages(j)%sources) do i=1,size(sources) select case (sources(i)%unit_type) case (FPM_UNIT_MODULE,FPM_UNIT_SUBMODULE,FPM_UNIT_SUBPROGRAM,FPM_UNIT_CSOURCE) - ! make file scope flag override flags, use just one or the other - file_scope_flag = get_file_scope_flags(sources(i), profile) - if (sources(i)%unit_type.eq.FPM_UNIT_CSOURCE) then - if (file_scope_flag.eq."") then - sources(i)%flags=model%cmd_compile_flags//" "//profile%c_flags - else - sources(i)%flags=model%cmd_compile_flags//" "//file_scope_flag - end if - else - if (file_scope_flag.eq."") then - sources(i)%flags=model%cmd_compile_flags//" "//profile%flags - else - sources(i)%flags=model%cmd_compile_flags//" "//file_scope_flag - end if - end if + + call get_object_name(sources(i), output_file, module_flags) call add_target(targets,source = sources(i), & type = merge(FPM_TARGET_C_OBJECT,FPM_TARGET_OBJECT,& sources(i)%unit_type==FPM_UNIT_CSOURCE), & - output_file = get_object_name(sources(i))) + output_file = output_file, module_flags = module_flags) if (with_lib .and. sources(i)%unit_scope == FPM_SCOPE_LIB) then ! Archive depends on object @@ -229,17 +226,12 @@ subroutine build_target_list(targets,model) end if case (FPM_UNIT_PROGRAM) - file_scope_flag = get_file_scope_flags(sources(i), profile) - if (file_scope_flag.eq."") then - sources(i)%flags=model%cmd_compile_flags//" "//profile%flags - else - sources(i)%flags=model%cmd_compile_flags//" "//file_scope_flag - end if - sources(i)%link_time_flags=profile%link_time_flags + call get_object_name(sources(i), output_file, module_flags) call add_target(targets,type = FPM_TARGET_OBJECT,& - output_file = get_object_name(sources(i)), & - source = sources(i) & + output_file = output_file, & + source = sources(i), & + module_flags = module_flags & ) if (sources(i)%unit_scope == FPM_SCOPE_APP) then @@ -279,39 +271,17 @@ subroutine build_target_list(targets,model) contains - function get_file_scope_flags(source, profile) result(file_scope_flag) - ! Try to match source%file_name in profile%file_scope_flags - ! - ! - type(srcfile_t), intent(in) :: source - type(profile_config_t), intent(in) :: profile - - character(:), allocatable :: file_scope_flag, current - integer :: i - - file_scope_flag = "" - - if (allocated(profile%file_scope_flags)) then - associate(fflags=>profile%file_scope_flags) - do i=1,size(fflags) - if (source%file_name.eq.fflags(i)%file_name) then - file_scope_flag = fflags(i)%flags//" " - end if - end do - end associate - end if - end function get_file_scope_flags - - function get_object_name(source) result(object_file) + subroutine get_object_name(source, object_file, module_flags) ! Generate object target path from source name and model params ! ! - type(srcfile_t), intent(inout) :: source - character(:), allocatable :: object_file + type(srcfile_t), intent(in) :: source + character(:), allocatable, intent(out) :: object_file + character(:), allocatable, intent(out) :: module_flags integer :: i character(1), parameter :: filesep = '/' - character(:), allocatable :: dir, out_dir, module_flags + character(:), allocatable :: dir, out_dir object_file = canon_path(source%file_name) @@ -319,10 +289,6 @@ function get_object_name(source) result(object_file) call get_module_flags(model%fortran_compiler, out_dir, module_flags) - if (allocated(source%flags)) then - source%flags = source%flags // module_flags - end if - ! Convert any remaining directory separators to underscores i = index(object_file,filesep) do while(i > 0) @@ -332,7 +298,7 @@ function get_object_name(source) result(object_file) object_file = join_path(out_dir,model%package_name, object_file)//'.o' - end function get_object_name + end subroutine get_object_name function get_output_directory(source) result(out_dir) ! Generate build directory name by hashing the flags of the source @@ -349,10 +315,10 @@ function get_output_directory(source) result(out_dir) end if out_dir = join_path('build',basename(model%fortran_compiler)//'_'//build_name) include_dir = string_t(out_dir) - if (.not. allocated(model%include_dirs)) then - model%include_dirs = [include_dir] - else if (.not. (out_dir.in.model%include_dirs)) then - model%include_dirs = [model%include_dirs, include_dir] + if (.not. allocated(build_dirs)) then + build_dirs = [include_dir] + else if (.not. (out_dir.in.build_dirs)) then + build_dirs = [build_dirs, include_dir] end if end function get_output_directory @@ -360,11 +326,12 @@ end subroutine build_target_list !> Allocate a new target and append to target list -subroutine add_target(targets,type,output_file,source,link_libraries) +subroutine add_target(targets,type,output_file,source, module_flags, link_libraries) type(build_target_ptr), allocatable, intent(inout) :: targets(:) integer, intent(in) :: type character(*), intent(in) :: output_file type(srcfile_t), intent(in), optional :: source + character(*), intent(in), optional :: module_flags type(string_t), intent(in), optional :: link_libraries(:) integer :: i @@ -392,7 +359,13 @@ subroutine add_target(targets,type,output_file,source,link_libraries) new_target%output_file = output_file if (present(source)) then new_target%source = source - if (allocated(source%flags)) new_target%compile_flags = " "//source%flags + if (allocated(source%flags)) then + if (present(module_flags)) then + new_target%compile_flags = " "//source%flags//module_flags + else + new_target%compile_flags = " "//source%flags + end if + end if if (allocated(source%link_time_flags)) new_target%link_flags = " "//source%link_time_flags//" " end if if (present(link_libraries)) new_target%link_libraries = link_libraries @@ -532,9 +505,10 @@ end function find_module_dependency !> Construct the linker flags string for each target !> `target%link_flags` includes non-library objects and library flags !> -subroutine resolve_target_linking(targets, model) +subroutine resolve_target_linking(targets, model, build_dirs) type(build_target_ptr), intent(inout), target :: targets(:) type(fpm_model_t), intent(in) :: model + type(string_t), allocatable, intent(in) :: build_dirs(:) integer :: i character(:), allocatable :: global_link_flags @@ -560,17 +534,16 @@ subroutine resolve_target_linking(targets, model) global_include_flags = global_include_flags // & & " -I " // string_cat(model%include_dirs," -I ") end if + if (size(build_dirs) > 0) then + global_include_flags = global_include_flags // & + & " -I " // string_cat(build_dirs," -I ") + end if end if do i=1,size(targets) associate(target => targets(i)%ptr) -! if (target%target_type /= FPM_TARGET_C_OBJECT) then -! target%compile_flags = model%fortran_compile_flags//" "//global_include_flags -! else -! target%compile_flags = global_include_flags -! end if target%compile_flags = target%compile_flags // global_include_flags allocate(target%link_objects(0)) From cb06c00deb19dade8ac214f06f01b33de87f68a6 Mon Sep 17 00:00:00 2001 From: kubajj Date: Thu, 22 Jul 2021 17:24:16 +0200 Subject: [PATCH 14/32] Fix src/fpm_targets.f90 to run with no source files --- src/fpm_targets.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index 6943bfa56f..6ddff2cd9f 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -182,6 +182,7 @@ subroutine build_target_list(targets,model, build_dirs) if (n_source < 1) then allocate(targets(0)) + allocate(build_dirs(0)) return end if @@ -508,7 +509,7 @@ end function find_module_dependency subroutine resolve_target_linking(targets, model, build_dirs) type(build_target_ptr), intent(inout), target :: targets(:) type(fpm_model_t), intent(in) :: model - type(string_t), allocatable, intent(in) :: build_dirs(:) + type(string_t), intent(in) :: build_dirs(:) integer :: i character(:), allocatable :: global_link_flags From 286ac9c76303f1901cdb605174606a0cc4861543 Mon Sep 17 00:00:00 2001 From: kubajj Date: Thu, 22 Jul 2021 18:05:06 +0200 Subject: [PATCH 15/32] Remove failing line from fpm_targets.f90 --- src/fpm_targets.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index e0ff0fa3a7..57796431a2 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -174,7 +174,6 @@ subroutine build_target_list(targets,model, build_dirs) character(:), allocatable :: xsuffix, exe_dir, flags_for_archive, output_file, module_flags character(len=16) :: build_name type(build_target_t), pointer :: dep - character(:), allocatable :: xsuffix, exe_dir logical :: with_lib ! Check for empty build (e.g. header-only lib) From 98badd65ec65ce744c9f83a9d79184807002ec44 Mon Sep 17 00:00:00 2001 From: kubajj Date: Mon, 26 Jul 2021 14:10:00 +0200 Subject: [PATCH 16/32] Update error handling in profiles parser and introduce is_built_in boolean --- .../program_with_compiler_profiles/fpm.toml | 3 - src/fpm.f90 | 2 + src/fpm/manifest/profiles.f90 | 80 ++++++++++--------- test/fpm_test/test_manifest.f90 | 16 ++-- 4 files changed, 50 insertions(+), 51 deletions(-) diff --git a/example_packages/program_with_compiler_profiles/fpm.toml b/example_packages/program_with_compiler_profiles/fpm.toml index 938dbc4004..7e7a0d8d5d 100644 --- a/example_packages/program_with_compiler_profiles/fpm.toml +++ b/example_packages/program_with_compiler_profiles/fpm.toml @@ -1,8 +1,5 @@ name = "hello_world" -[profiles.debug] -flags="-Og" - [profiles.debug.gfortran.linux] flags="-g" diff --git a/src/fpm.f90 b/src/fpm.f90 index 4bfbe71648..436adf25f8 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -206,6 +206,8 @@ subroutine build_model(model, settings, package, error) & get_os_type(), profile_found, current_pkg_profile) if (.not.profile_found .and. i.gt.1) then current_pkg_profile = primary_pkg_profile + else if (current_pkg_profile%is_built_in) then + current_pkg_profile = primary_pkg_profile else if (i.eq.1) then if (.not.profile_found) then error stop 'Error: primary package does not have given profile.' diff --git a/src/fpm/manifest/profiles.f90 b/src/fpm/manifest/profiles.f90 index 18c1b34995..d1208a3d23 100644 --- a/src/fpm/manifest/profiles.f90 +++ b/src/fpm/manifest/profiles.f90 @@ -39,7 +39,7 @@ !>``` !> module fpm_manifest_profile - use fpm_error, only : error_t, syntax_error, fatal_error + use fpm_error, only : error_t, syntax_error, fatal_error, fpm_stop use fpm_toml, only : toml_table, toml_key, toml_stat, get_value use fpm_strings, only: lower use fpm_environment, only: get_os_type, OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, & @@ -88,6 +88,9 @@ module fpm_manifest_profile !> File scope flags type(file_scope_flag), allocatable :: file_scope_flags(:) + !> Is this profile one of the built-in ones? + logical :: is_built_in + contains !> Print information on this instance @@ -98,7 +101,8 @@ module fpm_manifest_profile contains !> Construct a new profile configuration from a TOML data structure - function new_profile(profile_name, compiler, os_type, flags, c_flags, link_time_flags, file_scope_flags) result(profile) + function new_profile(profile_name, compiler, os_type, flags, c_flags, link_time_flags, file_scope_flags, is_built_in) & + & result(profile) !> Name of the profile character(len=*), intent(in) :: profile_name @@ -121,6 +125,9 @@ function new_profile(profile_name, compiler, os_type, flags, c_flags, link_time_ !> File scope flags type(file_scope_flag), optional, intent(in) :: file_scope_flags(:) + !> Is this profile one of the built-in ones? + logical, optional, intent(in) :: is_built_in + type(profile_config_t) :: profile profile%profile_name = profile_name @@ -144,6 +151,11 @@ function new_profile(profile_name, compiler, os_type, flags, c_flags, link_time_ if (present(file_scope_flags)) then profile%file_scope_flags = file_scope_flags end if + if (present(is_built_in)) then + profile%is_built_in = is_built_in + else + profile%is_built_in = .false. + end if end function new_profile @@ -319,7 +331,7 @@ subroutine traverse_oss(profile_name, compiler_name, os_list, table, error, prof integer, intent(inout), optional :: profindex type(toml_key), allocatable :: key_list(:) - character(len=:), allocatable :: os_name + character(len=:), allocatable :: os_name, l_os_name type(toml_table), pointer :: os_node character(len=:), allocatable :: flags integer :: ios, stat, os_type @@ -328,7 +340,7 @@ subroutine traverse_oss(profile_name, compiler_name, os_list, table, error, prof if (size(os_list)<1) return key_val_added = .false. do ios = 1, size(os_list) - os_name = lower(os_list(ios)%key) + os_name = os_list(ios)%key call validate_os_name(os_name, is_valid) if (is_valid) then if (present(profiles_size)) then @@ -351,6 +363,14 @@ subroutine traverse_oss(profile_name, compiler_name, os_list, table, error, prof if (allocated(error)) return end if else + ! Not lowercase OS name + l_os_name = lower(os_name) + call validate_os_name(l_os_name, is_valid) + if (is_valid) then + call fpm_stop(1,'*traverse_oss*:Error: Invalid OS name.') + end if + + ! Missing OS name is_key_val = .false. os_name = os_list(ios)%key call get_value(table, os_name, os_node, stat=stat) @@ -433,21 +453,7 @@ subroutine traverse_compilers(profile_name, comp_list, table, error, profiles_si if (allocated(error)) return end if else - os_list = comp_list(icomp:icomp) - compiler_name = DEFAULT_COMPILER - - if (present(profiles_size)) then - call traverse_oss(profile_name, compiler_name, os_list, table, error, profiles_size=profiles_size) - if (allocated(error)) return - else - if (.not.(present(profiles).and.present(profindex))) then - call fatal_error(error, "Both profiles and profindex have to be present") - return - end if - call traverse_oss(profile_name, compiler_name, os_list, table, & - & error, profiles=profiles, profindex=profindex) - if (allocated(error)) return - end if + call fpm_stop(1,'*traverse_compilers*:Error: Compiler name not specified or invalid.') end if end do end subroutine traverse_compilers @@ -582,46 +588,46 @@ function get_default_profiles(error) result(default_profiles) default_profiles = [ & & new_profile('release', 'caf', OS_ALL, flags=' -O3 -Wimplicit-interface& - & -fPIC -fmax-errors=1 -funroll-loops'), & + & -fPIC -fmax-errors=1 -funroll-loops', is_built_in=.true.), & & new_profile('release', 'gfortran', OS_ALL, flags=' -O3 -Wimplicit-interface -fPIC& - & -fmax-errors=1 -funroll-loops -fcoarray=single'), & + & -fmax-errors=1 -funroll-loops -fcoarray=single', is_built_in=.true.), & & new_profile('release', 'f95', OS_ALL, flags=' -O3 -Wimplicit-interface -fPIC& - & -fmax-errors=1 -ffast-math -funroll-loops'), & - & new_profile('release', 'nvfortran', OS_ALL, flags = ' -Mbackslash'), & + & -fmax-errors=1 -ffast-math -funroll-loops', is_built_in=.true.), & + & new_profile('release', 'nvfortran', OS_ALL, flags = ' -Mbackslash', is_built_in=.true.), & & new_profile('release', 'ifort', OS_ALL, flags = ' -fp-model precise -pc64 -align all& & -error-limit 1 -reentrancy threaded& - & -nogen-interfaces -assume byterecl'), & + & -nogen-interfaces -assume byterecl', is_built_in=.true.), & & new_profile('release', 'ifort', OS_WINDOWS, flags = ' /fp:precise /align:all& & /error-limit:1 /reentrancy:threaded& - & /nogen-interfaces /assume:byterecl'), & + & /nogen-interfaces /assume:byterecl', is_built_in=.true.), & & new_profile('release', 'ifx', OS_ALL, flags = ' -fp-model=precise -pc64& & -align all -error-limit 1 -reentrancy threaded& - & -nogen-interfaces -assume byterecl'), & + & -nogen-interfaces -assume byterecl', is_built_in=.true.), & & new_profile('release', 'ifx', OS_WINDOWS, flags = ' /fp:precise /align:all& & /error-limit:1 /reentrancy:threaded& - & /nogen-interfaces /assume:byterecl'), & - & new_profile('release', 'nagfor', OS_ALL, flags = ' -O4 -coarray=single -PIC'), & + & /nogen-interfaces /assume:byterecl', is_built_in=.true.), & + & new_profile('release', 'nagfor', OS_ALL, flags = ' -O4 -coarray=single -PIC', is_built_in=.true.), & & new_profile('debug', 'caf', OS_ALL, flags = ' -Wall -Wextra -Wimplicit-interface& & -fPIC -fmax-errors=1 -g -fcheck=bounds& - & -fcheck=array-temps -fbacktrace'), & + & -fcheck=array-temps -fbacktrace', is_built_in=.true.), & & new_profile('debug', 'gfortran', OS_ALL, flags = ' -Wall -Wextra -Wimplicit-interface& & -fPIC -fmax-errors=1 -g -fcheck=bounds& - & -fcheck=array-temps -fbacktrace -fcoarray=single'), & + & -fcheck=array-temps -fbacktrace -fcoarray=single', is_built_in=.true.), & & new_profile('debug', 'f95', OS_ALL, flags = ' -Wall -Wextra -Wimplicit-interface& & -fPIC -fmax-errors=1 -g -fcheck=bounds& & -fcheck=array-temps -Wno-maybe-uninitialized& - & -Wno-uninitialized -fbacktrace'), & + & -Wno-uninitialized -fbacktrace', is_built_in=.true.), & & new_profile('debug', 'nvfortran', OS_ALL, flags = ' -Minform=inform -Mbackslash -g& - & -Mbounds -Mchkptr -Mchkstk -traceback'), & + & -Mbounds -Mchkptr -Mchkstk -traceback', is_built_in=.true.), & & new_profile('debug', 'ifort', OS_ALL, flags = ' -warn all -check all -error-limit 1& - & -O0 -g -assume byterecl -traceback'), & + & -O0 -g -assume byterecl -traceback', is_built_in=.true.), & & new_profile('debug', 'ifort', OS_WINDOWS, flags = ' /warn:all /check:all /error-limit:1& - & /Od /Z7 /assume:byterecl /traceback'), & + & /Od /Z7 /assume:byterecl /traceback', is_built_in=.true.), & & new_profile('debug', 'ifx', OS_ALL, flags = ' -warn all -check all -error-limit 1& - & -O0 -g -assume byterecl -traceback'), & + & -O0 -g -assume byterecl -traceback', is_built_in=.true.), & & new_profile('debug', 'ifx', OS_WINDOWS, flags = ' /warn:all /check:all /error-limit:1& - & /Od /Z7 /assume:byterecl'), & - & new_profile('debug', 'nagfor', OS_ALL, flags = ' -g -C=all -O0 -gline -coarray=single -PIC') & + & /Od /Z7 /assume:byterecl', is_built_in=.true.), & + & new_profile('debug', 'nagfor', OS_ALL, flags = ' -g -C=all -O0 -gline -coarray=single -PIC', is_built_in=.true.) & &] end function get_default_profiles diff --git a/test/fpm_test/test_manifest.f90 b/test/fpm_test/test_manifest.f90 index 4b2a3de448..da1fb6d1eb 100644 --- a/test/fpm_test/test_manifest.f90 +++ b/test/fpm_test/test_manifest.f90 @@ -415,16 +415,10 @@ subroutine test_profiles(error) & 'flags = "2" #release.gfortran.all', & & '[profiles.gfortran.linux]', & & 'flags = "3" #all.gfortran.linux', & - & '[profiles.release.linux]', & - & 'flags = "4" #release.gfortran.linux', & - & '[profiles.release]', & - & 'flags = "5" #release.gfortran.all', & & '[profiles.gfortran]', & - & 'flags = "6" #all.gfortran.all', & - & '[profiles.linux]', & - & 'flags = "7" #all.gfortran.linux', & + & 'flags = "4" #all.gfortran.all', & & '[profiles.release.ifort]', & - & 'flags = "8" #release.ifort.all' + & 'flags = "5" #release.ifort.all' close(unit) call get_package_data(package, manifest, error) @@ -437,7 +431,7 @@ subroutine test_profiles(error) profile_name = 'release' compiler = 'gfortran' call find_profile(package%profiles, profile_name, compiler, 1, profile_found, chosen_profile) - if (.not.(chosen_profile%flags.eq.'4 3 7')) then + if (.not.(chosen_profile%flags.eq.'1 3')) then call test_failed(error, "Failed to append flags from profiles named 'all'") return end if @@ -445,7 +439,7 @@ subroutine test_profiles(error) profile_name = 'release' compiler = 'gfortran' call find_profile(package%profiles, profile_name, compiler, 3, profile_found, chosen_profile) - if (.not.(chosen_profile%flags.eq.'5 6')) then + if (.not.(chosen_profile%flags.eq.'2 4')) then call test_failed(error, "Failed to choose profile with OS 'all'") return end if @@ -469,7 +463,7 @@ subroutine test_profiles(error) profile_name = 'release' compiler = 'ifort' call find_profile(package%profiles, profile_name, compiler, 1, profile_found, chosen_profile) - if (.not.(chosen_profile%flags.eq.'8')) then + if (.not.(chosen_profile%flags.eq.'5')) then call test_failed(error, "Failed to overwrite built-in profile") return end if From 7d8ca4cb523569813030de8f20e68afbb3a9e393 Mon Sep 17 00:00:00 2001 From: kubajj Date: Sat, 31 Jul 2021 16:41:42 +0200 Subject: [PATCH 17/32] Add profiles hierarchy and propagation to dependencies --- ci/run_tests.sh | 27 +++++ .../profiles_priorities/d1/.gitignore | 1 + .../profiles_priorities/d1/app/d1.f90 | 7 ++ .../profiles_priorities/d1/fpm.toml | 18 +++ .../profiles_priorities/d1/source/d1_m.f90 | 12 ++ .../profiles_priorities/d11/.gitignore | 1 + .../profiles_priorities/d11/app/d11.f90 | 8 ++ .../profiles_priorities/d11/fpm.toml | 12 ++ .../profiles_priorities/d11/source/d11_m.f90 | 14 +++ .../profiles_priorities/d12/.gitignore | 1 + .../profiles_priorities/d12/app/d12.f90 | 9 ++ .../profiles_priorities/d12/fpm.toml | 10 ++ .../profiles_priorities/d12/source/d12_m.f90 | 15 +++ .../profiles_priorities/d2/.gitignore | 1 + .../profiles_priorities/d2/app/d2.f90 | 8 ++ .../profiles_priorities/d2/fpm.toml | 16 +++ .../profiles_priorities/d2/source/d2_m.f90 | 17 +++ .../profiles_priorities/d21/.gitignore | 1 + .../profiles_priorities/d21/app/d21.f90 | 10 ++ .../profiles_priorities/d21/fpm.toml | 13 +++ .../profiles_priorities/d21/source/d21_m.f90 | 15 +++ .../profiles_priorities/d22/.gitignore | 1 + .../profiles_priorities/d22/app/d22.f90 | 9 ++ .../profiles_priorities/d22/fpm.toml | 10 ++ .../profiles_priorities/d22/source/d22_m.f90 | 15 +++ .../main_package/.gitignore | 1 + .../main_package/app/main.f90 | 8 ++ .../main_package/correct_log.txt | 7 ++ .../profiles_priorities/main_package/fpm.toml | 9 ++ .../primary_package/fpm.toml | 3 - manifest-reference.md | 57 +++++++++- src/fpm.f90 | 68 +++++++---- src/fpm/dependency.f90 | 106 +++++++++++++----- src/fpm/manifest/profiles.f90 | 4 +- src/fpm_model.f90 | 3 + test/fpm_test/test_package_dependencies.f90 | 4 +- 36 files changed, 464 insertions(+), 57 deletions(-) create mode 100644 example_packages/profiles_priorities/d1/.gitignore create mode 100644 example_packages/profiles_priorities/d1/app/d1.f90 create mode 100644 example_packages/profiles_priorities/d1/fpm.toml create mode 100644 example_packages/profiles_priorities/d1/source/d1_m.f90 create mode 100644 example_packages/profiles_priorities/d11/.gitignore create mode 100644 example_packages/profiles_priorities/d11/app/d11.f90 create mode 100644 example_packages/profiles_priorities/d11/fpm.toml create mode 100644 example_packages/profiles_priorities/d11/source/d11_m.f90 create mode 100644 example_packages/profiles_priorities/d12/.gitignore create mode 100644 example_packages/profiles_priorities/d12/app/d12.f90 create mode 100644 example_packages/profiles_priorities/d12/fpm.toml create mode 100644 example_packages/profiles_priorities/d12/source/d12_m.f90 create mode 100644 example_packages/profiles_priorities/d2/.gitignore create mode 100644 example_packages/profiles_priorities/d2/app/d2.f90 create mode 100644 example_packages/profiles_priorities/d2/fpm.toml create mode 100644 example_packages/profiles_priorities/d2/source/d2_m.f90 create mode 100644 example_packages/profiles_priorities/d21/.gitignore create mode 100644 example_packages/profiles_priorities/d21/app/d21.f90 create mode 100644 example_packages/profiles_priorities/d21/fpm.toml create mode 100644 example_packages/profiles_priorities/d21/source/d21_m.f90 create mode 100644 example_packages/profiles_priorities/d22/.gitignore create mode 100644 example_packages/profiles_priorities/d22/app/d22.f90 create mode 100644 example_packages/profiles_priorities/d22/fpm.toml create mode 100644 example_packages/profiles_priorities/d22/source/d22_m.f90 create mode 100644 example_packages/profiles_priorities/main_package/.gitignore create mode 100644 example_packages/profiles_priorities/main_package/app/main.f90 create mode 100644 example_packages/profiles_priorities/main_package/correct_log.txt create mode 100644 example_packages/profiles_priorities/main_package/fpm.toml diff --git a/ci/run_tests.sh b/ci/run_tests.sh index ff477e7e47..226b057708 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -98,5 +98,32 @@ pushd c_header_only "$fpm" build popd +pushd profiles_with_c +"$fpm" build +"$fpm" run +popd + +pushd program_with_compiler_profiles +"$fpm" build +"$fpm" run +popd + +pushd program_with_free_form_in_dot_f +"$fpm" build +"$fpm" run +popd + +pushd "program_with_profiles_scope/primary_package" +"$fpm" build +"$fpm" run +popd + +pushd "profiles_priorities/main_package" +rm -rf build +"$fpm" build | sed -n 's,^.*/\([^/ ]*\.f90 .*\) -J .*$,\1,p' | sort > log.txt +cmp log.txt correct_log.txt +rm log.txt +popd + # Cleanup rm -rf ./*/build diff --git a/example_packages/profiles_priorities/d1/.gitignore b/example_packages/profiles_priorities/d1/.gitignore new file mode 100644 index 0000000000..a007feab07 --- /dev/null +++ b/example_packages/profiles_priorities/d1/.gitignore @@ -0,0 +1 @@ +build/* diff --git a/example_packages/profiles_priorities/d1/app/d1.f90 b/example_packages/profiles_priorities/d1/app/d1.f90 new file mode 100644 index 0000000000..9fc99a141d --- /dev/null +++ b/example_packages/profiles_priorities/d1/app/d1.f90 @@ -0,0 +1,7 @@ +program d1 + use d1_m, only: say_hi + + implicit none + + call say_hi() +end program d1 diff --git a/example_packages/profiles_priorities/d1/fpm.toml b/example_packages/profiles_priorities/d1/fpm.toml new file mode 100644 index 0000000000..f5146d5085 --- /dev/null +++ b/example_packages/profiles_priorities/d1/fpm.toml @@ -0,0 +1,18 @@ +name = "d1" + +[library] +source-dir="source" + +[[executable]] +name="d1" +source-dir="app" +main="d1.f90" + +[profiles.debug.gfortran.linux] +flags="-g -O1" + +[dependencies] +"d11" = {path = "../d11"} +"d12" = {path = "../d12"} + + diff --git a/example_packages/profiles_priorities/d1/source/d1_m.f90 b/example_packages/profiles_priorities/d1/source/d1_m.f90 new file mode 100644 index 0000000000..e2cc563eaa --- /dev/null +++ b/example_packages/profiles_priorities/d1/source/d1_m.f90 @@ -0,0 +1,12 @@ +module d1_m + use d11_m, only: create_greeting + use d12_m, only: get_name + implicit none + + public :: say_hi +contains + subroutine say_hi() + print *, create_greeting("hello"), get_name("developer","fpm") + end subroutine say_hi +end module d1_m + diff --git a/example_packages/profiles_priorities/d11/.gitignore b/example_packages/profiles_priorities/d11/.gitignore new file mode 100644 index 0000000000..a007feab07 --- /dev/null +++ b/example_packages/profiles_priorities/d11/.gitignore @@ -0,0 +1 @@ +build/* diff --git a/example_packages/profiles_priorities/d11/app/d11.f90 b/example_packages/profiles_priorities/d11/app/d11.f90 new file mode 100644 index 0000000000..674b310a4f --- /dev/null +++ b/example_packages/profiles_priorities/d11/app/d11.f90 @@ -0,0 +1,8 @@ +program d11 + use d11_m, only: create_greeting + + implicit none + + print *,create_greeting("hey") +end program d11 + diff --git a/example_packages/profiles_priorities/d11/fpm.toml b/example_packages/profiles_priorities/d11/fpm.toml new file mode 100644 index 0000000000..de5049fc4b --- /dev/null +++ b/example_packages/profiles_priorities/d11/fpm.toml @@ -0,0 +1,12 @@ +name = "d11" + +[library] +source-dir="source" + +[[executable]] +name="d11" +source-dir="app" +main="d11.f90" + +[profiles.debug.gfortran.linux] +flags="-g -O2" diff --git a/example_packages/profiles_priorities/d11/source/d11_m.f90 b/example_packages/profiles_priorities/d11/source/d11_m.f90 new file mode 100644 index 0000000000..37508b5fe5 --- /dev/null +++ b/example_packages/profiles_priorities/d11/source/d11_m.f90 @@ -0,0 +1,14 @@ +module d11_m + implicit none + + public :: create_greeting +contains + function create_greeting(greeting) result(created) + character(len=*), intent(in) :: greeting + character(len=:), allocatable :: created + + created = greeting // " " + end function create_greeting +end module d11_m + + diff --git a/example_packages/profiles_priorities/d12/.gitignore b/example_packages/profiles_priorities/d12/.gitignore new file mode 100644 index 0000000000..a007feab07 --- /dev/null +++ b/example_packages/profiles_priorities/d12/.gitignore @@ -0,0 +1 @@ +build/* diff --git a/example_packages/profiles_priorities/d12/app/d12.f90 b/example_packages/profiles_priorities/d12/app/d12.f90 new file mode 100644 index 0000000000..58e0043ae2 --- /dev/null +++ b/example_packages/profiles_priorities/d12/app/d12.f90 @@ -0,0 +1,9 @@ +program d12 + use d12_m, only: get_name + + implicit none + + print *,get_name("developer", "fpm") +end program d12 + + diff --git a/example_packages/profiles_priorities/d12/fpm.toml b/example_packages/profiles_priorities/d12/fpm.toml new file mode 100644 index 0000000000..654141deff --- /dev/null +++ b/example_packages/profiles_priorities/d12/fpm.toml @@ -0,0 +1,10 @@ +name = "d12" + +[library] +source-dir="source" + +[[executable]] +name="d12" +source-dir="app" +main="d12.f90" + diff --git a/example_packages/profiles_priorities/d12/source/d12_m.f90 b/example_packages/profiles_priorities/d12/source/d12_m.f90 new file mode 100644 index 0000000000..af5d29fff8 --- /dev/null +++ b/example_packages/profiles_priorities/d12/source/d12_m.f90 @@ -0,0 +1,15 @@ +module d12_m + implicit none + + public :: get_name +contains + function get_name(name, surname) result(full_name) + character(len=*), intent(in) :: name, surname + character(len=:), allocatable :: full_name + + full_name = surname // " " // name + end function get_name +end module d12_m + + + diff --git a/example_packages/profiles_priorities/d2/.gitignore b/example_packages/profiles_priorities/d2/.gitignore new file mode 100644 index 0000000000..a007feab07 --- /dev/null +++ b/example_packages/profiles_priorities/d2/.gitignore @@ -0,0 +1 @@ +build/* diff --git a/example_packages/profiles_priorities/d2/app/d2.f90 b/example_packages/profiles_priorities/d2/app/d2.f90 new file mode 100644 index 0000000000..6b212b1323 --- /dev/null +++ b/example_packages/profiles_priorities/d2/app/d2.f90 @@ -0,0 +1,8 @@ +program d2 + use d2_m, only: count_to_ten + + implicit none + + call count_to_ten() +end program d2 + diff --git a/example_packages/profiles_priorities/d2/fpm.toml b/example_packages/profiles_priorities/d2/fpm.toml new file mode 100644 index 0000000000..3f588c7afa --- /dev/null +++ b/example_packages/profiles_priorities/d2/fpm.toml @@ -0,0 +1,16 @@ +name = "d2" + +[library] +source-dir="source" + +[[executable]] +name="d2" +source-dir="app" +main="d2.f90" + +[dependencies] +"d21" = {path = "../d21"} +"d22" = {path = "../d22"} + + + diff --git a/example_packages/profiles_priorities/d2/source/d2_m.f90 b/example_packages/profiles_priorities/d2/source/d2_m.f90 new file mode 100644 index 0000000000..d16623afb2 --- /dev/null +++ b/example_packages/profiles_priorities/d2/source/d2_m.f90 @@ -0,0 +1,17 @@ +module d2_m + use d21_m, only: count_iter + use d22_m, only: count_rec + implicit none + + public :: count_to_ten +contains + subroutine count_to_ten() + print *,"This is test of counting to ten:" + print *,"Iterative version" + call count_iter(10) + print *,"Recursive version" + call count_rec(1,10) + end subroutine count_to_ten +end module d2_m + + diff --git a/example_packages/profiles_priorities/d21/.gitignore b/example_packages/profiles_priorities/d21/.gitignore new file mode 100644 index 0000000000..a007feab07 --- /dev/null +++ b/example_packages/profiles_priorities/d21/.gitignore @@ -0,0 +1 @@ +build/* diff --git a/example_packages/profiles_priorities/d21/app/d21.f90 b/example_packages/profiles_priorities/d21/app/d21.f90 new file mode 100644 index 0000000000..53f3e9cab5 --- /dev/null +++ b/example_packages/profiles_priorities/d21/app/d21.f90 @@ -0,0 +1,10 @@ +program d21 + use d21_m, only: count_iter + + implicit none + + call count_iter(10) +end program d21 + + + diff --git a/example_packages/profiles_priorities/d21/fpm.toml b/example_packages/profiles_priorities/d21/fpm.toml new file mode 100644 index 0000000000..4bc9e3a58d --- /dev/null +++ b/example_packages/profiles_priorities/d21/fpm.toml @@ -0,0 +1,13 @@ +name = "d21" + +[library] +source-dir="source" + +[[executable]] +name="d21" +source-dir="app" +main="d21.f90" + +[profiles.debug.gfortran.linux] +flags="-g -O2" + diff --git a/example_packages/profiles_priorities/d21/source/d21_m.f90 b/example_packages/profiles_priorities/d21/source/d21_m.f90 new file mode 100644 index 0000000000..19153b8a4a --- /dev/null +++ b/example_packages/profiles_priorities/d21/source/d21_m.f90 @@ -0,0 +1,15 @@ +module d21_m + implicit none + + public :: count_iter +contains + subroutine count_iter(n) + integer :: n, i + do i=1,n + print *,i + end do + end subroutine count_iter +end module d21_m + + + diff --git a/example_packages/profiles_priorities/d22/.gitignore b/example_packages/profiles_priorities/d22/.gitignore new file mode 100644 index 0000000000..a007feab07 --- /dev/null +++ b/example_packages/profiles_priorities/d22/.gitignore @@ -0,0 +1 @@ +build/* diff --git a/example_packages/profiles_priorities/d22/app/d22.f90 b/example_packages/profiles_priorities/d22/app/d22.f90 new file mode 100644 index 0000000000..2586631201 --- /dev/null +++ b/example_packages/profiles_priorities/d22/app/d22.f90 @@ -0,0 +1,9 @@ +program d22 + use d22_m, only: count_rec + + implicit none + + call count_rec(1,10) +end program d22 + + diff --git a/example_packages/profiles_priorities/d22/fpm.toml b/example_packages/profiles_priorities/d22/fpm.toml new file mode 100644 index 0000000000..89e1343b23 --- /dev/null +++ b/example_packages/profiles_priorities/d22/fpm.toml @@ -0,0 +1,10 @@ +name = "d22" + +[library] +source-dir="source" + +[[executable]] +name="d22" +source-dir="app" +main="d22.f90" + diff --git a/example_packages/profiles_priorities/d22/source/d22_m.f90 b/example_packages/profiles_priorities/d22/source/d22_m.f90 new file mode 100644 index 0000000000..c20ca27c55 --- /dev/null +++ b/example_packages/profiles_priorities/d22/source/d22_m.f90 @@ -0,0 +1,15 @@ +module d22_m + implicit none + + public :: count_rec +contains + recursive subroutine count_rec(c, n) + integer :: c,n + if (n > 0) then + print *,c + call count_rec(c+1, n-1) + end if + end subroutine count_rec +end module d22_m + + diff --git a/example_packages/profiles_priorities/main_package/.gitignore b/example_packages/profiles_priorities/main_package/.gitignore new file mode 100644 index 0000000000..a007feab07 --- /dev/null +++ b/example_packages/profiles_priorities/main_package/.gitignore @@ -0,0 +1 @@ +build/* diff --git a/example_packages/profiles_priorities/main_package/app/main.f90 b/example_packages/profiles_priorities/main_package/app/main.f90 new file mode 100644 index 0000000000..0086519a82 --- /dev/null +++ b/example_packages/profiles_priorities/main_package/app/main.f90 @@ -0,0 +1,8 @@ +program main_package + use d1_m, only: say_hi + use d2_m, only: count_to_ten + + call say_hi() + call count_to_ten() +end program main_package + diff --git a/example_packages/profiles_priorities/main_package/correct_log.txt b/example_packages/profiles_priorities/main_package/correct_log.txt new file mode 100644 index 0000000000..260ecefd05 --- /dev/null +++ b/example_packages/profiles_priorities/main_package/correct_log.txt @@ -0,0 +1,7 @@ +d11_m.f90 -g -O2 +d12_m.f90 -g -O1 +d1_m.f90 -g -O1 +d21_m.f90 -g -O2 +d22_m.f90 -g +d2_m.f90 -g +main.f90 -g diff --git a/example_packages/profiles_priorities/main_package/fpm.toml b/example_packages/profiles_priorities/main_package/fpm.toml new file mode 100644 index 0000000000..948d335fe1 --- /dev/null +++ b/example_packages/profiles_priorities/main_package/fpm.toml @@ -0,0 +1,9 @@ +name = "main_package" + +[profiles.debug.gfortran.linux] +flags="-g" + +[dependencies] +"d1" = {path = "../d1"} +"d2" = {path = "../d2"} + diff --git a/example_packages/program_with_profiles_scope/primary_package/fpm.toml b/example_packages/program_with_profiles_scope/primary_package/fpm.toml index 861c78bc77..e185c1c86d 100644 --- a/example_packages/program_with_profiles_scope/primary_package/fpm.toml +++ b/example_packages/program_with_profiles_scope/primary_package/fpm.toml @@ -1,8 +1,5 @@ name = "hello_world" -[profiles.debug] -flags="-Og" - [profiles.debug.gfortran.linux] flags="-g" diff --git a/manifest-reference.md b/manifest-reference.md index aca5688fcc..c23ec3f120 100644 --- a/manifest-reference.md +++ b/manifest-reference.md @@ -47,7 +47,9 @@ Every manifest file consists of the following sections: Project library dependencies - [*dev-dependencies*](#development-dependencies): Dependencies only needed for tests -- [*compiler profiles*](#compiler-flags-profiles): +- Compiler profiles sections: + - [*compiler profiles toml*](#compiler-flags-profiles-toml): + - [*compiler profiles hierarchy*](#compiler-flags-profiles-hierarchy): - [*install*](#installation-configuration): Installation configuration @@ -469,12 +471,40 @@ rev = "2f5eaba864ff630ba0c3791126a3f811b6e437f3" Development dependencies allow to declare *dev-dependencies* in the manifest root, which are available to all tests but not exported with the project. ## Compiler flags profiles +### Compiler flags profiles - Toml Compiler flags profiles can be declared in the *profiles* table. They are organised into subtables in the following order: | Subtable | Profile name | Compiler | Operating system | |---|:---:|:---:|:---:| | Example | `debug` | `gfortran` | `linux` | +- Profile name can be an arbitrary string. +- Compiler can be a string from the following list: + - "gfortran" + - "ifort" + - "ifx" + - "pgfortran" + - "nvfrotran" + - "flang" + - "caf" + - "f95" + - "lfortran" + - "lfc" + - "nagfor" + - "crayftn" + - "xlf90" + - "ftn95" +- Operating system can be a lowercase string from the following list: + - "linux" + - "macos" + - "windows" + - "cygwin" + - "solaris" + - "freebsd" + - "openbsd" + - "unknown" + - "UNKNOWN" + There are 4 fields that can be specified for each of the profiles: - `'flags'` - Fortran compiler flags - `'c-flags'` - C compiler flags @@ -488,9 +518,8 @@ flags = '-g -Wall' files={"source/greet_m.f90"="-Wall -g -fcheck=all", "source/farewell_m.f90"="-Og"} ``` -All the subtables can be omitted in the definition. In such case the following behaviour is applied: +Both profile name and operating system subtables can be omitted in the definition. In such case the following behaviour is applied: - *Profile name* is omitted - Fields of this subtable are added to fields of all profiles with matching compiler and OS definitions (this is not the case for `files` field) -- *Compiler* is omitted - Compiler is set to *default* value (currently `gfortran`) - *Operating system* is omitted - Fields of this subtable are used if and only if there is no profile with perfectly matching OS definition Example: @@ -500,6 +529,28 @@ Example: flags = '-g -Wall' ``` +### Compiler flags profiles - Hierarchy +There are 18 built-in profiles which are implemented in `fpm_manifest_profiles.f90`. They should cover the most used cases. If user wishes to specify their own profiles +such profiles have priority over the built-in ones. This priority can be propagated to dependencies if they do not specify the profiles. + +Example: +In `example_packages/profiles_priorities`, there are 7 packages in total. The main package is called `main_package` and uses `d1` and `d2`. +`d1` uses `d11` and `d12` and similarly for `d2`. +The compiler flags degined in these packages are following: +| Package | Flags | Flags with priorities | +|---|:---:|:---:| +| `main_package` | `-g` | `-g` | +| `d1` | `-g -O1` | `-g -O1` | +| `d11` | `-g -O2` | `-g -O2` | +| `d12` | *none* | `-g -O1` | +| `d2` | *none* | `-g` | +| `d11` | `-g -O2` | `-g -O2` | +| `d12` | *none* | `-g` | + +As `d12`, `d2` and `d22` do not specify any profiles in their `fpm.toml`, they inherit profile from their parents. +For `d12` the first ancestor with specified profiles is `d1`, therefore it inherits flags `-g -O1`. +The parent of `d22` is `d2` which does not have profiles specified, therefore, both of them inherit `-g` from the main package. + ## Installation configuration In the *install* section components for the installation can be selected. diff --git a/src/fpm.f90 b/src/fpm.f90 index 436adf25f8..a7b737d9bf 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -42,7 +42,6 @@ subroutine build_model(model, settings, package, error) integer :: i, j type(package_config_t) :: dependency - type(profile_config_t) :: primary_pkg_profile, current_pkg_profile character(len=:), allocatable :: manifest, lib_dir, profile, compiler_flags, file_scope_flag logical :: duplicates_found = .false., profile_found @@ -134,7 +133,9 @@ subroutine build_model(model, settings, package, error) if (allocated(error)) exit model%packages(i)%name = dependency%name - model%packages(i)%profiles = dependency%profiles + if (allocated(dependency%profiles)) model%packages(i)%profiles = dependency%profiles + if (allocated(dep%parent)) model%packages(i)%parent = dep%parent + if (.not.allocated(model%packages(i)%sources)) allocate(model%packages(i)%sources(0)) if (allocated(dependency%library)) then @@ -200,25 +201,7 @@ subroutine build_model(model, settings, package, error) if (allocated(profile)) then do i=1,size(model%packages) - associate(pkg => model%packages(i)) - if (allocated(pkg%profiles)) then - call find_profile(pkg%profiles, profile, model%fortran_compiler, & - & get_os_type(), profile_found, current_pkg_profile) - if (.not.profile_found .and. i.gt.1) then - current_pkg_profile = primary_pkg_profile - else if (current_pkg_profile%is_built_in) then - current_pkg_profile = primary_pkg_profile - else if (i.eq.1) then - if (.not.profile_found) then - error stop 'Error: primary package does not have given profile.' - end if - primary_pkg_profile = current_pkg_profile - end if - else - current_pkg_profile = primary_pkg_profile - end if - pkg%chosen_profile = current_pkg_profile - end associate + model%packages(i)%chosen_profile = look_for_profile(i) end do end if @@ -267,6 +250,49 @@ subroutine build_model(model, settings, package, error) contains + function look_for_profile(package_id) result (chosen_profile) + integer, intent(in) :: package_id + + integer :: idx + type(profile_config_t), allocatable :: built_in, chosen_profile + type(profile_config_t) :: current + logical :: profile_found + + idx = package_id + associate(pkgs => model%packages) + do while (.true.) + profile_found = .false. + if (allocated(pkgs(idx)%profiles)) then + call find_profile(pkgs(idx)%profiles, profile, model%fortran_compiler, & + & get_os_type(), profile_found, current) + if (profile_found) then + if (current%is_built_in) then + if (.not. allocated(built_in)) then + built_in = current + chosen_profile = current + end if + if (allocated(pkgs(idx)%parent)) then + idx = pkgs(idx)%parent(1) + else + exit + end if + else + chosen_profile = current + return + end if + end if + else + if (allocated(pkgs(idx)%parent)) then + idx = pkgs(idx)%parent(1) + else + call fpm_stop(1,'*look_for_profile*:Error: Orphan package does not have any profiles.') + end if + end if + end do + end associate + if (.not. allocated(chosen_profile)) call fpm_stop(1,'*look_for_profile*:Error: No profile found.') + end function look_for_profile + function get_file_scope_flags(source, profile) result(file_scope_flag) ! Try to match source%file_name in profile%file_scope_flags ! diff --git a/src/fpm/dependency.f90 b/src/fpm/dependency.f90 index bd85b6f014..1ae98d00a1 100644 --- a/src/fpm/dependency.f90 +++ b/src/fpm/dependency.f90 @@ -57,14 +57,15 @@ module fpm_dependency use, intrinsic :: iso_fortran_env, only : output_unit use fpm_environment, only : get_os_type, OS_WINDOWS - use fpm_error, only : error_t, fatal_error + use fpm_error, only : error_t, fatal_error, fpm_stop use fpm_filesystem, only : exists, join_path, mkdir, canon_path, windows_path use fpm_git, only : git_target_revision, git_target_default, git_revision use fpm_manifest, only : package_config_t, dependency_config_t, & get_package_data use fpm_strings, only : string_t, operator(.in.) - use fpm_toml, only : toml_table, toml_key, toml_error, toml_serializer, & - toml_parse, get_value, set_value, add_table + use fpm_toml, only : toml_table, toml_array, toml_key, toml_error, & + & toml_serializer, toml_parse, toml_stat, get_value, set_value, & + & add_table, add_array, len use fpm_versioning, only : version_t, new_version, char implicit none private @@ -92,6 +93,8 @@ module fpm_dependency logical :: done = .false. !> Dependency should be updated logical :: update = .false. + !> List of indices of parent nodes in the tree + integer, allocatable :: parent(:) contains !> Update dependency from project manifest procedure :: register @@ -191,7 +194,8 @@ subroutine new_dependency_tree(self, verbosity, cache) end subroutine new_dependency_tree !> Create a new dependency node from a configuration - pure subroutine new_dependency_node(self, dependency, version, proj_dir, update) +! pure subroutine new_dependency_node(self, dependency, version, proj_dir, update, parent) + subroutine new_dependency_node(self, dependency, version, proj_dir, update, parent) !> Instance of the dependency node type(dependency_node_t), intent(out) :: self !> Dependency configuration data @@ -202,6 +206,8 @@ pure subroutine new_dependency_node(self, dependency, version, proj_dir, update) character(len=*), intent(in), optional :: proj_dir !> Dependency should be updated logical, intent(in), optional :: update + !> Index of parent node + integer, intent(in), optional :: parent self%dependency_config_t = dependency @@ -217,6 +223,11 @@ pure subroutine new_dependency_node(self, dependency, version, proj_dir, update) self%update = update end if + if (present(parent)) then + allocate(self%parent(1)) + self%parent(1) = parent + end if + end subroutine new_dependency_node !> Add project dependencies, each depth level after each other. @@ -252,16 +263,16 @@ subroutine add_project(self, package, error) if (allocated(error)) return ! Resolve the root project - call self%resolve(root, error) + call self%resolve(root, error, parent=package%name) if (allocated(error)) return ! Add the root project dependencies (depth 1) - call self%add(package, root, .true., error) + call self%add(package, root, .true., error, parent=package%name) if (allocated(error)) return ! Now decent into the dependency tree, level for level do while(.not.self%finished()) - call self%resolve(root, error) + call self%resolve(root, error, parent=package%name) if (allocated(error)) exit end do if (allocated(error)) return @@ -274,7 +285,7 @@ subroutine add_project(self, package, error) end subroutine add_project !> Add a project and its dependencies to the dependency tree - recursive subroutine add_project_dependencies(self, package, root, main, error) + recursive subroutine add_project_dependencies(self, package, root, main, error, parent) !> Instance of the dependency tree class(dependency_tree_t), intent(inout) :: self !> Project configuration to add @@ -285,24 +296,26 @@ recursive subroutine add_project_dependencies(self, package, root, main, error) logical, intent(in) :: main !> Error handling type(error_t), allocatable, intent(out) :: error + !> Name of parent package + character(len=*), intent(in), optional :: parent integer :: ii if (allocated(package%dependency)) then - call self%add(package%dependency, error) + call self%add(package%dependency, error, parent=package%name) if (allocated(error)) return end if if (main) then if (allocated(package%dev_dependency)) then - call self%add(package%dev_dependency, error) + call self%add(package%dev_dependency, error, parent=package%name) if (allocated(error)) return end if if (allocated(package%executable)) then do ii = 1, size(package%executable) if (allocated(package%executable(ii)%dependency)) then - call self%add(package%executable(ii)%dependency, error) + call self%add(package%executable(ii)%dependency, error, parent=package%name) if (allocated(error)) exit end if end do @@ -312,7 +325,7 @@ recursive subroutine add_project_dependencies(self, package, root, main, error) if (allocated(package%example)) then do ii = 1, size(package%example) if (allocated(package%example(ii)%dependency)) then - call self%add(package%example(ii)%dependency, error) + call self%add(package%example(ii)%dependency, error, parent=package%name) if (allocated(error)) exit end if end do @@ -322,7 +335,7 @@ recursive subroutine add_project_dependencies(self, package, root, main, error) if (allocated(package%test)) then do ii = 1, size(package%test) if (allocated(package%test(ii)%dependency)) then - call self%add(package%test(ii)%dependency, error) + call self%add(package%test(ii)%dependency, error, parent=package%name) if (allocated(error)) exit end if end do @@ -333,13 +346,15 @@ recursive subroutine add_project_dependencies(self, package, root, main, error) end subroutine add_project_dependencies !> Add a list of dependencies to the dependency tree - subroutine add_dependencies(self, dependency, error) + subroutine add_dependencies(self, dependency, error, parent) !> Instance of the dependency tree class(dependency_tree_t), intent(inout) :: self !> Dependency configuration to add type(dependency_config_t), intent(in) :: dependency(:) !> Error handling type(error_t), allocatable, intent(out) :: error + !> Name of parent package + character(len=*), intent(in), optional :: parent integer :: ii, ndep @@ -349,7 +364,7 @@ subroutine add_dependencies(self, dependency, error) end if do ii = 1, size(dependency) - call self%add(dependency(ii), error) + call self%add(dependency(ii), error, parent=parent) if (allocated(error)) exit end do if (allocated(error)) return @@ -357,20 +372,39 @@ subroutine add_dependencies(self, dependency, error) end subroutine add_dependencies !> Add a single dependency to the dependency tree - pure subroutine add_dependency(self, dependency, error) +! pure subroutine add_dependency(self, dependency, error, parent) + subroutine add_dependency(self, dependency, error, parent) !> Instance of the dependency tree class(dependency_tree_t), intent(inout) :: self !> Dependency configuration to add type(dependency_config_t), intent(in) :: dependency !> Error handling type(error_t), allocatable, intent(out) :: error + !> Name of parent package + character(len=*), intent(in), optional :: parent - integer :: id + integer :: id, i, parent_id=0 + logical :: found = .false. + if (present(parent)) then + parent_id = self%find(parent) + if (parent_id < 1) call fpm_stop(1,'*add_dependency*:Error: No such package in dependency tree.') + end if id = self%find(dependency) if (id == 0) then self%ndep = self%ndep + 1 - call new_dependency_node(self%dep(self%ndep), dependency) + if (parent_id > 0) then + call new_dependency_node(self%dep(self%ndep), dependency, parent=parent_id) + else + call new_dependency_node(self%dep(self%ndep), dependency) + end if + else if (present(parent) .and. allocated(self%dep(id)%parent)) then + do i=1, size(self%dep(id)%parent) + if (self%dep(id)%parent(i)==parent_id) then + found=.true. + end if + end do + if (.not. found) self%dep(id)%parent = [self%dep(id)%parent, parent_id] end if end subroutine add_dependency @@ -420,18 +454,20 @@ subroutine update_dependency(self, name, error) end subroutine update_dependency !> Resolve all dependencies in the tree - subroutine resolve_dependencies(self, root, error) + subroutine resolve_dependencies(self, root, error, parent) !> Instance of the dependency tree class(dependency_tree_t), intent(inout) :: self !> Current installation prefix character(len=*), intent(in) :: root !> Error handling type(error_t), allocatable, intent(out) :: error + !> Name of parent package + character(len=*), intent(in), optional :: parent integer :: ii do ii = 1, self%ndep - call self%resolve(self%dep(ii), root, error) + call self%resolve(self%dep(ii), root, error, parent=parent) if (allocated(error)) exit end do @@ -440,7 +476,7 @@ subroutine resolve_dependencies(self, root, error) end subroutine resolve_dependencies !> Resolve a single dependency node - subroutine resolve_dependency(self, dependency, root, error) + subroutine resolve_dependency(self, dependency, root, error, parent) !> Instance of the dependency tree class(dependency_tree_t), intent(inout) :: self !> Dependency configuration to add @@ -449,6 +485,8 @@ subroutine resolve_dependency(self, dependency, root, error) character(len=*), intent(in) :: root !> Error handling type(error_t), allocatable, intent(out) :: error + !> Name of parent package + character(len=*), intent(in), optional :: parent type(package_config_t) :: package character(len=:), allocatable :: manifest, proj_dir, revision @@ -491,7 +529,7 @@ subroutine resolve_dependency(self, dependency, root, error) "at", dependency%proj_dir end if - call self%add(package, proj_dir, .false., error) + call self%add(package, proj_dir, .false., error, parent=parent) if (allocated(error)) return end subroutine resolve_dependency @@ -638,11 +676,12 @@ subroutine load_from_toml(self, table, error) !> Error handling type(error_t), allocatable, intent(out) :: error - integer :: ndep, ii + integer :: ndep, ii, ip logical :: unix - character(len=:), allocatable :: version, url, obj, rev, proj_dir + character(len=:), allocatable :: version, url, obj, rev, proj_dir, parent_name type(toml_key), allocatable :: list(:) type(toml_table), pointer :: ptr + type(toml_array), pointer :: p_array call table%get_keys(list) @@ -660,6 +699,7 @@ subroutine load_from_toml(self, table, error) call get_value(ptr, "git", url) call get_value(ptr, "obj", obj) call get_value(ptr, "rev", rev) + call get_value(ptr, "parent", p_array, requested=.false.) if (.not.allocated(proj_dir)) cycle self%ndep = self%ndep + 1 associate(dep => self%dep(self%ndep)) @@ -691,6 +731,13 @@ subroutine load_from_toml(self, table, error) else dep%path = proj_dir end if + if (associated(p_array)) then + allocate(dep%parent(len(p_array))) + do ip = 1, len(p_array) + call get_value(p_array, ip, parent_name) + dep%parent(ip) = self%find(parent_name) + end do + end if end associate end do if (allocated(error)) return @@ -746,12 +793,13 @@ subroutine dump_to_toml(self, table, error) !> Error handling type(error_t), allocatable, intent(out) :: error - integer :: ii + integer :: ii, iii type(toml_table), pointer :: ptr + type(toml_array), pointer :: parent_ptr character(len=:), allocatable :: proj_dir do ii = 1, self%ndep - associate(dep => self%dep(ii)) + associate(dep => self%dep(ii), deps => self%dep) call add_table(table, dep%name, ptr) if (.not.associated(ptr)) then call fatal_error(error, "Cannot create entry for "//dep%name) @@ -771,6 +819,12 @@ subroutine dump_to_toml(self, table, error) call set_value(ptr, "rev", dep%revision) end if end if + if (allocated(dep%parent) .and. size(dep%parent) > 0) then + call add_array(ptr, "parent", parent_ptr) + do iii=1,size(dep%parent) + call set_value(parent_ptr, iii, self%dep(dep%parent(iii))%name) + end do + end if end associate end do if (allocated(error)) return diff --git a/src/fpm/manifest/profiles.f90 b/src/fpm/manifest/profiles.f90 index d1208a3d23..8c1bd7afdf 100644 --- a/src/fpm/manifest/profiles.f90 +++ b/src/fpm/manifest/profiles.f90 @@ -2,7 +2,7 @@ !> !> A profiles table can currently have the following subtables: !> Profile names - any string, if omitted, flags are appended to all matching profiles -!> Compiler - any from the following list, if omitted, `DEFAULT_COMPILER` is used +!> Compiler - any from the following list, omitting it yields an error !> - "gfortran" !> - "ifort" !> - "ifx" @@ -350,9 +350,7 @@ subroutine traverse_oss(profile_name, compiler_name, os_list, table, error, prof call fatal_error(error, "Both profiles and profindex have to be present") return end if - os_name = os_list(ios)%key call get_value(table, os_name, os_node, stat=stat) - os_name = lower(os_name) if (stat /= toml_stat%success) then call syntax_error(error, "os "//os_name//" has to be a table") return diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index c1dba53614..17411bc7b4 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -113,6 +113,9 @@ module fpm_model !> Chosen compiler profile type(profile_config_t) :: chosen_profile + + !> Indices of parent packages + integer, allocatable :: parent(:) end type package_t diff --git a/test/fpm_test/test_package_dependencies.f90 b/test/fpm_test/test_package_dependencies.f90 index a3192ff2f9..7e8a879361 100644 --- a/test/fpm_test/test_package_dependencies.f90 +++ b/test/fpm_test/test_package_dependencies.f90 @@ -212,7 +212,7 @@ end subroutine test_add_dependencies !> Resolve a single dependency node - subroutine resolve_dependency_once(self, dependency, root, error) + subroutine resolve_dependency_once(self, dependency, root, error, parent) !> Mock instance of the dependency tree class(mock_dependency_tree_t), intent(inout) :: self !> Dependency configuration to add @@ -221,6 +221,8 @@ subroutine resolve_dependency_once(self, dependency, root, error) character(len=*), intent(in) :: root !> Error handling type(error_t), allocatable, intent(out) :: error + !> Name of the parent package + character(len=*), intent(in), optional :: parent if (dependency%done) then call test_failed(error, "Should only visit this node once") From 999c3a6bc4bc0840f1de4f351dcea881225a911b Mon Sep 17 00:00:00 2001 From: kubajj Date: Sat, 31 Jul 2021 19:40:26 +0200 Subject: [PATCH 18/32] Implement suggested changes --- ci/run_tests.sh | 4 +++- example_packages/profiles_priorities/d1/fpm.toml | 5 ++++- example_packages/profiles_priorities/d11/fpm.toml | 5 ++++- example_packages/profiles_priorities/d21/fpm.toml | 5 ++++- .../profiles_priorities/main_package/fpm.toml | 5 ++++- .../profiles_priorities/main_package/log_1.txt | 7 +++++++ manifest-reference.md | 3 +-- src/fpm/dependency.f90 | 12 +++++++----- src/fpm/manifest/profiles.f90 | 7 +++---- 9 files changed, 37 insertions(+), 16 deletions(-) create mode 100644 example_packages/profiles_priorities/main_package/log_1.txt diff --git a/ci/run_tests.sh b/ci/run_tests.sh index 226b057708..bb943a915a 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -120,7 +120,9 @@ popd pushd "profiles_priorities/main_package" rm -rf build -"$fpm" build | sed -n 's,^.*/\([^/ ]*\.f90 .*\) -J .*$,\1,p' | sort > log.txt +"$fpm" build | sed -n 's,^.*/\([^/ ]*\.f90 .*\) -J .*$,\1,p' > log_1.txt +cat log_1.txt +cat log_1.txt | sed 's,/,-,g' | sort > log.txt cmp log.txt correct_log.txt rm log.txt popd diff --git a/example_packages/profiles_priorities/d1/fpm.toml b/example_packages/profiles_priorities/d1/fpm.toml index f5146d5085..a19e011a2f 100644 --- a/example_packages/profiles_priorities/d1/fpm.toml +++ b/example_packages/profiles_priorities/d1/fpm.toml @@ -8,9 +8,12 @@ name="d1" source-dir="app" main="d1.f90" -[profiles.debug.gfortran.linux] +[profiles.debug.gfortran] flags="-g -O1" +[profiles.debug.gfortran.windows] +flags="/g /O1" + [dependencies] "d11" = {path = "../d11"} "d12" = {path = "../d12"} diff --git a/example_packages/profiles_priorities/d11/fpm.toml b/example_packages/profiles_priorities/d11/fpm.toml index de5049fc4b..b7dab8ae52 100644 --- a/example_packages/profiles_priorities/d11/fpm.toml +++ b/example_packages/profiles_priorities/d11/fpm.toml @@ -8,5 +8,8 @@ name="d11" source-dir="app" main="d11.f90" -[profiles.debug.gfortran.linux] +[profiles.debug.gfortran] flags="-g -O2" + +[profiles.debug.gfortran.windows] +flags="/g /O2" diff --git a/example_packages/profiles_priorities/d21/fpm.toml b/example_packages/profiles_priorities/d21/fpm.toml index 4bc9e3a58d..e651b4a92b 100644 --- a/example_packages/profiles_priorities/d21/fpm.toml +++ b/example_packages/profiles_priorities/d21/fpm.toml @@ -8,6 +8,9 @@ name="d21" source-dir="app" main="d21.f90" -[profiles.debug.gfortran.linux] +[profiles.debug.gfortran] flags="-g -O2" +[profiles.debug.gfortran.windows] +flags="/g /O2" + diff --git a/example_packages/profiles_priorities/main_package/fpm.toml b/example_packages/profiles_priorities/main_package/fpm.toml index 948d335fe1..d39a62bf37 100644 --- a/example_packages/profiles_priorities/main_package/fpm.toml +++ b/example_packages/profiles_priorities/main_package/fpm.toml @@ -1,8 +1,11 @@ name = "main_package" -[profiles.debug.gfortran.linux] +[profiles.debug.gfortran] flags="-g" +[profiles.debug.gfortran.windows] +flags="/g" + [dependencies] "d1" = {path = "../d1"} "d2" = {path = "../d2"} diff --git a/example_packages/profiles_priorities/main_package/log_1.txt b/example_packages/profiles_priorities/main_package/log_1.txt new file mode 100644 index 0000000000..4a56f682fb --- /dev/null +++ b/example_packages/profiles_priorities/main_package/log_1.txt @@ -0,0 +1,7 @@ +d11_m.f90 -g -O2 +d12_m.f90 -g -O1 +d21_m.f90 -g -O2 +d22_m.f90 -g +d1_m.f90 -g -O1 +d2_m.f90 -g +main.f90 -g diff --git a/manifest-reference.md b/manifest-reference.md index c23ec3f120..f89fb38fce 100644 --- a/manifest-reference.md +++ b/manifest-reference.md @@ -484,7 +484,7 @@ Compiler flags profiles can be declared in the *profiles* table. They are organi - "ifort" - "ifx" - "pgfortran" - - "nvfrotran" + - "nvfortran" - "flang" - "caf" - "f95" @@ -503,7 +503,6 @@ Compiler flags profiles can be declared in the *profiles* table. They are organi - "freebsd" - "openbsd" - "unknown" - - "UNKNOWN" There are 4 fields that can be specified for each of the profiles: - `'flags'` - Fortran compiler flags diff --git a/src/fpm/dependency.f90 b/src/fpm/dependency.f90 index 1ae98d00a1..dd87178d7f 100644 --- a/src/fpm/dependency.f90 +++ b/src/fpm/dependency.f90 @@ -383,9 +383,11 @@ subroutine add_dependency(self, dependency, error, parent) !> Name of parent package character(len=*), intent(in), optional :: parent - integer :: id, i, parent_id=0 - logical :: found = .false. + integer :: id, i, parent_id + logical :: found + parent_id = 0 + found = .false. if (present(parent)) then parent_id = self%find(parent) if (parent_id < 1) call fpm_stop(1,'*add_dependency*:Error: No such package in dependency tree.') @@ -793,7 +795,7 @@ subroutine dump_to_toml(self, table, error) !> Error handling type(error_t), allocatable, intent(out) :: error - integer :: ii, iii + integer :: ii, ip type(toml_table), pointer :: ptr type(toml_array), pointer :: parent_ptr character(len=:), allocatable :: proj_dir @@ -821,8 +823,8 @@ subroutine dump_to_toml(self, table, error) end if if (allocated(dep%parent) .and. size(dep%parent) > 0) then call add_array(ptr, "parent", parent_ptr) - do iii=1,size(dep%parent) - call set_value(parent_ptr, iii, self%dep(dep%parent(iii))%name) + do ip=1,size(dep%parent) + call set_value(parent_ptr, ip, self%dep(dep%parent(ip))%name) end do end if end associate diff --git a/src/fpm/manifest/profiles.f90 b/src/fpm/manifest/profiles.f90 index 8c1bd7afdf..3f16ca7dd4 100644 --- a/src/fpm/manifest/profiles.f90 +++ b/src/fpm/manifest/profiles.f90 @@ -7,7 +7,7 @@ !> - "ifort" !> - "ifx" !> - "pgfortran" -!> - "nvfrotran" +!> - "nvfortran" !> - "flang" !> - "caf" !> - "f95" @@ -27,7 +27,6 @@ !> - "freebsd" !> - "openbsd" !> - "unknown" -!> - "UNKNOWN" !> !> Each of the subtables currently supports the following fields: !>```toml @@ -168,7 +167,7 @@ subroutine validate_compiler_name(compiler_name, is_valid) !> Boolean value of whether compiler_name is valid or not logical, intent(out) :: is_valid select case(compiler_name) - case("gfortran", "ifort", "ifx", "pgfortran", "nvfrotran", "flang", "caf", & + case("gfortran", "ifort", "ifx", "pgfortran", "nvfortran", "flang", "caf", & & "f95", "lfortran", "lfc", "nagfor", "crayftn", "xlf90", "ftn95") is_valid = .true. case default @@ -187,7 +186,7 @@ subroutine validate_os_name(os_name, is_valid) select case (os_name) case ("linux", "macos", "windows", "cygwin", "solaris", "freebsd", & - & "openbsd", "unknown", "UNKNOWN") + & "openbsd", "unknown") is_valid = .true. case default is_valid = .false. From 981df565391989224a43842f21fd594c126c5478 Mon Sep 17 00:00:00 2001 From: kubajj Date: Sat, 31 Jul 2021 19:51:37 +0200 Subject: [PATCH 19/32] Update ci test for windows --- ci/run_tests.sh | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/ci/run_tests.sh b/ci/run_tests.sh index bb943a915a..6eb1ac2e1f 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -120,9 +120,11 @@ popd pushd "profiles_priorities/main_package" rm -rf build -"$fpm" build | sed -n 's,^.*/\([^/ ]*\.f90 .*\) -J .*$,\1,p' > log_1.txt -cat log_1.txt -cat log_1.txt | sed 's,/,-,g' | sort > log.txt +if [ `uname -s` = "Windows" ]; then + "$fpm" build | sed -n 's,^.*\\\([^\\ ]*\.f90 .*\) -J .*$,\1,p' | sort > log.txt +else + "$fpm" build | sed -n 's,^.*/\([^/ ]*\.f90 .*\) -J .*$,\1,p' | sort > log.txt +fi cmp log.txt correct_log.txt rm log.txt popd From 1e82f4ee88ea4548e41fda9635fb6e444b9c6d75 Mon Sep 17 00:00:00 2001 From: kubajj Date: Sat, 31 Jul 2021 20:47:25 +0200 Subject: [PATCH 20/32] Update profiles priorities test to use proprocessor --- ci/run_tests.sh | 9 ++------- example_packages/profiles_priorities/d1/fpm.toml | 6 +++--- .../profiles_priorities/d1/source/{d1_m.f90 => d1_m.F90} | 1 + example_packages/profiles_priorities/d11/fpm.toml | 6 +++--- .../d11/source/{d11_m.f90 => d11_m.F90} | 1 + example_packages/profiles_priorities/d12/fpm.toml | 2 +- .../d12/source/{d12_m.f90 => d12_m.F90} | 1 + example_packages/profiles_priorities/d2/fpm.toml | 2 +- .../profiles_priorities/d2/source/{d2_m.f90 => d2_m.F90} | 1 + example_packages/profiles_priorities/d21/fpm.toml | 6 +++--- .../d21/source/{d21_m.f90 => d21_m.F90} | 1 + example_packages/profiles_priorities/d22/fpm.toml | 2 +- .../d22/source/{d22_m.f90 => d22_m.F90} | 1 + .../profiles_priorities/main_package/app/main.f90 | 1 + .../profiles_priorities/main_package/correct_log.txt | 7 ------- .../profiles_priorities/main_package/fpm.toml | 4 ++-- .../profiles_priorities/main_package/log_1.txt | 7 ------- 17 files changed, 23 insertions(+), 35 deletions(-) rename example_packages/profiles_priorities/d1/source/{d1_m.f90 => d1_m.F90} (88%) rename example_packages/profiles_priorities/d11/source/{d11_m.f90 => d11_m.F90} (89%) rename example_packages/profiles_priorities/d12/source/{d12_m.f90 => d12_m.F90} (89%) rename example_packages/profiles_priorities/d2/source/{d2_m.f90 => d2_m.F90} (91%) rename example_packages/profiles_priorities/d21/source/{d21_m.f90 => d21_m.F90} (86%) rename example_packages/profiles_priorities/d22/source/{d22_m.f90 => d22_m.F90} (88%) delete mode 100644 example_packages/profiles_priorities/main_package/correct_log.txt delete mode 100644 example_packages/profiles_priorities/main_package/log_1.txt diff --git a/ci/run_tests.sh b/ci/run_tests.sh index 6eb1ac2e1f..37decd3ab5 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -120,13 +120,8 @@ popd pushd "profiles_priorities/main_package" rm -rf build -if [ `uname -s` = "Windows" ]; then - "$fpm" build | sed -n 's,^.*\\\([^\\ ]*\.f90 .*\) -J .*$,\1,p' | sort > log.txt -else - "$fpm" build | sed -n 's,^.*/\([^/ ]*\.f90 .*\) -J .*$,\1,p' | sort > log.txt -fi -cmp log.txt correct_log.txt -rm log.txt +"$fpm" build +"$fpm" run popd # Cleanup diff --git a/example_packages/profiles_priorities/d1/fpm.toml b/example_packages/profiles_priorities/d1/fpm.toml index a19e011a2f..0309566754 100644 --- a/example_packages/profiles_priorities/d1/fpm.toml +++ b/example_packages/profiles_priorities/d1/fpm.toml @@ -6,13 +6,13 @@ source-dir="source" [[executable]] name="d1" source-dir="app" -main="d1.f90" +main="d1.F90" [profiles.debug.gfortran] -flags="-g -O1" +flags="-g -O1 -Dnot_defined=3" [profiles.debug.gfortran.windows] -flags="/g /O1" +flags="/g /O1 /Dnot_defined=3" [dependencies] "d11" = {path = "../d11"} diff --git a/example_packages/profiles_priorities/d1/source/d1_m.f90 b/example_packages/profiles_priorities/d1/source/d1_m.F90 similarity index 88% rename from example_packages/profiles_priorities/d1/source/d1_m.f90 rename to example_packages/profiles_priorities/d1/source/d1_m.F90 index e2cc563eaa..f180f9bb89 100644 --- a/example_packages/profiles_priorities/d1/source/d1_m.f90 +++ b/example_packages/profiles_priorities/d1/source/d1_m.F90 @@ -6,6 +6,7 @@ module d1_m public :: say_hi contains subroutine say_hi() + if (not_defined /= 3) stop print *, create_greeting("hello"), get_name("developer","fpm") end subroutine say_hi end module d1_m diff --git a/example_packages/profiles_priorities/d11/fpm.toml b/example_packages/profiles_priorities/d11/fpm.toml index b7dab8ae52..a828b9ef4b 100644 --- a/example_packages/profiles_priorities/d11/fpm.toml +++ b/example_packages/profiles_priorities/d11/fpm.toml @@ -6,10 +6,10 @@ source-dir="source" [[executable]] name="d11" source-dir="app" -main="d11.f90" +main="d11.F90" [profiles.debug.gfortran] -flags="-g -O2" +flags="-g -O2 -Dnot_defined=4" [profiles.debug.gfortran.windows] -flags="/g /O2" +flags="/g /O2 /Dnot_defined=4" diff --git a/example_packages/profiles_priorities/d11/source/d11_m.f90 b/example_packages/profiles_priorities/d11/source/d11_m.F90 similarity index 89% rename from example_packages/profiles_priorities/d11/source/d11_m.f90 rename to example_packages/profiles_priorities/d11/source/d11_m.F90 index 37508b5fe5..9e3c9adc32 100644 --- a/example_packages/profiles_priorities/d11/source/d11_m.f90 +++ b/example_packages/profiles_priorities/d11/source/d11_m.F90 @@ -7,6 +7,7 @@ function create_greeting(greeting) result(created) character(len=*), intent(in) :: greeting character(len=:), allocatable :: created + if (not_defined /= 4) stop created = greeting // " " end function create_greeting end module d11_m diff --git a/example_packages/profiles_priorities/d12/fpm.toml b/example_packages/profiles_priorities/d12/fpm.toml index 654141deff..c931545731 100644 --- a/example_packages/profiles_priorities/d12/fpm.toml +++ b/example_packages/profiles_priorities/d12/fpm.toml @@ -6,5 +6,5 @@ source-dir="source" [[executable]] name="d12" source-dir="app" -main="d12.f90" +main="d12.F90" diff --git a/example_packages/profiles_priorities/d12/source/d12_m.f90 b/example_packages/profiles_priorities/d12/source/d12_m.F90 similarity index 89% rename from example_packages/profiles_priorities/d12/source/d12_m.f90 rename to example_packages/profiles_priorities/d12/source/d12_m.F90 index af5d29fff8..6fa4e1d8df 100644 --- a/example_packages/profiles_priorities/d12/source/d12_m.f90 +++ b/example_packages/profiles_priorities/d12/source/d12_m.F90 @@ -7,6 +7,7 @@ function get_name(name, surname) result(full_name) character(len=*), intent(in) :: name, surname character(len=:), allocatable :: full_name + if (not_defined /= 3) stop full_name = surname // " " // name end function get_name end module d12_m diff --git a/example_packages/profiles_priorities/d2/fpm.toml b/example_packages/profiles_priorities/d2/fpm.toml index 3f588c7afa..5318afb40e 100644 --- a/example_packages/profiles_priorities/d2/fpm.toml +++ b/example_packages/profiles_priorities/d2/fpm.toml @@ -6,7 +6,7 @@ source-dir="source" [[executable]] name="d2" source-dir="app" -main="d2.f90" +main="d2.F90" [dependencies] "d21" = {path = "../d21"} diff --git a/example_packages/profiles_priorities/d2/source/d2_m.f90 b/example_packages/profiles_priorities/d2/source/d2_m.F90 similarity index 91% rename from example_packages/profiles_priorities/d2/source/d2_m.f90 rename to example_packages/profiles_priorities/d2/source/d2_m.F90 index d16623afb2..41cf5d31dd 100644 --- a/example_packages/profiles_priorities/d2/source/d2_m.f90 +++ b/example_packages/profiles_priorities/d2/source/d2_m.F90 @@ -6,6 +6,7 @@ module d2_m public :: count_to_ten contains subroutine count_to_ten() + if (not_defined /= 1) stop print *,"This is test of counting to ten:" print *,"Iterative version" call count_iter(10) diff --git a/example_packages/profiles_priorities/d21/fpm.toml b/example_packages/profiles_priorities/d21/fpm.toml index e651b4a92b..8353e89bfc 100644 --- a/example_packages/profiles_priorities/d21/fpm.toml +++ b/example_packages/profiles_priorities/d21/fpm.toml @@ -6,11 +6,11 @@ source-dir="source" [[executable]] name="d21" source-dir="app" -main="d21.f90" +main="d21.F90" [profiles.debug.gfortran] -flags="-g -O2" +flags="-g -O2 -Dnot_defined=2" [profiles.debug.gfortran.windows] -flags="/g /O2" +flags="/g /O2 /Dnot_defined=2" diff --git a/example_packages/profiles_priorities/d21/source/d21_m.f90 b/example_packages/profiles_priorities/d21/source/d21_m.F90 similarity index 86% rename from example_packages/profiles_priorities/d21/source/d21_m.f90 rename to example_packages/profiles_priorities/d21/source/d21_m.F90 index 19153b8a4a..d83b3a29f7 100644 --- a/example_packages/profiles_priorities/d21/source/d21_m.f90 +++ b/example_packages/profiles_priorities/d21/source/d21_m.F90 @@ -5,6 +5,7 @@ module d21_m contains subroutine count_iter(n) integer :: n, i + if (not_defined /= 2) stop do i=1,n print *,i end do diff --git a/example_packages/profiles_priorities/d22/fpm.toml b/example_packages/profiles_priorities/d22/fpm.toml index 89e1343b23..9037de63a1 100644 --- a/example_packages/profiles_priorities/d22/fpm.toml +++ b/example_packages/profiles_priorities/d22/fpm.toml @@ -6,5 +6,5 @@ source-dir="source" [[executable]] name="d22" source-dir="app" -main="d22.f90" +main="d22.F90" diff --git a/example_packages/profiles_priorities/d22/source/d22_m.f90 b/example_packages/profiles_priorities/d22/source/d22_m.F90 similarity index 88% rename from example_packages/profiles_priorities/d22/source/d22_m.f90 rename to example_packages/profiles_priorities/d22/source/d22_m.F90 index c20ca27c55..55994ab472 100644 --- a/example_packages/profiles_priorities/d22/source/d22_m.f90 +++ b/example_packages/profiles_priorities/d22/source/d22_m.F90 @@ -5,6 +5,7 @@ module d22_m contains recursive subroutine count_rec(c, n) integer :: c,n + if (not_defined /= 1) stop if (n > 0) then print *,c call count_rec(c+1, n-1) diff --git a/example_packages/profiles_priorities/main_package/app/main.f90 b/example_packages/profiles_priorities/main_package/app/main.f90 index 0086519a82..f27308544e 100644 --- a/example_packages/profiles_priorities/main_package/app/main.f90 +++ b/example_packages/profiles_priorities/main_package/app/main.f90 @@ -2,6 +2,7 @@ program main_package use d1_m, only: say_hi use d2_m, only: count_to_ten + if (not_defined /= 1) stop call say_hi() call count_to_ten() end program main_package diff --git a/example_packages/profiles_priorities/main_package/correct_log.txt b/example_packages/profiles_priorities/main_package/correct_log.txt deleted file mode 100644 index 260ecefd05..0000000000 --- a/example_packages/profiles_priorities/main_package/correct_log.txt +++ /dev/null @@ -1,7 +0,0 @@ -d11_m.f90 -g -O2 -d12_m.f90 -g -O1 -d1_m.f90 -g -O1 -d21_m.f90 -g -O2 -d22_m.f90 -g -d2_m.f90 -g -main.f90 -g diff --git a/example_packages/profiles_priorities/main_package/fpm.toml b/example_packages/profiles_priorities/main_package/fpm.toml index d39a62bf37..6d2a6bc0b8 100644 --- a/example_packages/profiles_priorities/main_package/fpm.toml +++ b/example_packages/profiles_priorities/main_package/fpm.toml @@ -1,10 +1,10 @@ name = "main_package" [profiles.debug.gfortran] -flags="-g" +flags="-g -Dnot_defined=1" [profiles.debug.gfortran.windows] -flags="/g" +flags="/g /Dnot_defined=1" [dependencies] "d1" = {path = "../d1"} diff --git a/example_packages/profiles_priorities/main_package/log_1.txt b/example_packages/profiles_priorities/main_package/log_1.txt deleted file mode 100644 index 4a56f682fb..0000000000 --- a/example_packages/profiles_priorities/main_package/log_1.txt +++ /dev/null @@ -1,7 +0,0 @@ -d11_m.f90 -g -O2 -d12_m.f90 -g -O1 -d21_m.f90 -g -O2 -d22_m.f90 -g -d1_m.f90 -g -O1 -d2_m.f90 -g -main.f90 -g From 20084fedcdc08b81d678871c33e62bc4c90ffc12 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakub=20Jel=C3=ADnek?= <33724536+kubajj@users.noreply.github.com> Date: Sat, 31 Jul 2021 21:23:17 +0200 Subject: [PATCH 21/32] Apply suggestions from code review Co-authored-by: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> --- .../tests/farewell/farewell_test.f90 | 2 +- .../program_with_free_form_in_dot_f/tests/greet/greet_test.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/example_packages/program_with_free_form_in_dot_f/tests/farewell/farewell_test.f90 b/example_packages/program_with_free_form_in_dot_f/tests/farewell/farewell_test.f90 index 0f21b18015..1d619deccb 100644 --- a/example_packages/program_with_free_form_in_dot_f/tests/farewell/farewell_test.f90 +++ b/example_packages/program_with_free_form_in_dot_f/tests/farewell/farewell_test.f90 @@ -13,6 +13,6 @@ program farewell_test write(output_unit, *) "Passed" else write(error_unit, *) "Failed" - call exit(1) + stop 1 end if end program farewell_test diff --git a/example_packages/program_with_free_form_in_dot_f/tests/greet/greet_test.f90 b/example_packages/program_with_free_form_in_dot_f/tests/greet/greet_test.f90 index 41fa50878e..bb5d0f92dd 100644 --- a/example_packages/program_with_free_form_in_dot_f/tests/greet/greet_test.f90 +++ b/example_packages/program_with_free_form_in_dot_f/tests/greet/greet_test.f90 @@ -13,6 +13,6 @@ program greet_test write(output_unit, *) "Passed" else write(error_unit, *) "Failed" - call exit(1) + stop 1 end if end program greet_test From 91323bf71f5a46a3132912639ef9e42cf9a2979f Mon Sep 17 00:00:00 2001 From: kubajj Date: Sat, 31 Jul 2021 21:27:58 +0200 Subject: [PATCH 22/32] Change stop to stop 1 in profiles_priorities example package --- example_packages/profiles_priorities/d1/source/d1_m.F90 | 2 +- example_packages/profiles_priorities/d11/source/d11_m.F90 | 2 +- example_packages/profiles_priorities/d12/source/d12_m.F90 | 2 +- example_packages/profiles_priorities/d2/source/d2_m.F90 | 2 +- example_packages/profiles_priorities/d21/source/d21_m.F90 | 2 +- example_packages/profiles_priorities/d22/source/d22_m.F90 | 2 +- example_packages/profiles_priorities/main_package/app/main.f90 | 2 +- 7 files changed, 7 insertions(+), 7 deletions(-) diff --git a/example_packages/profiles_priorities/d1/source/d1_m.F90 b/example_packages/profiles_priorities/d1/source/d1_m.F90 index f180f9bb89..e4acbad7d5 100644 --- a/example_packages/profiles_priorities/d1/source/d1_m.F90 +++ b/example_packages/profiles_priorities/d1/source/d1_m.F90 @@ -6,7 +6,7 @@ module d1_m public :: say_hi contains subroutine say_hi() - if (not_defined /= 3) stop + if (not_defined /= 3) stop 1 print *, create_greeting("hello"), get_name("developer","fpm") end subroutine say_hi end module d1_m diff --git a/example_packages/profiles_priorities/d11/source/d11_m.F90 b/example_packages/profiles_priorities/d11/source/d11_m.F90 index 9e3c9adc32..64e7b640d8 100644 --- a/example_packages/profiles_priorities/d11/source/d11_m.F90 +++ b/example_packages/profiles_priorities/d11/source/d11_m.F90 @@ -7,7 +7,7 @@ function create_greeting(greeting) result(created) character(len=*), intent(in) :: greeting character(len=:), allocatable :: created - if (not_defined /= 4) stop + if (not_defined /= 4) stop 1 created = greeting // " " end function create_greeting end module d11_m diff --git a/example_packages/profiles_priorities/d12/source/d12_m.F90 b/example_packages/profiles_priorities/d12/source/d12_m.F90 index 6fa4e1d8df..87a1158b44 100644 --- a/example_packages/profiles_priorities/d12/source/d12_m.F90 +++ b/example_packages/profiles_priorities/d12/source/d12_m.F90 @@ -7,7 +7,7 @@ function get_name(name, surname) result(full_name) character(len=*), intent(in) :: name, surname character(len=:), allocatable :: full_name - if (not_defined /= 3) stop + if (not_defined /= 3) stop 1 full_name = surname // " " // name end function get_name end module d12_m diff --git a/example_packages/profiles_priorities/d2/source/d2_m.F90 b/example_packages/profiles_priorities/d2/source/d2_m.F90 index 41cf5d31dd..d385cfcf11 100644 --- a/example_packages/profiles_priorities/d2/source/d2_m.F90 +++ b/example_packages/profiles_priorities/d2/source/d2_m.F90 @@ -6,7 +6,7 @@ module d2_m public :: count_to_ten contains subroutine count_to_ten() - if (not_defined /= 1) stop + if (not_defined /= 1) stop 1 print *,"This is test of counting to ten:" print *,"Iterative version" call count_iter(10) diff --git a/example_packages/profiles_priorities/d21/source/d21_m.F90 b/example_packages/profiles_priorities/d21/source/d21_m.F90 index d83b3a29f7..e9f727185d 100644 --- a/example_packages/profiles_priorities/d21/source/d21_m.F90 +++ b/example_packages/profiles_priorities/d21/source/d21_m.F90 @@ -5,7 +5,7 @@ module d21_m contains subroutine count_iter(n) integer :: n, i - if (not_defined /= 2) stop + if (not_defined /= 2) stop 1 do i=1,n print *,i end do diff --git a/example_packages/profiles_priorities/d22/source/d22_m.F90 b/example_packages/profiles_priorities/d22/source/d22_m.F90 index 55994ab472..fe4b891c5c 100644 --- a/example_packages/profiles_priorities/d22/source/d22_m.F90 +++ b/example_packages/profiles_priorities/d22/source/d22_m.F90 @@ -5,7 +5,7 @@ module d22_m contains recursive subroutine count_rec(c, n) integer :: c,n - if (not_defined /= 1) stop + if (not_defined /= 1) stop 1 if (n > 0) then print *,c call count_rec(c+1, n-1) diff --git a/example_packages/profiles_priorities/main_package/app/main.f90 b/example_packages/profiles_priorities/main_package/app/main.f90 index f27308544e..6b10b6d514 100644 --- a/example_packages/profiles_priorities/main_package/app/main.f90 +++ b/example_packages/profiles_priorities/main_package/app/main.f90 @@ -2,7 +2,7 @@ program main_package use d1_m, only: say_hi use d2_m, only: count_to_ten - if (not_defined /= 1) stop + if (not_defined /= 1) stop 1 call say_hi() call count_to_ten() end program main_package From 269416a285b08fa3a979d09897f88bbbcc763f70 Mon Sep 17 00:00:00 2001 From: kubajj Date: Sat, 31 Jul 2021 21:31:08 +0200 Subject: [PATCH 23/32] Prevent main package in profiles priorities from failing due to not being preprocessed --- ci/run_tests.sh | 1 - example_packages/profiles_priorities/main_package/app/main.f90 | 1 - 2 files changed, 2 deletions(-) diff --git a/ci/run_tests.sh b/ci/run_tests.sh index 37decd3ab5..5b08cb51bf 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -121,7 +121,6 @@ popd pushd "profiles_priorities/main_package" rm -rf build "$fpm" build -"$fpm" run popd # Cleanup diff --git a/example_packages/profiles_priorities/main_package/app/main.f90 b/example_packages/profiles_priorities/main_package/app/main.f90 index 6b10b6d514..0086519a82 100644 --- a/example_packages/profiles_priorities/main_package/app/main.f90 +++ b/example_packages/profiles_priorities/main_package/app/main.f90 @@ -2,7 +2,6 @@ program main_package use d1_m, only: say_hi use d2_m, only: count_to_ten - if (not_defined /= 1) stop 1 call say_hi() call count_to_ten() end program main_package From ce590825f01b9ab2fee366c36d5931f9f323c356 Mon Sep 17 00:00:00 2001 From: kubajj Date: Mon, 9 Aug 2021 16:28:28 +0200 Subject: [PATCH 24/32] Add comments detailing the functions --- src/fpm.f90 | 9 ++++++--- src/fpm/manifest/profiles.f90 | 2 ++ 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 2dbf7444fa..355be57338 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -9,8 +9,6 @@ module fpm use fpm_model use fpm_compiler, only: get_module_flags, is_unknown_compiler, get_default_c_compiler, & get_archiver - - use fpm_sources, only: add_executable_sources, add_sources_from_dir use fpm_targets, only: targets_from_sources, resolve_module_dependencies, & resolve_target_linking, build_target_t, build_target_ptr, & @@ -204,6 +202,7 @@ subroutine build_model(model, settings, package, error) profile = settings%profile endif + ! Choose profile for each package if (allocated(profile)) then do i=1,size(model%packages) model%packages(i)%chosen_profile = look_for_profile(i) @@ -220,10 +219,10 @@ subroutine build_model(model, settings, package, error) "Defaults for this compiler might be incorrect" end if + ! Choose profiles flags or file specific flags do j=1,size(model%packages) associate(package=>model%packages(j), sources=>model%packages(j)%sources, profile=>model%packages(j)%chosen_profile) do i=1,size(sources) - select case (sources(i)%unit_type) case (FPM_UNIT_MODULE,FPM_UNIT_SUBMODULE,FPM_UNIT_SUBPROGRAM,FPM_UNIT_CSOURCE) file_scope_flag = get_file_scope_flags(sources(i), profile) @@ -255,6 +254,10 @@ subroutine build_model(model, settings, package, error) contains + ! Look for an appropriate profile + ! If package has specified profile, return it + ! If it has just built-in profile, try to find specified one in parents, otherwise return it + ! If it has no profiles, try to find one in parents function look_for_profile(package_id) result (chosen_profile) integer, intent(in) :: package_id diff --git a/src/fpm/manifest/profiles.f90 b/src/fpm/manifest/profiles.f90 index 3f16ca7dd4..cb3d7b304f 100644 --- a/src/fpm/manifest/profiles.f90 +++ b/src/fpm/manifest/profiles.f90 @@ -744,6 +744,7 @@ subroutine find_profile(profiles, profile_name, compiler, os_type, found_matchin found_matching = .false. if (size(profiles) < 1) return + ! Try to find profile with matching OS type do i=1,size(profiles) curr_profile_name = profiles(i)%profile_name curr_compiler = profiles(i)%compiler @@ -757,6 +758,7 @@ subroutine find_profile(profiles, profile_name, compiler, os_type, found_matchin end if end if end do + ! Try to find profile with OS type 'all' if (.not. found_matching) then do i=1,size(profiles) curr_profile_name = profiles(i)%profile_name From 794cd8589ffe8300b9cd47d1d691758b4caeac5e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakub=20Jel=C3=ADnek?= <33724536+kubajj@users.noreply.github.com> Date: Mon, 9 Aug 2021 22:54:00 +0200 Subject: [PATCH 25/32] Apply suggestions from code review Co-authored-by: Brad Richardson --- manifest-reference.md | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/manifest-reference.md b/manifest-reference.md index 9e7ee1b118..407fa8bd11 100644 --- a/manifest-reference.md +++ b/manifest-reference.md @@ -526,9 +526,8 @@ Both profile name and operating system subtables can be omitted in the definitio Example: - The flags field of the following profile is appended to flags fields of all profiles using `gfortran` on `linux` OS ```toml -[profiles.linux] +[profiles.gfortran.linux] flags = '-g -Wall' -``` ### Compiler flags profiles - Hierarchy There are 18 built-in profiles which are implemented in `fpm_manifest_profiles.f90`. They should cover the most used cases. If user wishes to specify their own profiles @@ -537,8 +536,8 @@ such profiles have priority over the built-in ones. This priority can be propaga Example: In `example_packages/profiles_priorities`, there are 7 packages in total. The main package is called `main_package` and uses `d1` and `d2`. `d1` uses `d11` and `d12` and similarly for `d2`. -The compiler flags degined in these packages are following: -| Package | Flags | Flags with priorities | +The compiler flags defined in these packages are as follows: +| Package | Flags specified | Flags used | |---|:---:|:---:| | `main_package` | `-g` | `-g` | | `d1` | `-g -O1` | `-g -O1` | From a3978b8a29228cf70d907c84c60fbfc6595afcea Mon Sep 17 00:00:00 2001 From: kubajj Date: Mon, 9 Aug 2021 22:55:21 +0200 Subject: [PATCH 26/32] Make new_dependency_node pure --- src/fpm/dependency.f90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/fpm/dependency.f90 b/src/fpm/dependency.f90 index dd87178d7f..7c1394562c 100644 --- a/src/fpm/dependency.f90 +++ b/src/fpm/dependency.f90 @@ -194,8 +194,7 @@ subroutine new_dependency_tree(self, verbosity, cache) end subroutine new_dependency_tree !> Create a new dependency node from a configuration -! pure subroutine new_dependency_node(self, dependency, version, proj_dir, update, parent) - subroutine new_dependency_node(self, dependency, version, proj_dir, update, parent) + pure subroutine new_dependency_node(self, dependency, version, proj_dir, update, parent) !> Instance of the dependency node type(dependency_node_t), intent(out) :: self !> Dependency configuration data From e642a1448471a817f82510e87211f71a1ed5d5a3 Mon Sep 17 00:00:00 2001 From: kubajj Date: Mon, 9 Aug 2021 23:12:19 +0200 Subject: [PATCH 27/32] Make get_default_profiles neater --- src/fpm/manifest/profiles.f90 | 139 ++++++++++++++++++++++++---------- 1 file changed, 98 insertions(+), 41 deletions(-) diff --git a/src/fpm/manifest/profiles.f90 b/src/fpm/manifest/profiles.f90 index cb3d7b304f..bdc114e410 100644 --- a/src/fpm/manifest/profiles.f90 +++ b/src/fpm/manifest/profiles.f90 @@ -584,47 +584,104 @@ function get_default_profiles(error) result(default_profiles) type(profile_config_t), allocatable :: default_profiles(:) default_profiles = [ & - & new_profile('release', 'caf', OS_ALL, flags=' -O3 -Wimplicit-interface& - & -fPIC -fmax-errors=1 -funroll-loops', is_built_in=.true.), & - & new_profile('release', 'gfortran', OS_ALL, flags=' -O3 -Wimplicit-interface -fPIC& - & -fmax-errors=1 -funroll-loops -fcoarray=single', is_built_in=.true.), & - & new_profile('release', 'f95', OS_ALL, flags=' -O3 -Wimplicit-interface -fPIC& - & -fmax-errors=1 -ffast-math -funroll-loops', is_built_in=.true.), & - & new_profile('release', 'nvfortran', OS_ALL, flags = ' -Mbackslash', is_built_in=.true.), & - & new_profile('release', 'ifort', OS_ALL, flags = ' -fp-model precise -pc64 -align all& - & -error-limit 1 -reentrancy threaded& - & -nogen-interfaces -assume byterecl', is_built_in=.true.), & - & new_profile('release', 'ifort', OS_WINDOWS, flags = ' /fp:precise /align:all& - & /error-limit:1 /reentrancy:threaded& - & /nogen-interfaces /assume:byterecl', is_built_in=.true.), & - & new_profile('release', 'ifx', OS_ALL, flags = ' -fp-model=precise -pc64& - & -align all -error-limit 1 -reentrancy threaded& - & -nogen-interfaces -assume byterecl', is_built_in=.true.), & - & new_profile('release', 'ifx', OS_WINDOWS, flags = ' /fp:precise /align:all& - & /error-limit:1 /reentrancy:threaded& - & /nogen-interfaces /assume:byterecl', is_built_in=.true.), & - & new_profile('release', 'nagfor', OS_ALL, flags = ' -O4 -coarray=single -PIC', is_built_in=.true.), & - & new_profile('debug', 'caf', OS_ALL, flags = ' -Wall -Wextra -Wimplicit-interface& - & -fPIC -fmax-errors=1 -g -fcheck=bounds& - & -fcheck=array-temps -fbacktrace', is_built_in=.true.), & - & new_profile('debug', 'gfortran', OS_ALL, flags = ' -Wall -Wextra -Wimplicit-interface& - & -fPIC -fmax-errors=1 -g -fcheck=bounds& - & -fcheck=array-temps -fbacktrace -fcoarray=single', is_built_in=.true.), & - & new_profile('debug', 'f95', OS_ALL, flags = ' -Wall -Wextra -Wimplicit-interface& - & -fPIC -fmax-errors=1 -g -fcheck=bounds& - & -fcheck=array-temps -Wno-maybe-uninitialized& - & -Wno-uninitialized -fbacktrace', is_built_in=.true.), & - & new_profile('debug', 'nvfortran', OS_ALL, flags = ' -Minform=inform -Mbackslash -g& - & -Mbounds -Mchkptr -Mchkstk -traceback', is_built_in=.true.), & - & new_profile('debug', 'ifort', OS_ALL, flags = ' -warn all -check all -error-limit 1& - & -O0 -g -assume byterecl -traceback', is_built_in=.true.), & - & new_profile('debug', 'ifort', OS_WINDOWS, flags = ' /warn:all /check:all /error-limit:1& - & /Od /Z7 /assume:byterecl /traceback', is_built_in=.true.), & - & new_profile('debug', 'ifx', OS_ALL, flags = ' -warn all -check all -error-limit 1& - & -O0 -g -assume byterecl -traceback', is_built_in=.true.), & - & new_profile('debug', 'ifx', OS_WINDOWS, flags = ' /warn:all /check:all /error-limit:1& - & /Od /Z7 /assume:byterecl', is_built_in=.true.), & - & new_profile('debug', 'nagfor', OS_ALL, flags = ' -g -C=all -O0 -gline -coarray=single -PIC', is_built_in=.true.) & + & new_profile('release', & + & 'caf', & + & OS_ALL, & + & flags=' -O3 -Wimplicit-interface -fPIC -fmax-errors=1 -funroll-loops', & + & is_built_in=.true.), & + & new_profile('release', & + & 'gfortran', & + & OS_ALL, & + & flags=' -O3 -Wimplicit-interface -fPIC -fmax-errors=1 -funroll-loops -fcoarray=single', & + & is_built_in=.true.), & + & new_profile('release', & + & 'f95', & + & OS_ALL, & + & flags=' -O3 -Wimplicit-interface -fPIC -fmax-errors=1 -ffast-math -funroll-loops', & + & is_built_in=.true.), & + & new_profile('release', & + & 'nvfortran', & + & OS_ALL, & + & flags = ' -Mbackslash', & + & is_built_in=.true.), & + & new_profile('release', & + & 'ifort', & + & OS_ALL, & + & flags = ' -fp-model precise -pc64 -align all -error-limit 1 -reentrancy& + & threaded -nogen-interfaces -assume byterecl', & + & is_built_in=.true.), & + & new_profile('release', & + & 'ifort', & + & OS_WINDOWS, & + & flags = ' /fp:precise /align:all /error-limit:1 /reentrancy:threaded& + & /nogen-interfaces /assume:byterecl', & + & is_built_in=.true.), & + & new_profile('release', & + & 'ifx', & + & OS_ALL, & + & flags = ' -fp-model=precise -pc64 -align all -error-limit 1 -reentrancy& + & threaded -nogen-interfaces -assume byterecl', & + & is_built_in=.true.), & + & new_profile('release', & + & 'ifx', & + & OS_WINDOWS, & + & flags = ' /fp:precise /align:all /error-limit:1 /reentrancy:threaded& + & /nogen-interfaces /assume:byterecl', & + & is_built_in=.true.), & + & new_profile('release', & + &'nagfor', & + & OS_ALL, & + & flags = ' -O4 -coarray=single -PIC', & + & is_built_in=.true.), & + & new_profile('debug', & + & 'caf', & + & OS_ALL, & + & flags = ' -Wall -Wextra -Wimplicit-interface -fPIC -fmax-errors=1 -g -fcheck=bounds& + & -fcheck=array-temps -fbacktrace', & + & is_built_in=.true.), & + & new_profile('debug', & + & 'gfortran', & + & OS_ALL, & + & flags = ' -Wall -Wextra -Wimplicit-interface -fPIC -fmax-errors=1 -g -fcheck=bounds& + & -fcheck=array-temps -fbacktrace -fcoarray=single', & + & is_built_in=.true.), & + & new_profile('debug', & + & 'f95', & + & OS_ALL, & + & flags = ' -Wall -Wextra -Wimplicit-interface -fPIC -fmax-errors=1 -g -fcheck=bounds& + & -fcheck=array-temps -Wno-maybe-uninitialized -Wno-uninitialized -fbacktrace', & + & is_built_in=.true.), & + & new_profile('debug', & + & 'nvfortran', & + & OS_ALL, & + & flags = ' -Minform=inform -Mbackslash -g -Mbounds -Mchkptr -Mchkstk -traceback', & + & is_built_in=.true.), & + & new_profile('debug', & + & 'ifort', & + & OS_ALL, & + & flags = ' -warn all -check all -error-limit 1 -O0 -g -assume byterecl -traceback', & + & is_built_in=.true.), & + & new_profile('debug', & + & 'ifort', & + & OS_WINDOWS, & + & flags = ' /warn:all /check:all /error-limit:1& + & /Od /Z7 /assume:byterecl /traceback', & + & is_built_in=.true.), & + & new_profile('debug', & + & 'ifx', & + & OS_ALL, & + & flags = ' -warn all -check all -error-limit 1 -O0 -g -assume byterecl -traceback', & + & is_built_in=.true.), & + & new_profile('debug', & + & 'ifx', & + & OS_WINDOWS, & + & flags = ' /warn:all /check:all /error-limit:1 /Od /Z7 /assume:byterecl', & + & is_built_in=.true.), & + & new_profile('debug', & + & 'nagfor', & + & OS_ALL, & + & flags = ' -g -C=all -O0 -gline -coarray=single -PIC', & + & is_built_in=.true.) & &] end function get_default_profiles From 09e5b97b6e1d73bc7f4878cac7f23a3d9f2f357c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakub=20Jel=C3=ADnek?= <33724536+kubajj@users.noreply.github.com> Date: Tue, 10 Aug 2021 12:03:52 +0200 Subject: [PATCH 28/32] Apply some suggestions from code review Co-authored-by: Laurence Kedward --- src/fpm.f90 | 1 + src/fpm_backend.f90 | 10 +++++----- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 355be57338..afea2da031 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -318,6 +318,7 @@ function get_file_scope_flags(source, profile) result(file_scope_flag) do i=1,size(fflags) if (source%file_name.eq.fflags(i)%file_name) then file_scope_flag = fflags(i)%flags//" " + exit end if end do end associate diff --git a/src/fpm_backend.f90 b/src/fpm_backend.f90 index 7469d179c9..1422809955 100644 --- a/src/fpm_backend.f90 +++ b/src/fpm_backend.f90 @@ -71,11 +71,11 @@ subroutine build_package(targets,model,build_dirs) end do end if if (present(build_dirs)) then - if (allocated(build_dirs)) then - do i=1,size(build_dirs) - call mkdir(build_dirs(i)%s) - end do - end if + if (allocated(build_dirs)) then + do i=1,size(build_dirs) + call mkdir(build_dirs(i)%s) + end do + end if end if ! Initialise build status flags allocate(stat(size(queue))) From 7d09b4ffdd2bd7b85ced56d913d72db55e445ee5 Mon Sep 17 00:00:00 2001 From: kubajj Date: Tue, 10 Aug 2021 12:45:56 +0200 Subject: [PATCH 29/32] Extend subroutine get_object_name --- src/fpm.f90 | 22 ++++------- src/fpm_targets.f90 | 95 +++++++++++++++++++++++++-------------------- 2 files changed, 59 insertions(+), 58 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 355be57338..b6c3b76c76 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -224,29 +224,21 @@ subroutine build_model(model, settings, package, error) associate(package=>model%packages(j), sources=>model%packages(j)%sources, profile=>model%packages(j)%chosen_profile) do i=1,size(sources) select case (sources(i)%unit_type) - case (FPM_UNIT_MODULE,FPM_UNIT_SUBMODULE,FPM_UNIT_SUBPROGRAM,FPM_UNIT_CSOURCE) + case (FPM_UNIT_MODULE,FPM_UNIT_SUBMODULE,FPM_UNIT_SUBPROGRAM,FPM_UNIT_CSOURCE,FPM_UNIT_PROGRAM) file_scope_flag = get_file_scope_flags(sources(i), profile) - if (sources(i)%unit_type.eq.FPM_UNIT_CSOURCE) then - if (file_scope_flag.eq."") then + if (file_scope_flag.eq."") then + if (sources(i)%unit_type.eq.FPM_UNIT_CSOURCE) then sources(i)%flags=model%cmd_compile_flags//" "//profile%c_flags else - sources(i)%flags=model%cmd_compile_flags//" "//file_scope_flag - end if - else - if (file_scope_flag.eq."") then sources(i)%flags=model%cmd_compile_flags//" "//profile%flags - else - sources(i)%flags=model%cmd_compile_flags//" "//file_scope_flag end if - end if - case (FPM_UNIT_PROGRAM) - file_scope_flag = get_file_scope_flags(sources(i), profile) - if (file_scope_flag.eq."") then - sources(i)%flags=model%cmd_compile_flags//" "//profile%flags else sources(i)%flags=model%cmd_compile_flags//" "//file_scope_flag end if - sources(i)%link_time_flags=profile%link_time_flags + + if (sources(i)%unit_type == FPM_UNIT_PROGRAM) then + sources(i)%link_time_flags=profile%link_time_flags + end if end select end do end associate diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index 57796431a2..73d337910b 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -171,8 +171,7 @@ subroutine build_target_list(targets,model, build_dirs) type(string_t), allocatable, intent(out) :: build_dirs(:) integer :: i, j, n_source - character(:), allocatable :: xsuffix, exe_dir, flags_for_archive, output_file, module_flags - character(len=16) :: build_name + character(:), allocatable :: xsuffix, exe_dir, output_file, module_flags type(build_target_t), pointer :: dep logical :: with_lib @@ -197,15 +196,9 @@ subroutine build_target_list(targets,model, build_dirs) j=1,size(model%packages))]) if (with_lib) then - if (allocated(model%packages(1)%profiles)) then - flags_for_archive = model%cmd_compile_flags//" "//model%packages(1)%chosen_profile%flags - else - flags_for_archive = model%cmd_compile_flags - end if - write(build_name, '(z16.16)') fnv_1a(flags_for_archive) + call get_object_name(output_file, unit_type=FPM_TARGET_ARCHIVE) call add_target(targets,type = FPM_TARGET_ARCHIVE,& - output_file = join_path('build',basename(model%fortran_compiler)//'_'// & - & build_name, model%package_name, 'lib'//model%package_name//'.a')) + output_file = output_file) end if do j=1,size(model%packages) @@ -215,7 +208,7 @@ subroutine build_target_list(targets,model, build_dirs) select case (sources(i)%unit_type) case (FPM_UNIT_MODULE,FPM_UNIT_SUBMODULE,FPM_UNIT_SUBPROGRAM,FPM_UNIT_CSOURCE) - call get_object_name(sources(i), output_file, module_flags) + call get_object_name(output_file, module_flags=module_flags, source=sources(i)) call add_target(targets,source = sources(i), & type = merge(FPM_TARGET_C_OBJECT,FPM_TARGET_OBJECT,& sources(i)%unit_type==FPM_UNIT_CSOURCE), & @@ -228,31 +221,16 @@ subroutine build_target_list(targets,model, build_dirs) case (FPM_UNIT_PROGRAM) - call get_object_name(sources(i), output_file, module_flags) + call get_object_name(output_file, module_flags=module_flags, source=sources(i)) call add_target(targets,type = FPM_TARGET_OBJECT,& output_file = output_file, & source = sources(i), & - module_flags = module_flags & - ) - - if (sources(i)%unit_scope == FPM_SCOPE_APP) then - - exe_dir = 'app' - - else if (sources(i)%unit_scope == FPM_SCOPE_EXAMPLE) then - - exe_dir = 'example' - - else - - exe_dir = 'test' - - end if + module_flags = module_flags) + call get_object_name(output_file, source=sources(i), unit_type=FPM_TARGET_EXECUTABLE) call add_target(targets,type = FPM_TARGET_EXECUTABLE,& link_libraries = sources(i)%link_libraries, & - output_file = join_path(get_output_directory(sources(i)),exe_dir, & - sources(i)%exe_name//xsuffix)) + output_file = output_file) ! Executable depends on object call add_dependency(targets(size(targets))%ptr, targets(size(targets)-1)%ptr) @@ -272,32 +250,63 @@ subroutine build_target_list(targets,model, build_dirs) contains - subroutine get_object_name(source, object_file, module_flags) + subroutine get_object_name(object_file, module_flags, source, unit_type) ! Generate object target path from source name and model params ! ! - type(srcfile_t), intent(in) :: source character(:), allocatable, intent(out) :: object_file - character(:), allocatable, intent(out) :: module_flags + character(:), allocatable, optional, intent(out) :: module_flags + type(srcfile_t), optional, intent(in) :: source + integer, optional, intent(in) :: unit_type integer :: i character(1), parameter :: filesep = '/' - character(:), allocatable :: dir, out_dir + character(:), allocatable :: dir, out_dir, flags_for_archive, exe_dir + character(len=16) :: build_name - object_file = canon_path(source%file_name) + if (.not. present(unit_type) .and. present(source)) then + object_file = canon_path(source%file_name) - out_dir = get_output_directory(source) + out_dir = get_output_directory(source) - call get_module_flags(model%fortran_compiler, out_dir, module_flags) + call get_module_flags(model%fortran_compiler, out_dir, module_flags) - ! Convert any remaining directory separators to underscores - i = index(object_file,filesep) - do while(i > 0) - object_file(i:i) = '_' + ! Convert any remaining directory separators to underscores i = index(object_file,filesep) - end do + do while(i > 0) + object_file(i:i) = '_' + i = index(object_file,filesep) + end do + + object_file = join_path(out_dir,model%package_name, object_file)//'.o' + else + if (unit_type == FPM_TARGET_ARCHIVE) then + + if (allocated(model%packages(1)%profiles)) then + flags_for_archive = model%cmd_compile_flags//" "//model%packages(1)%chosen_profile%flags + else + flags_for_archive = model%cmd_compile_flags + end if + + write(build_name, '(z16.16)') fnv_1a(flags_for_archive) + + object_file = join_path('build',basename(model%fortran_compiler)//'_'// & + & build_name, model%package_name, 'lib'//model%package_name//'.a') - object_file = join_path(out_dir,model%package_name, object_file)//'.o' + else if (unit_type == FPM_TARGET_EXECUTABLE .and. present(source)) then + + if (source%unit_scope == FPM_SCOPE_APP) then + exe_dir = 'app' + else if (source%unit_scope == FPM_SCOPE_EXAMPLE) then + exe_dir = 'example' + else + exe_dir = 'test' + end if + + object_file = join_path(get_output_directory(source),exe_dir, source%exe_name//xsuffix) + end if + + end if end subroutine get_object_name From d708b9462fbc7c8ca59a424e6ba75d0311da743f Mon Sep 17 00:00:00 2001 From: kubajj Date: Tue, 10 Aug 2021 14:10:52 +0200 Subject: [PATCH 30/32] Close code fence and propagate error while reading manifest --- manifest-reference.md | 1 + src/fpm/manifest/profiles.f90 | 4 ++-- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/manifest-reference.md b/manifest-reference.md index 407fa8bd11..5865d95dbe 100644 --- a/manifest-reference.md +++ b/manifest-reference.md @@ -528,6 +528,7 @@ Example: ```toml [profiles.gfortran.linux] flags = '-g -Wall' +``` ### Compiler flags profiles - Hierarchy There are 18 built-in profiles which are implemented in `fpm_manifest_profiles.f90`. They should cover the most used cases. If user wishes to specify their own profiles diff --git a/src/fpm/manifest/profiles.f90 b/src/fpm/manifest/profiles.f90 index bdc114e410..7ab8f26db7 100644 --- a/src/fpm/manifest/profiles.f90 +++ b/src/fpm/manifest/profiles.f90 @@ -364,7 +364,7 @@ subroutine traverse_oss(profile_name, compiler_name, os_list, table, error, prof l_os_name = lower(os_name) call validate_os_name(l_os_name, is_valid) if (is_valid) then - call fpm_stop(1,'*traverse_oss*:Error: Invalid OS name.') + call fatal_error(error,'*traverse_oss*:Error: Invalid OS name.') end if ! Missing OS name @@ -450,7 +450,7 @@ subroutine traverse_compilers(profile_name, comp_list, table, error, profiles_si if (allocated(error)) return end if else - call fpm_stop(1,'*traverse_compilers*:Error: Compiler name not specified or invalid.') + call fatal_error(error,'*traverse_compilers*:Error: Compiler name not specified or invalid.') end if end do end subroutine traverse_compilers From fa52c0abb74edd76fa113a98d6ded535a8f2bd97 Mon Sep 17 00:00:00 2001 From: kubajj Date: Thu, 12 Aug 2021 10:45:21 +0200 Subject: [PATCH 31/32] Cover invalid toml - only supported tables and fields are valid --- src/fpm/manifest/profiles.f90 | 21 +++++++++++++++++---- 1 file changed, 17 insertions(+), 4 deletions(-) diff --git a/src/fpm/manifest/profiles.f90 b/src/fpm/manifest/profiles.f90 index 7ab8f26db7..245154a673 100644 --- a/src/fpm/manifest/profiles.f90 +++ b/src/fpm/manifest/profiles.f90 @@ -218,7 +218,7 @@ end subroutine match_os_type !> Look for flags, c-flags, link-time-flags key-val pairs !> and files table in a given table and create new profiles - subroutine get_flags(profile_name, compiler_name, os_type, key_list, table, profiles, profindex, error) + subroutine get_flags(profile_name, compiler_name, os_type, key_list, table, profiles, profindex, error, os_valid) !> Name of profile character(len=:), allocatable, intent(in) :: profile_name @@ -244,7 +244,10 @@ subroutine get_flags(profile_name, compiler_name, os_type, key_list, table, prof !> Error handling type(error_t), allocatable, intent(out) :: error - character(len=:), allocatable :: flags, c_flags, link_time_flags, key_name, file_name, file_flags + !> Was called with valid operating system + logical, intent(in) :: os_valid + + character(len=:), allocatable :: flags, c_flags, link_time_flags, key_name, file_name, file_flags, err_message type(toml_table), pointer :: files type(toml_key), allocatable :: file_list(:) type(file_scope_flag), allocatable :: file_scope_flags(:) @@ -293,10 +296,19 @@ subroutine get_flags(profile_name, compiler_name, os_type, key_list, table, prof cur_file%flags = file_flags end associate end do + else if (.not. os_valid) then + call validate_os_name(key_name, is_valid) + err_message = "Unnexpected key " // key_name // " found in profile table "//profile_name//" "//compiler_name//"." + if (.not. is_valid) call syntax_error(error, err_message) + else + err_message = "Unnexpected key " // key_name // " found in profile table "//profile_name//" "//compiler_name//"." + call syntax_error(error, err_message) end if end do end if + if (allocated(error)) return + profiles(profindex) = new_profile(profile_name, compiler_name, os_type, & & flags, c_flags, link_time_flags, file_scope_flags) profindex = profindex + 1 @@ -356,7 +368,7 @@ subroutine traverse_oss(profile_name, compiler_name, os_list, table, error, prof end if call match_os_type(os_name, os_type) call os_node%get_keys(key_list) - call get_flags(profile_name, compiler_name, os_type, key_list, os_node, profiles, profindex, error) + call get_flags(profile_name, compiler_name, os_type, key_list, os_node, profiles, profindex, error, .true.) if (allocated(error)) return end if else @@ -366,6 +378,7 @@ subroutine traverse_oss(profile_name, compiler_name, os_list, table, error, prof if (is_valid) then call fatal_error(error,'*traverse_oss*:Error: Invalid OS name.') end if + if (allocated(error)) return ! Missing OS name is_key_val = .false. @@ -389,7 +402,7 @@ subroutine traverse_oss(profile_name, compiler_name, os_list, table, error, prof end if os_type = OS_ALL os_node=>table - call get_flags(profile_name, compiler_name, os_type, os_list, os_node, profiles, profindex, error) + call get_flags(profile_name, compiler_name, os_type, os_list, os_node, profiles, profindex, error, .false.) if (allocated(error)) return end if end if From 1edf2f1a1d79c5cb4f8f6f012c687861c73b9bb9 Mon Sep 17 00:00:00 2001 From: kubajj Date: Fri, 13 Aug 2021 11:37:02 +0200 Subject: [PATCH 32/32] Last GSoC commit - Separate validation and reading when parsing toml profiles table --- src/fpm/manifest/profiles.f90 | 97 ++++++++++++++++++++++++----------- 1 file changed, 67 insertions(+), 30 deletions(-) diff --git a/src/fpm/manifest/profiles.f90 b/src/fpm/manifest/profiles.f90 index 245154a673..10c3281ed7 100644 --- a/src/fpm/manifest/profiles.f90 +++ b/src/fpm/manifest/profiles.f90 @@ -216,9 +216,7 @@ subroutine match_os_type(os_name, os_type) end subroutine match_os_type - !> Look for flags, c-flags, link-time-flags key-val pairs - !> and files table in a given table and create new profiles - subroutine get_flags(profile_name, compiler_name, os_type, key_list, table, profiles, profindex, error, os_valid) + subroutine validate_profile_table(profile_name, compiler_name, key_list, table, error, os_valid) !> Name of profile character(len=:), allocatable, intent(in) :: profile_name @@ -226,21 +224,12 @@ subroutine get_flags(profile_name, compiler_name, os_type, key_list, table, prof !> Name of compiler character(len=:), allocatable, intent(in) :: compiler_name - !> OS type - integer, intent(in) :: os_type - !> List of keys in the table type(toml_key), allocatable, intent(in) :: key_list(:) !> Table containing OS tables type(toml_table), pointer, intent(in) :: table - !> List of profiles - type(profile_config_t), allocatable, intent(inout) :: profiles(:) - - !> Index in the list of profiles - integer, intent(inout) :: profindex - !> Error handling type(error_t), allocatable, intent(out) :: error @@ -250,7 +239,6 @@ subroutine get_flags(profile_name, compiler_name, os_type, key_list, table, prof character(len=:), allocatable :: flags, c_flags, link_time_flags, key_name, file_name, file_flags, err_message type(toml_table), pointer :: files type(toml_key), allocatable :: file_list(:) - type(file_scope_flag), allocatable :: file_scope_flags(:) integer :: ikey, ifile, stat logical :: is_valid @@ -282,7 +270,6 @@ subroutine get_flags(profile_name, compiler_name, os_type, key_list, table, prof return end if call files%get_keys(file_list) - allocate(file_scope_flags(size(file_list))) do ifile=1,size(file_list) file_name = file_list(ifile)%key call get_value(files, file_name, file_flags, stat=stat) @@ -290,11 +277,6 @@ subroutine get_flags(profile_name, compiler_name, os_type, key_list, table, prof call syntax_error(error, "file scope flags has to be a key-value pair") return end if - associate(cur_file=>file_scope_flags(ifile)) - if (.not.(path.eq."")) file_name = join_path(path, file_name) - cur_file%file_name = file_name - cur_file%flags = file_flags - end associate end do else if (.not. os_valid) then call validate_os_name(key_name, is_valid) @@ -309,6 +291,61 @@ subroutine get_flags(profile_name, compiler_name, os_type, key_list, table, prof if (allocated(error)) return + end subroutine validate_profile_table + + !> Look for flags, c-flags, link-time-flags key-val pairs + !> and files table in a given table and create new profiles + subroutine get_flags(profile_name, compiler_name, os_type, key_list, table, profiles, profindex, os_valid) + + !> Name of profile + character(len=:), allocatable, intent(in) :: profile_name + + !> Name of compiler + character(len=:), allocatable, intent(in) :: compiler_name + + !> OS type + integer, intent(in) :: os_type + + !> List of keys in the table + type(toml_key), allocatable, intent(in) :: key_list(:) + + !> Table containing OS tables + type(toml_table), pointer, intent(in) :: table + + !> List of profiles + type(profile_config_t), allocatable, intent(inout) :: profiles(:) + + !> Index in the list of profiles + integer, intent(inout) :: profindex + + !> Was called with valid operating system + logical, intent(in) :: os_valid + + character(len=:), allocatable :: flags, c_flags, link_time_flags, key_name, file_name, file_flags, err_message + type(toml_table), pointer :: files + type(toml_key), allocatable :: file_list(:) + type(file_scope_flag), allocatable :: file_scope_flags(:) + integer :: ikey, ifile, stat + logical :: is_valid + + call get_value(table, 'flags', flags) + call get_value(table, 'c-flags', c_flags) + call get_value(table, 'link-time-flags', link_time_flags) + call get_value(table, 'files', files) + if (associated(files)) then + call files%get_keys(file_list) + allocate(file_scope_flags(size(file_list))) + do ifile=1,size(file_list) + file_name = file_list(ifile)%key + call get_value(files, file_name, file_flags) + associate(cur_file=>file_scope_flags(ifile)) + if (.not.(path.eq."")) file_name = join_path(path, file_name) + cur_file%file_name = file_name + cur_file%flags = file_flags + end associate + end do + end if + profiles(profindex) = new_profile(profile_name, compiler_name, os_type, & & flags, c_flags, link_time_flags, file_scope_flags) profindex = profindex + 1 @@ -354,22 +391,22 @@ subroutine traverse_oss(profile_name, compiler_name, os_list, table, error, prof os_name = os_list(ios)%key call validate_os_name(os_name, is_valid) if (is_valid) then + call get_value(table, os_name, os_node, stat=stat) + if (stat /= toml_stat%success) then + call syntax_error(error, "os "//os_name//" has to be a table") + return + end if + call os_node%get_keys(key_list) if (present(profiles_size)) then profiles_size = profiles_size + 1 + call validate_profile_table(profile_name, compiler_name, key_list, os_node, error, .true.) else if (.not.(present(profiles).and.present(profindex))) then call fatal_error(error, "Both profiles and profindex have to be present") return end if - call get_value(table, os_name, os_node, stat=stat) - if (stat /= toml_stat%success) then - call syntax_error(error, "os "//os_name//" has to be a table") - return - end if call match_os_type(os_name, os_type) - call os_node%get_keys(key_list) - call get_flags(profile_name, compiler_name, os_type, key_list, os_node, profiles, profindex, error, .true.) - if (allocated(error)) return + call get_flags(profile_name, compiler_name, os_type, key_list, os_node, profiles, profindex, .true.) end if else ! Not lowercase OS name @@ -387,6 +424,7 @@ subroutine traverse_oss(profile_name, compiler_name, os_list, table, error, prof if (stat /= toml_stat%success) then is_key_val = .true. end if + os_node=>table if (present(profiles_size)) then if (is_key_val.and..not.key_val_added) then key_val_added = .true. @@ -395,15 +433,14 @@ subroutine traverse_oss(profile_name, compiler_name, os_list, table, error, prof else if (.not.is_key_val) then profiles_size = profiles_size + 1 end if + call validate_profile_table(profile_name, compiler_name, os_list, os_node, error, .false.) else if (.not.(present(profiles).and.present(profindex))) then call fatal_error(error, "Both profiles and profindex have to be present") return end if os_type = OS_ALL - os_node=>table - call get_flags(profile_name, compiler_name, os_type, os_list, os_node, profiles, profindex, error, .false.) - if (allocated(error)) return + call get_flags(profile_name, compiler_name, os_type, os_list, os_node, profiles, profindex, .false.) end if end if end do