From 48be4a269f6cc5f30ff406c54fe5cefc308bd55d Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 7 Sep 2025 15:24:10 +0200 Subject: [PATCH 01/59] profiles: remove all previous fields; replace with a list of features --- src/fpm/manifest/profiles.f90 | 1026 +++++---------------------------- test/fpm_test/test_toml.f90 | 20 - 2 files changed, 143 insertions(+), 903 deletions(-) diff --git a/src/fpm/manifest/profiles.f90 b/src/fpm/manifest/profiles.f90 index 75f800d94d..bccd6c7c67 100644 --- a/src/fpm/manifest/profiles.f90 +++ b/src/fpm/manifest/profiles.f90 @@ -1,667 +1,155 @@ -!> Implementation of the meta data for compiler flag profiles. +!> Implementation of the profiles configuration. !> -!> 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, omitting it yields an error +!> A profile is a named collection of features that can be applied together. +!> Profiles provide a convenient way to group features for different use cases, +!> such as debug builds, release builds, or specific target configurations. !> -!> - "gfortran" -!> - "ifort" -!> - "ifx" -!> - "pgfortran" -!> - "nvfortran" -!> - "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" -!> -!> Each of the subtables currently supports the following fields: +!> A profile table has the following structure: !>```toml -!>[profiles.debug.gfortran.linux] -!> flags="-Wall -g -Og" -!> c-flags="-g O1" -!> cxx-flags="-g O1" -!> link-time-flags="-xlinkopt" -!> files={"hello_world.f90"="-Wall -O3"} -!>``` +!>[profiles.debug] +!>features = ["debug-flags", "development-tools"] !> +!>[profiles.release] +!>features = ["optimized", "strip-symbols"] +!>``` module fpm_manifest_profile - use fpm_manifest_feature, only: feature_config_t, new_feature, find_feature - use fpm_error, only : error_t, syntax_error, fatal_error, fpm_stop - use tomlf, only : toml_table, toml_key, toml_stat - use fpm_toml, only : get_value, serializable_t, set_value, & - set_string, add_table - use fpm_strings, only: lower - use fpm_manifest_platform, only: platform_config_t - use fpm_environment, only: get_os_type, OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, & - OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD, OS_NAME, OS_ALL, & - validate_os_name, match_os_type - use fpm_compiler, only: compiler_enum, compiler_id_name, match_compiler_type, & - id_unknown, id_gcc, id_f95, id_caf, validate_compiler_name, & - id_intel_classic_nix, id_intel_classic_mac, id_intel_classic_windows, & - id_intel_llvm_nix, id_intel_llvm_windows, id_intel_llvm_unknown, & - id_pgi, id_nvhpc, id_nag, id_flang, id_flang_new, id_f18, & - id_ibmxl, id_cray, id_lahey, id_lfortran, id_all - use fpm_filesystem, only: join_path + use fpm_error, only: error_t, fatal_error, syntax_error + use fpm_strings, only: string_t, operator(==) + use tomlf, only: toml_table, toml_key, toml_stat + use fpm_toml, only: get_value, serializable_t, set_string, set_list, get_list, add_table + implicit none - public :: profile_config_t, new_profile, new_profiles, find_profile, DEFAULT_COMPILER - - !> Name of the default compiler - character(len=*), parameter :: DEFAULT_COMPILER = 'gfortran' - character(len=:), allocatable :: path + private - !> Type storing file name - file scope compiler flags pairs - type, extends(serializable_t) :: file_scope_flag + public :: profile_config_t, new_profile, new_profiles - !> Name of the file - character(len=:), allocatable :: file_name - - !> File scope flags - character(len=:), allocatable :: flags - - contains - - !> Serialization interface - procedure :: serializable_is_same => file_scope_same - procedure :: dump_to_toml => file_scope_dump - procedure :: load_from_toml => file_scope_load - - end type file_scope_flag - - !> Configuration meta data for a profile (now based on features) + !> Configuration data for a profile type, extends(serializable_t) :: profile_config_t - - !> Profile feature - contains all profile configuration - type(feature_config_t) :: profile_feature - !> File scope flags (maintained for backwards compatibility) - type(file_scope_flag), allocatable :: file_scope_flags(:) + !> Profile name + character(len=:), allocatable :: name + + !> List of features to apply + type(string_t), allocatable :: features(:) - contains + contains !> Print information on this instance procedure :: info !> Serialization interface - procedure :: serializable_is_same => profile_same - procedure :: dump_to_toml => profile_dump - procedure :: load_from_toml => profile_load - - !> Convenience accessors for backward compatibility - procedure :: profile_name => get_profile_name - procedure :: compiler => get_profile_compiler - procedure :: os_type => get_profile_os_type - procedure :: flags => get_profile_flags - procedure :: c_flags => get_profile_c_flags - procedure :: cxx_flags => get_profile_cxx_flags - procedure :: link_time_flags => get_profile_link_time_flags - procedure :: is_built_in => get_profile_is_built_in + procedure :: serializable_is_same => profile_is_same + procedure :: dump_to_toml + procedure :: load_from_toml 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, cxx_flags, & - link_time_flags, file_scope_flags, is_built_in) & - & result(profile) - - !> Name of the profile - character(len=*), intent(in) :: profile_name - - !> Name of the compiler - character(len=*), intent(in) :: compiler - - !> Type of the OS - integer, intent(in) :: os_type - - !> Fortran compiler flags - character(len=*), optional, intent(in) :: flags - - !> C compiler flags - character(len=*), optional, intent(in) :: c_flags - - !> C++ compiler flags - character(len=*), optional, intent(in) :: cxx_flags + character(len=*), parameter, private :: class_name = 'profile_config_t' - !> Link time compiler flags - character(len=*), optional, intent(in) :: link_time_flags +contains - !> File scope flags - type(file_scope_flag), optional, intent(in) :: file_scope_flags(:) + !> Construct a new profile configuration from a TOML data structure + subroutine new_profile(self, table, profile_name, error) - !> Is this profile one of the built-in ones? - logical, optional, intent(in) :: is_built_in - - type(profile_config_t) :: profile - integer(compiler_enum) :: compiler_id - - ! Initialize the profile feature - profile%profile_feature%name = profile_name - profile%profile_feature%platform = platform_config_t(compiler, os_type) - if (present(is_built_in)) then - profile%profile_feature%default = is_built_in - else - profile%profile_feature%default = .false. - end if - - ! Set flags - if (present(flags)) then - profile%profile_feature%flags = flags - else - profile%profile_feature%flags = "" - end if - if (present(c_flags)) then - profile%profile_feature%c_flags = c_flags - else - profile%profile_feature%c_flags = "" - end if - if (present(cxx_flags)) then - profile%profile_feature%cxx_flags = cxx_flags - else - profile%profile_feature%cxx_flags = "" - end if - if (present(link_time_flags)) then - profile%profile_feature%link_time_flags = link_time_flags - else - profile%profile_feature%link_time_flags = "" - end if - - ! Set file scope flags (maintained for backward compatibility) - if (present(file_scope_flags)) then - profile%file_scope_flags = file_scope_flags - end if - - end function new_profile - - !> Match lowercase string with name of OS to os_type enum - function os_type_name(os_type) - - !> Name of operating system - character(len=:), allocatable :: os_type_name - - !> Enum representing type of OS - integer, intent(in) :: os_type - - select case (os_type) - case (OS_ALL); os_type_name = "all" - case default; os_type_name = lower(OS_NAME(os_type)) - end select - - end function os_type_name - - subroutine validate_profile_table(profile_name, compiler_name, key_list, table, error, os_valid) - - !> Name of profile - character(len=:), allocatable, intent(in) :: profile_name - - !> Name of compiler - character(len=:), allocatable, intent(in) :: compiler_name + !> Instance of the profile configuration + type(profile_config_t), intent(out) :: self - !> List of keys in the table - type(toml_key), allocatable, intent(in) :: key_list(:) + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table - !> Table containing OS tables - type(toml_table), pointer, intent(in) :: table + !> Name of the profile + character(len=*), intent(in) :: profile_name !> Error handling type(error_t), allocatable, intent(out) :: error - !> Was called with valid operating system - logical, intent(in) :: os_valid - - character(len=:), allocatable :: flags, c_flags, cxx_flags, link_time_flags, key_name, file_name, file_flags, err_message - type(toml_table), pointer :: files - type(toml_key), allocatable :: file_list(:) - 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 - 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 if (key_name.eq.'cxx-flags') then - call get_value(table, 'cxx-flags', cxx_flags, stat=stat) - if (stat /= toml_stat%success) then - call syntax_error(error, "cxx-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) - 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) - 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 - end do - else if (.not. os_valid) then - call validate_os_name(key_name, is_valid) - err_message = "Unexpected key " // key_name // " found in profile table "//profile_name//" "//compiler_name//"." - if (.not. is_valid) call syntax_error(error, err_message) - else - err_message = "Unexpected key " // key_name // " found in profile table "//profile_name//" "//compiler_name//"." - call syntax_error(error, err_message) - end if - end do - end if - + call check(table, error) 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, cxx_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, 'cxx-flags', cxx_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, cxx_flags, link_time_flags, file_scope_flags) - profindex = profindex + 1 - end subroutine get_flags + ! Set profile name + self%name = profile_name - !> Traverse operating system tables to obtain number of profiles - subroutine traverse_oss_for_size(profile_name, compiler_name, os_list, table, profiles_size, error) + ! Get list of features + call get_list(table, "features", self%features, error) + if (allocated(error)) return - !> Name of profile - character(len=:), allocatable, intent(in) :: profile_name + ! If no features specified, initialize empty array + if (.not. allocated(self%features)) then + allocate(self%features(0)) + end if - !> Name of compiler - character(len=:), allocatable, intent(in) :: compiler_name + end subroutine new_profile - !> List of OSs in table with profile name and compiler name given - type(toml_key), allocatable, intent(in) :: os_list(:) + !> Check local schema for allowed entries + subroutine check(table, error) - !> Table containing OS tables - type(toml_table), pointer, intent(in) :: table + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table !> Error handling type(error_t), allocatable, intent(out) :: error - !> Number of profiles in list of profiles - integer, intent(inout) :: profiles_size - - type(toml_key), allocatable :: key_list(:) - character(len=:), allocatable :: os_name, l_os_name - type(toml_table), pointer :: os_node - integer :: ios, stat - 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) - 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) - profiles_size = profiles_size + 1 - call validate_profile_table(profile_name, compiler_name, key_list, os_node, error, .true.) - 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 fatal_error(error,'*traverse_oss*:Error: Name of the operating system must be a lowercase string.') - end if - if (allocated(error)) return - - ! Missing OS name - is_key_val = .false. - os_name = os_list(ios)%key - call get_value(table, os_name, os_node, stat=stat) - if (stat /= toml_stat%success) then - is_key_val = .true. - end if - os_node=>table - 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 - call validate_profile_table(profile_name, compiler_name, os_list, os_node, error, .false.) - end if - end do - end subroutine traverse_oss_for_size - - - !> Traverse operating system tables to obtain profiles - subroutine traverse_oss(profile_name, compiler_name, os_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 - - !> 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 + type(toml_key), allocatable :: list(:) + integer :: ikey - !> List of profiles - type(profile_config_t), allocatable, intent(inout) :: profiles(:) + call table%get_keys(list) - !> Index in the list of profiles - integer, intent(inout) :: profindex + ! Profile table can be empty (no features) + if (size(list) < 1) return - type(toml_key), allocatable :: key_list(:) - character(len=:), allocatable :: os_name, l_os_name - type(toml_table), pointer :: os_node - integer :: ios, stat, os_type - logical :: is_valid, is_key_val + do ikey = 1, size(list) + select case(list(ikey)%key) + case default + call syntax_error(error, "Key "//list(ikey)%key//" is not allowed in profile table") + exit - if (size(os_list)<1) return - do ios = 1, size(os_list) - 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) - os_type = match_os_type(os_name) - call get_flags(profile_name, compiler_name, os_type, key_list, os_node, profiles, profindex, .true.) - 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 fatal_error(error,'*traverse_oss*:Error: Name of the operating system must be a lowercase string.') - end if - if (allocated(error)) return + case("features") + continue - ! Missing OS name - is_key_val = .false. - os_name = os_list(ios)%key - call get_value(table, os_name, os_node, stat=stat) - if (stat /= toml_stat%success) then - is_key_val = .true. - end if - os_node=>table - os_type = OS_ALL - call get_flags(profile_name, compiler_name, os_type, os_list, os_node, profiles, profindex, .false.) - end if + end select end do - end subroutine traverse_oss - !> Traverse compiler tables - subroutine traverse_compilers(profile_name, comp_list, table, error, profiles_size, profiles, profindex) + end subroutine check - !> Name of profile - character(len=:), allocatable, intent(in) :: profile_name + !> Construct new profiles array from a TOML data structure + subroutine new_profiles(profiles, table, error) - !> List of OSs in table with profile name given - type(toml_key), allocatable, intent(in) :: comp_list(:) + !> Instance of the profile configuration array + type(profile_config_t), allocatable, intent(out) :: profiles(:) - !> Table containing compiler tables - type(toml_table), pointer, intent(in) :: table + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table !> Error handling type(error_t), allocatable, intent(out) :: error - !> Number of profiles in list of profiles - integer, intent(inout), optional :: profiles_size + type(toml_table), pointer :: node + type(toml_key), allocatable :: list(:) + integer :: iprofile, stat - !> List of profiles - type(profile_config_t), allocatable, intent(inout), optional :: profiles(:) + call table%get_keys(list) - !> Index in the list of profiles - integer, intent(inout), optional :: profindex + if (size(list) < 1) then + allocate(profiles(0)) + return + end if - character(len=:), allocatable :: compiler_name - type(toml_table), pointer :: comp_node - type(toml_key), allocatable :: os_list(:) - integer :: icomp, stat - logical :: is_valid + allocate(profiles(size(list))) - 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) + do iprofile = 1, size(list) + call get_value(table, list(iprofile)%key, 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_for_size(profile_name, compiler_name, os_list, comp_node, profiles_size, error) - 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, comp_node, & - & profiles, profindex, error) - if (allocated(error)) return - end if - else - call fatal_error(error,'*traverse_compilers*:Error: Compiler name not specified or invalid.') - 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), target, 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(:) - type(toml_key), allocatable :: os_list(:) - character(len=:), allocatable :: profile_name, compiler_name - integer :: profiles_size, iprof, stat, profindex - logical :: is_valid - type(profile_config_t), allocatable :: default_profiles(:) - - path = '' - - ! Default profiles are now features - no longer used - allocate(default_profiles(0)) - 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 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) - if (allocated(error)) return - else - 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_for_size(profile_name, compiler_name, os_list, table, profiles_size, error) - 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") + call fatal_error(error, "Profile "//list(iprofile)%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 - end if - end do - - profiles_size = profiles_size + size(default_profiles) - allocate(profiles(profiles_size)) - - 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 - 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) - if (allocated(error)) return - else - 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, profiles, profindex, error) - 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_feature%name == 'all') then - do profindex = 1,size(profiles) - if (.not.(profiles(profindex)%profile_feature%name == 'all') & - & .and.(profiles(profindex)%profile_feature%platform == profiles(iprof)%profile_feature%platform)) then - profiles(profindex)%profile_feature%flags = profiles(profindex)%profile_feature%flags // & - & " " // profiles(iprof)%profile_feature%flags - profiles(profindex)%profile_feature%c_flags = profiles(profindex)%profile_feature%c_flags // & - & " " // profiles(iprof)%profile_feature%c_flags - profiles(profindex)%profile_feature%cxx_flags = profiles(profindex)%profile_feature%cxx_flags // & - & " " // profiles(iprof)%profile_feature%cxx_flags - profiles(profindex)%profile_feature%link_time_flags = profiles(profindex)%profile_feature%link_time_flags // & - & " " // profiles(iprof)%profile_feature%link_time_flags - end if - end do - end if + call new_profile(profiles(iprofile), node, list(iprofile)%key, error) + if (allocated(error)) exit end do - end subroutine new_profiles + end subroutine new_profiles - !> Write information on instance - subroutine info(self, unit, verbosity) + !> Write information on instance + subroutine info(self, unit, verbosity) !> Instance of the profile configuration class(profile_config_t), intent(in) :: self @@ -672,8 +160,9 @@ subroutine info(self, unit, verbosity) !> Verbosity of the printout integer, intent(in), optional :: verbosity - integer :: pr - character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)' + integer :: pr, ii + character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)', & + & fmti = '("#", 1x, a, t30, i0)' if (present(verbosity)) then pr = verbosity @@ -681,114 +170,64 @@ subroutine info(self, unit, verbosity) pr = 1 end if + if (pr < 1) return + write(unit, fmt) "Profile" - if (allocated(self%profile_feature%name)) then - write(unit, fmt) "- profile name", self%profile_feature%name + if (allocated(self%name)) then + write(unit, fmt) "- name", self%name end if - - call self%profile_feature%platform%info(unit, verbosity) - if (allocated(self%profile_feature%flags)) then - write(unit, fmt) "- compiler flags", self%profile_feature%flags + if (allocated(self%features)) then + if (size(self%features) > 0) then + write(unit, fmti) "- features", size(self%features) + if (pr > 1) then + do ii = 1, size(self%features) + write(unit, fmt) " - feature", self%features(ii)%s + end do + end if + end if end if - end subroutine info - - !> Look for profile with given configuration in array profiles - subroutine find_profile(profiles, profile_name, target, found_matching, chosen_profile) + end subroutine info - !> Array of profiles - type(profile_config_t), allocatable, intent(in) :: profiles(:) + !> Check that two profile configs are equal + logical function profile_is_same(this, that) + class(profile_config_t), intent(in) :: this + class(serializable_t), intent(in) :: that - !> Name of profile - character(:), allocatable, intent(in) :: profile_name + integer :: ii - ! Target platform - type(platform_config_t), intent(in) :: target + profile_is_same = .false. - !> Boolean value containing true if matching profile was found - logical, intent(out) :: found_matching + select type (other=>that) + type is (profile_config_t) - !> Last matching profile in the profiles array - type(profile_config_t), intent(out) :: chosen_profile - - integer :: i - - found_matching = .false. - if (size(profiles) < 1) return - - - ! Try to find profile with matching OS type - do i=1,size(profiles) - - associate (feat => profiles(i)%profile_feature) - - if (profiles(i)%profile_feature%name == profile_name) then - if (profiles(i)%profile_feature%platform%matches(target)) then - chosen_profile = profiles(i) - found_matching = .true. - return - end if - end if - - endassociate - - end do - - end subroutine find_profile - - - logical function file_scope_same(this,that) - class(file_scope_flag), intent(in) :: this - class(serializable_t), intent(in) :: that - - file_scope_same = .false. + if (allocated(this%name).neqv.allocated(other%name)) return + if (allocated(this%name)) then + if (.not.(this%name==other%name)) return + end if - select type (other=>that) - type is (file_scope_flag) - if (allocated(this%file_name).neqv.allocated(other%file_name)) return - if (allocated(this%file_name)) then - if (.not.(this%file_name==other%file_name)) return - endif - if (allocated(this%flags).neqv.allocated(other%flags)) return - if (allocated(this%flags)) then - if (.not.(this%flags==other%flags)) return - endif + if (allocated(this%features).neqv.allocated(other%features)) return + if (allocated(this%features)) then + if (.not.(size(this%features)==size(other%features))) return + do ii = 1, size(this%features) + if (.not.(this%features(ii)==other%features(ii))) return + end do + end if - class default - ! Not the same type + class default return - end select - - !> All checks passed! - file_scope_same = .true. - - end function file_scope_same - - !> Dump to toml table - subroutine file_scope_dump(self, table, error) - - !> Instance of the serializable object - class(file_scope_flag), intent(inout) :: self - - !> Data structure - type(toml_table), intent(inout) :: table - - !> Error handling - type(error_t), allocatable, intent(out) :: error + end select - call set_string(table, "file-name", self%file_name, error) - if (allocated(error)) return - call set_string(table, "flags", self%flags, error) - if (allocated(error)) return + profile_is_same = .true. - end subroutine file_scope_dump + end function profile_is_same - !> Read from toml table (no checks made at this stage) - subroutine file_scope_load(self, table, error) + !> Dump profile to toml table + subroutine dump_to_toml(self, table, error) !> Instance of the serializable object - class(file_scope_flag), intent(inout) :: self + class(profile_config_t), intent(inout) :: self !> Data structure type(toml_table), intent(inout) :: table @@ -796,101 +235,16 @@ subroutine file_scope_load(self, table, error) !> Error handling type(error_t), allocatable, intent(out) :: error - call get_value(table, "file-name", self%file_name) - call get_value(table, "flags", self%flags) - - end subroutine file_scope_load - - logical function profile_same(this,that) - class(profile_config_t), intent(in) :: this - class(serializable_t), intent(in) :: that - - integer :: ii - - profile_same = .false. - - select type (other=>that) - type is (profile_config_t) - - ! Compare the underlying features - if (.not.(this%profile_feature==other%profile_feature)) return - - ! Compare file scope flags (maintained for backward compatibility) - if (allocated(this%file_scope_flags).neqv.allocated(other%file_scope_flags)) return - if (allocated(this%file_scope_flags)) then - if (.not.size(this%file_scope_flags)==size(other%file_scope_flags)) return - do ii=1,size(this%file_scope_flags) - if (.not.this%file_scope_flags(ii)==other%file_scope_flags(ii)) return - end do - endif - - class default - ! Not the same type - return - end select - - !> All checks passed! - profile_same = .true. - - end function profile_same - - !> Dump to toml table - subroutine profile_dump(self, table, error) - - !> Instance of the serializable object - class(profile_config_t), intent(inout) :: self - - !> Data structure - type(toml_table), intent(inout) :: table - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - !> Local variables - integer :: ierr, ii - type(toml_table), pointer :: ptr_deps, ptr - character(len=30) :: unnamed - - ! Dump the underlying feature data - call self%profile_feature%dump_to_toml(table, error) - if (allocated(error)) return - - if (allocated(self%file_scope_flags)) then - - ! Create file scope flags table - call add_table(table, "file-scope-flags", ptr_deps) - if (.not. associated(ptr_deps)) then - call fatal_error(error, "profile_config_t cannot create file scope table ") - return - end if - - do ii = 1, size(self%file_scope_flags) - associate (dep => self%file_scope_flags(ii)) - - !> Because files need a name, fallback if this has no name - if (len_trim(dep%file_name)==0) then - write(unnamed,1) ii - call add_table(ptr_deps, trim(unnamed), ptr) - else - call add_table(ptr_deps, dep%file_name, ptr) - end if - if (.not. associated(ptr)) then - call fatal_error(error, "profile_config_t cannot create entry for file "//dep%file_name) - return - end if - call dep%dump_to_toml(ptr, error) - if (allocated(error)) return - end associate - end do - - endif + call set_string(table, "name", self%name, error, class_name) + if (allocated(error)) return - 1 format('UNNAMED_FILE_',i0) + call set_list(table, "features", self%features, error) + if (allocated(error)) return - end subroutine profile_dump + end subroutine dump_to_toml - !> Read from toml table (no checks made at this stage) - subroutine profile_load(self, table, error) + !> Read profile from toml table (no checks made at this stage) + subroutine load_from_toml(self, table, error) !> Instance of the serializable object class(profile_config_t), intent(inout) :: self @@ -901,105 +255,11 @@ subroutine profile_load(self, table, error) !> Error handling type(error_t), allocatable, intent(out) :: error - !> Local variables - character(len=:), allocatable :: flag, compiler_name - integer :: ii, jj - type(toml_table), pointer :: ptr_dep, ptr - type(toml_key), allocatable :: keys(:),dep_keys(:) - - call table%get_keys(keys) - - ! Load into feature structure - ! Dump the underlying feature data - call self%profile_feature%load_from_toml(table, error) - if (allocated(error)) return - - if (allocated(self%file_scope_flags)) deallocate(self%file_scope_flags) - sub_deps: do ii = 1, size(keys) - - select case (keys(ii)%key) - case ("file-scope-flags") - - call get_value(table, keys(ii), ptr) - if (.not.associated(ptr)) then - call fatal_error(error,'profile_config_t: error retrieving file_scope_flags table') - return - end if - - !> Read all file scope flags - call ptr%get_keys(dep_keys) - allocate(self%file_scope_flags(size(dep_keys))) + call get_value(table, "name", self%name) - do jj = 1, size(dep_keys) - - call get_value(ptr, dep_keys(jj), ptr_dep) - call self%file_scope_flags(jj)%load_from_toml(ptr_dep, error) - if (allocated(error)) return - - end do - - end select - end do sub_deps - - end subroutine profile_load - - !> Convenience accessor procedures for backward compatibility - - !> Get profile name - function get_profile_name(self) result(name) - class(profile_config_t), intent(in) :: self - character(len=:), allocatable :: name - name = self%profile_feature%name - end function get_profile_name - - !> Get compiler name - function get_profile_compiler(self) result(compiler) - class(profile_config_t), intent(in) :: self - character(len=:), allocatable :: compiler - compiler = compiler_id_name(self%profile_feature%platform%compiler) - end function get_profile_compiler - - !> Get OS type - function get_profile_os_type(self) result(os_type) - class(profile_config_t), intent(in) :: self - integer :: os_type - os_type = self%profile_feature%platform%os_type - end function get_profile_os_type - - !> Get flags - function get_profile_flags(self) result(flags) - class(profile_config_t), intent(in) :: self - character(len=:), allocatable :: flags - flags = self%profile_feature%flags - end function get_profile_flags - - !> Get C flags - function get_profile_c_flags(self) result(c_flags) - class(profile_config_t), intent(in) :: self - character(len=:), allocatable :: c_flags - c_flags = self%profile_feature%c_flags - end function get_profile_c_flags - - !> Get C++ flags - function get_profile_cxx_flags(self) result(cxx_flags) - class(profile_config_t), intent(in) :: self - character(len=:), allocatable :: cxx_flags - cxx_flags = self%profile_feature%cxx_flags - end function get_profile_cxx_flags - - !> Get link time flags - function get_profile_link_time_flags(self) result(link_time_flags) - class(profile_config_t), intent(in) :: self - character(len=:), allocatable :: link_time_flags - link_time_flags = self%profile_feature%link_time_flags - end function get_profile_link_time_flags - - !> Get is_built_in flag (maps to feature default flag) - function get_profile_is_built_in(self) result(is_built_in) - class(profile_config_t), intent(in) :: self - logical :: is_built_in - is_built_in = self%profile_feature%default - end function get_profile_is_built_in + call get_list(table, "features", self%features, error) + if (allocated(error)) return + end subroutine load_from_toml end module fpm_manifest_profile diff --git a/test/fpm_test/test_toml.f90 b/test/fpm_test/test_toml.f90 index dff79fd29a..5a17bd9740 100644 --- a/test/fpm_test/test_toml.f90 +++ b/test/fpm_test/test_toml.f90 @@ -17,7 +17,6 @@ module test_toml use fpm_manifest_library, only: library_config_t use fpm_manifest_executable, only: executable_config_t use fpm_manifest_preprocess, only: preprocess_config_t - use fpm_manifest_profile, only: file_scope_flag use fpm_manifest_platform, only: platform_config_t use fpm_manifest_metapackages, only: metapackage_config_t use fpm_manifest_feature_collection, only: feature_collection_t @@ -39,7 +38,6 @@ module test_toml contains - !> Collect all exported unit tests subroutine collect_toml(testsuite) @@ -64,7 +62,6 @@ subroutine collect_toml(testsuite) & new_unittest("serialize-library-config", library_config_roundtrip), & & new_unittest("serialize-executable-config", executable_config_roundtrip), & & new_unittest("serialize-preprocess-config", preprocess_config_roundtrip), & - & new_unittest("serialize-file-scope-flag", file_scope_flag_roundtrip), & & new_unittest("serialize-string-array", string_array_roundtrip), & & new_unittest("serialize-fortran-features", fft_roundtrip), & & new_unittest("serialize-fortran-invalid", fft_invalid, should_fail=.true.), & @@ -1288,23 +1285,6 @@ subroutine preprocess_config_roundtrip(error) end subroutine preprocess_config_roundtrip - subroutine file_scope_flag_roundtrip(error) - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(file_scope_flag) :: ff - - call ff%test_serialization('file_scope_flag: empty', error) - if (allocated(error)) return - - ff%file_name = "preprocessor config" - ff%flags = "-1 -f -2 -g" - - call ff%test_serialization('file_scope_flag: non-empty', error) - - end subroutine file_scope_flag_roundtrip - !> Test a metapackage configuration subroutine metapackage_config_roundtrip(error) From 5f6f5d15c9453abecb02eaa0c4a2e5562b07ae30 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 7 Sep 2025 15:35:14 +0200 Subject: [PATCH 02/59] test profiles serialization --- test/fpm_test/test_manifest.f90 | 121 ++++++++++---------------------- test/fpm_test/test_toml.f90 | 22 +++++- 2 files changed, 60 insertions(+), 83 deletions(-) diff --git a/test/fpm_test/test_manifest.f90 b/test/fpm_test/test_manifest.f90 index 36be44af82..cbb08f055e 100644 --- a/test/fpm_test/test_manifest.f90 +++ b/test/fpm_test/test_manifest.f90 @@ -41,9 +41,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.), & - ! FROZEN: Profile tests disabled during transition to feature-based architecture - ! & new_unittest("profiles", test_profiles), & - ! & new_unittest("profiles-keyvalue-table", test_profiles_keyvalue_table, should_fail=.true.), & + & new_unittest("profiles", test_profiles), & + & new_unittest("profiles-invalid", test_profiles_invalid, 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.), & @@ -535,10 +534,7 @@ subroutine test_dependencies_typeerror(error) end subroutine test_dependencies_typeerror - !> FROZEN TEST: Include a table of profiles in toml, check whether they are parsed correctly and stored in package - !> NOTE: This test is frozen during transition to feature-based architecture. - !> Profiles are now empty arrays, functionality moved to features. - !> Will be replaced with feature-based tests in future. + !> Test profile parsing and storage in package subroutine test_profiles(error) !> Error handling @@ -547,24 +543,14 @@ subroutine test_profiles(error) type(package_config_t) :: package character(len=*), parameter :: manifest = 'fpm-profiles.toml' integer :: unit - character(:), allocatable :: profile_name - logical :: profile_found - type(platform_config_t) :: target - type(profile_config_t) :: chosen_profile 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.gfortran]', & - & 'flags = "4" #all.gfortran.all', & - & '[profiles.release.ifort]', & - & 'flags = "5" #release.ifort.all' + & '[profiles]', & + & 'development.features = ["debug", "testing"]', & + & 'release.features = ["optimized"]', & + & 'full-test.features = ["debug", "testing", "benchmarks"]' close(unit) call get_package_data(package, manifest, error) @@ -574,68 +560,38 @@ subroutine test_profiles(error) if (allocated(error)) return -! profile_name = 'release' -! compiler = 'gfortran' -! -! call find_profile(package%profiles, profile_name, compiler, 1, profile_found, chosen_profile) -! if (.not.(chosen_profile%flags().eq.'1 3')) then -! call test_failed(error, "Failed to append flags from profiles named 'all'") -! return -! end if -! -! call chosen_profile%test_serialization('profile serialization: '//profile_name//' '//compiler,error) -! if (allocated(error)) return -! -! profile_name = 'release' -! compiler = 'gfortran' -! call find_profile(package%profiles, profile_name, compiler, 3, profile_found, chosen_profile) -! if (.not.(chosen_profile%flags().eq.'2 4')) then -! call test_failed(error, "Failed to choose profile with OS 'all'") -! return -! end if -! -! call chosen_profile%test_serialization('profile serialization: '//profile_name//' '//compiler,error) -! if (allocated(error)) return -! -! profile_name = 'publish' -! compiler = 'gfortran' -! call find_profile(package%profiles, profile_name, compiler, 1, profile_found, chosen_profile) -! if (profile_found) then -! call test_failed(error, "Profile named "//profile_name//" should not exist") -! return -! end if -! -! call chosen_profile%test_serialization('profile serialization: '//profile_name//' '//compiler,error) -! if (allocated(error)) return -! -! profile_name = 'debug' -! compiler = 'ifort' -! 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 "//profile_name) -! return -! end if -! -! call chosen_profile%test_serialization('profile serialization: '//profile_name//' '//compiler,error) -! if (allocated(error)) return -! -! profile_name = 'release' -! compiler = 'ifort' -! call find_profile(package%profiles, profile_name, compiler, 1, profile_found, chosen_profile) -! if (.not.(chosen_profile%flags().eq.'5')) then -! call test_failed(error, "Failed to overwrite built-in profile") -! return -! end if - -! call chosen_profile%test_serialization('profile serialization: '//profile_name//' '//compiler,error) -! if (allocated(error)) return + ! Check that profiles were parsed correctly + if (.not. allocated(package%profiles)) then + call test_failed(error, "No profiles found in package") + return + end if + + if (size(package%profiles) /= 3) then + call test_failed(error, "Unexpected number of profiles, should be 3") + return + end if + + ! Check development profile + if (package%profiles(1)%name /= "development") then + call test_failed(error, "Expected profile name 'development', got '" // package%profiles(1)%name // "'") + return + end if + + if (size(package%profiles(1)%features) /= 2) then + call test_failed(error, "Unexpected number of features, should be 2") + return + end if + + if (package%profiles(1)%features(1)%s /= "debug" .or. & + package%profiles(1)%features(2)%s /= "testing") then + call test_failed(error, "Incorrect features in development profile") + return + end if end subroutine test_profiles - !> FROZEN TEST: 'flags' is a key-value entry, test should fail as it is defined as a table - !> NOTE: This test is frozen during transition to feature-based architecture. - subroutine test_profiles_keyvalue_table(error) + !> Test invalid profile configuration should fail + subroutine test_profiles_invalid(error) !> Error handling type(error_t), allocatable, intent(out) :: error @@ -647,14 +603,15 @@ subroutine test_profiles_keyvalue_table(error) open(file=manifest, newunit=unit) write(unit, '(a)') & & 'name = "example"', & - & '[profiles.linux.flags]' + & '[profiles]', & + & 'development.invalid_key = "should_fail"' close(unit) call get_package_data(package, manifest, error) open(file=manifest, newunit=unit) close(unit, status='delete') - end subroutine test_profiles_keyvalue_table + end subroutine test_profiles_invalid !> Executables cannot be created from empty tables subroutine test_executable_empty(error) diff --git a/test/fpm_test/test_toml.f90 b/test/fpm_test/test_toml.f90 index 5a17bd9740..a061a75320 100644 --- a/test/fpm_test/test_toml.f90 +++ b/test/fpm_test/test_toml.f90 @@ -20,6 +20,7 @@ module test_toml use fpm_manifest_platform, only: platform_config_t use fpm_manifest_metapackages, only: metapackage_config_t use fpm_manifest_feature_collection, only: feature_collection_t + use fpm_manifest_profile, only: profile_config_t use fpm_environment, only: OS_ALL, OS_LINUX, OS_MACOS use fpm_versioning, only: new_version use fpm_strings, only: string_t, operator(==), split @@ -75,7 +76,8 @@ subroutine collect_toml(testsuite) & new_unittest("serialize-model", fpm_model_roundtrip), & & new_unittest("serialize-model-invalid", fpm_model_invalid, should_fail=.true.), & & new_unittest("serialize-metapackage-config", metapackage_config_roundtrip), & - & new_unittest("serialize-feature-collection", feature_collection_roundtrip)] + & new_unittest("serialize-feature-collection", feature_collection_roundtrip), & + & new_unittest("serialize-profile-config", profile_config_roundtrip)] end subroutine collect_toml @@ -1330,5 +1332,23 @@ subroutine feature_collection_roundtrip(error) end subroutine feature_collection_roundtrip + subroutine profile_config_roundtrip(error) + type(error_t), allocatable, intent(out) :: error + type(profile_config_t) :: profile + + ! Set up a profile with features + profile%name = "development" + + ! Allocate and populate features array + allocate(profile%features(3)) + profile%features(1)%s = "debug" + profile%features(2)%s = "testing" + profile%features(3)%s = "verbose" + + ! Round-trip via the generic serialization tester + call profile%test_serialization('profile_config_t: development profile', error) + + end subroutine profile_config_roundtrip + end module test_toml From 1c37b21dc7955ec8199a639ea13b2f95be184cd4 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 7 Sep 2025 16:04:43 +0200 Subject: [PATCH 03/59] remove .features field from the profiles manifest --- src/fpm/manifest/profiles.f90 | 70 +++++++++++---------------------- test/fpm_test/test_manifest.f90 | 8 ++-- 2 files changed, 27 insertions(+), 51 deletions(-) diff --git a/src/fpm/manifest/profiles.f90 b/src/fpm/manifest/profiles.f90 index bccd6c7c67..e3c162e8f0 100644 --- a/src/fpm/manifest/profiles.f90 +++ b/src/fpm/manifest/profiles.f90 @@ -15,7 +15,7 @@ module fpm_manifest_profile use fpm_error, only: error_t, fatal_error, syntax_error use fpm_strings, only: string_t, operator(==) - use tomlf, only: toml_table, toml_key, toml_stat + use tomlf, only: toml_table, toml_array, toml_key, toml_stat, len use fpm_toml, only: get_value, serializable_t, set_string, set_list, get_list, add_table implicit none @@ -48,14 +48,14 @@ module fpm_manifest_profile contains - !> Construct a new profile configuration from a TOML data structure - subroutine new_profile(self, table, profile_name, error) + !> Construct a new profile configuration from a TOML array + subroutine new_profile(self, features_array, profile_name, error) !> Instance of the profile configuration type(profile_config_t), intent(out) :: self - !> Instance of the TOML data structure - type(toml_table), intent(inout) :: table + !> TOML array containing the feature names + type(toml_array), intent(inout) :: features_array !> Name of the profile character(len=*), intent(in) :: profile_name @@ -63,53 +63,29 @@ subroutine new_profile(self, table, profile_name, error) !> Error handling type(error_t), allocatable, intent(out) :: error - call check(table, error) - if (allocated(error)) return + integer :: i, stat + character(len=:), allocatable :: feature_name ! Set profile name self%name = profile_name - ! Get list of features - call get_list(table, "features", self%features, error) - if (allocated(error)) return - - ! If no features specified, initialize empty array - if (.not. allocated(self%features)) then + ! Get feature names from array + if (len(features_array) > 0) then + allocate(self%features(len(features_array))) + do i = 1, len(features_array) + call get_value(features_array, i, feature_name, stat=stat) + if (stat /= toml_stat%success) then + call fatal_error(error, "Failed to read feature name from profile " // profile_name) + return + end if + self%features(i)%s = feature_name + end do + else allocate(self%features(0)) end if end subroutine new_profile - !> Check local schema for allowed entries - subroutine check(table, error) - - !> Instance of the TOML data structure - type(toml_table), intent(inout) :: table - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(toml_key), allocatable :: list(:) - integer :: ikey - - call table%get_keys(list) - - ! Profile table can be empty (no features) - if (size(list) < 1) return - - do ikey = 1, size(list) - select case(list(ikey)%key) - case default - call syntax_error(error, "Key "//list(ikey)%key//" is not allowed in profile table") - exit - - case("features") - continue - - end select - end do - - end subroutine check !> Construct new profiles array from a TOML data structure subroutine new_profiles(profiles, table, error) @@ -123,7 +99,7 @@ subroutine new_profiles(profiles, table, error) !> Error handling type(error_t), allocatable, intent(out) :: error - type(toml_table), pointer :: node + type(toml_array), pointer :: array_node type(toml_key), allocatable :: list(:) integer :: iprofile, stat @@ -137,12 +113,12 @@ subroutine new_profiles(profiles, table, error) allocate(profiles(size(list))) do iprofile = 1, size(list) - call get_value(table, list(iprofile)%key, node, stat=stat) + call get_value(table, list(iprofile)%key, array_node, stat=stat) if (stat /= toml_stat%success) then - call fatal_error(error, "Profile "//list(iprofile)%key//" must be a table entry") + call fatal_error(error, "Profile "//list(iprofile)%key//" must be an array of feature names") exit end if - call new_profile(profiles(iprofile), node, list(iprofile)%key, error) + call new_profile(profiles(iprofile), array_node, list(iprofile)%key, error) if (allocated(error)) exit end do diff --git a/test/fpm_test/test_manifest.f90 b/test/fpm_test/test_manifest.f90 index cbb08f055e..68a6a431f7 100644 --- a/test/fpm_test/test_manifest.f90 +++ b/test/fpm_test/test_manifest.f90 @@ -548,9 +548,9 @@ subroutine test_profiles(error) write(unit, '(a)') & & 'name = "example"', & & '[profiles]', & - & 'development.features = ["debug", "testing"]', & - & 'release.features = ["optimized"]', & - & 'full-test.features = ["debug", "testing", "benchmarks"]' + & 'development = ["debug", "testing"]', & + & 'release = ["optimized"]', & + & 'full-test = ["debug", "testing", "benchmarks"]' close(unit) call get_package_data(package, manifest, error) @@ -604,7 +604,7 @@ subroutine test_profiles_invalid(error) write(unit, '(a)') & & 'name = "example"', & & '[profiles]', & - & 'development.invalid_key = "should_fail"' + & 'development = "not_an_array"' close(unit) call get_package_data(package, manifest, error) From f7790cde9b3be9a7082fc889b3d0b0f7b756670a Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 7 Sep 2025 16:26:31 +0200 Subject: [PATCH 04/59] add `features` to the CLI settings --- src/fpm_command_line.f90 | 68 ++++++++++++++++++++++++++-------------- 1 file changed, 45 insertions(+), 23 deletions(-) diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index f871ccd232..924f1bb1ec 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -84,6 +84,7 @@ module fpm_command_line character(len=:),allocatable :: cxx_compiler character(len=:),allocatable :: archiver character(len=:),allocatable :: profile + character(len=:),allocatable :: features character(len=:),allocatable :: flag character(len=:),allocatable :: cflag character(len=:),allocatable :: cxxflag @@ -164,11 +165,14 @@ module fpm_command_line ! '12345678901234567890123456789012345678901234567890123456789012345678901234567890',& character(len=80), parameter :: help_text_build_common(*) = [character(len=80) :: & - ' --profile PROF Selects the compilation profile for the build. ',& - ' Currently available profiles are "release" for ',& - ' high optimization and "debug" for full debug options. ',& - ' If --flag is not specified the "debug" flags are the ',& + ' --profile PROF Selects either a compilation profile ("release", "debug") or ',& + ' a feature profile defined in fpm.toml. Feature profiles ',& + ' group multiple features together. Cannot be used with ',& + ' --features. If --flag is not specified the "debug" flags ',& ' default. ',& + ' --features LIST Comma-separated list of features to enable (defined in ',& + ' fpm.toml). Cannot be used with --profile. ',& + ' Example: `fpm build --features mpi,openmp,hdf5 ` ',& ' --no-prune Disable tree-shaking/pruning of unused module dependencies ',& ' --build-dir DIR Specify the build directory. Default is "build" unless set ',& ' by the environment variable FPM_BUILD_DIR. '& @@ -249,9 +253,10 @@ subroutine get_command_line_settings(cmd_settings) & c_compiler, cxx_compiler, archiver, version_s, token_s, config_file character(len=*), parameter :: fc_env = "FC", cc_env = "CC", ar_env = "AR", & - & fflags_env = "FFLAGS", cflags_env = "CFLAGS", cxxflags_env = "CXXFLAGS", ldflags_env = "LDFLAGS", & - & fc_default = "gfortran", cc_default = " ", ar_default = " ", flags_default = " ", & - & cxx_env = "CXX", cxx_default = " ", build_dir_env = "BUILD_DIR", build_dir_default = "build" + & fflags_env = "FFLAGS", cflags_env = "CFLAGS", cxxflags_env = "CXXFLAGS", & + & ldflags_env = "LDFLAGS", fc_default = "gfortran", cc_default = " ", ar_default = " ", & + & flags_default = " ", cxx_env = "CXX", cxx_default = " ", build_dir_env = "BUILD_DIR", & + & build_dir_default = "build" type(error_t), allocatable :: error call set_help() @@ -297,6 +302,7 @@ subroutine get_command_line_settings(cmd_settings) compiler_args = & ' --profile " "' // & + ' --features " "' // & ' --no-prune F' // & ' --compiler "'//get_fpm_env(fc_env, fc_default)//'"' // & ' --c-compiler "'//get_fpm_env(cc_env, cc_default)//'"' // & @@ -406,14 +412,16 @@ subroutine get_command_line_settings(cmd_settings) name='.' else write(stderr,'(*(7x,g0,/))') & - & ' fpm new NAME [[--lib|--src] [--app] [--test] [--example]]|[--full|--bare] [--backfill]' + & ' fpm new NAME [[--lib|--src] [--app] [--test] '//& + & ' [--example]]|[--full|--bare] [--backfill]' call fpm_stop(1,'directory name required') endif case(2) name=trim(unnamed(2)) case default write(stderr,'(7x,g0)') & - & ' fpm new NAME [[--lib|--src] [--app] [--test] [--example]]| [--full|--bare] [--backfill]' + & ' fpm new NAME [[--lib|--src] [--app] [--test] [--example]] '//& + & '| [--full|--bare] [--backfill]' call fpm_stop(2,'only one directory name allowed') end select !*! canon_path is not converting ".", etc. @@ -672,7 +680,8 @@ subroutine get_command_line_settings(cmd_settings) end if if (target_specific .and. any([skip, clean_all])) then - call fpm_stop(6, 'Cannot combine target-specific flags (--test, --apps, --examples) with --skip or --all.') + call fpm_stop(6, 'Cannot combine target-specific flags (--test, --apps, '//& + '--examples) with --skip or --all.') end if allocate(fpm_clean_settings :: cmd_settings) @@ -829,18 +838,20 @@ subroutine set_help() ' '] help_list_dash = [character(len=80) :: & ' ', & - ' build [--compiler COMPILER_NAME] [--profile PROF] [--flag FFLAGS] [--list] ', & - ' [--tests] [--no-prune] [--dump [FILENAME]] [--config-file PATH] ', & + ' build [--compiler COMPILER_NAME] [--profile PROF] [--features LIST] [--list] ', & + ' [--flag FFLAGS] [--tests] [--no-prune] [--dump [FILENAME]] ', & + ' [--config-file PATH] ', & ' help [NAME(s)] ', & ' new NAME [[--lib|--src] [--app] [--test] [--example]]| ', & ' [--full|--bare][--backfill] ', & ' update [NAME(s)] [--fetch-only] [--clean] [--verbose] [--dump [FILENAME]] ', & ' list [--list] ', & - ' run [[--target] NAME(s) [--example] [--profile PROF] [--flag FFLAGS] [--all] ', & + ' run [[--target] NAME(s) [--example] [--profile PROF] [--features LIST] [--all]', & ' [--runner "CMD"] [--compiler COMPILER_NAME] [--list] [-- ARGS] ', & - ' [--config-file PATH] ', & - ' test [[--target] NAME(s)] [--profile PROF] [--flag FFLAGS] [--runner "CMD"] ', & - ' [--list] [--compiler COMPILER_NAME] [--config-file PATH] [-- ARGS] ', & + ' [--config-file PATH] [--flag FFLAGS] ', & + ' test [[--target] NAME(s)] [--profile PROF] [--features LIST] [--flag FFLAGS] ', & + ' [--runner "CMD"] [--list] [--compiler COMPILER_NAME] [--config-file PATH] ', & + ' [-- ARGS] ', & ' install [--profile PROF] [--flag FFLAGS] [--no-rebuild] [--prefix PATH] ', & ' [--config-file PATH] [--registry-cache] [options] ', & ' clean [--skip|--all] [--test] [--apps] [--examples] [--config-file PATH] ', & @@ -1154,9 +1165,9 @@ subroutine set_help() ' build(1) - the fpm(1) subcommand to build a project ', & ' ', & 'SYNOPSIS ', & - ' fpm build [--profile PROF] [--flag FFLAGS] [--compiler COMPILER_NAME] ', & - ' [--build-dir DIR] [--list] [--tests] [--config-file PATH] ', & - ' [--dump [FILENAME]] ', & + ' fpm build [--profile PROF] [--features LIST] [--flag FFLAGS] ', & + ' [--compiler COMPILER_NAME] [--build-dir DIR] [--list] ', & + ' [--tests] [--config-file PATH] [--dump [FILENAME]] ', & ' ', & ' fpm build --help|--version ', & ' ', & @@ -1200,6 +1211,8 @@ subroutine set_help() ' ', & ' fpm build # build with debug options ', & ' fpm build --profile release # build with high optimization ', & + ' fpm build --features mpi,openmp # build with specific features ', & + ' fpm build --profile development # use feature profile from fpm.toml', & ' fpm build --build-dir /tmp/my_build # build to custom directory ', & '' ] @@ -1343,9 +1356,9 @@ subroutine set_help() ' test(1) - the fpm(1) subcommand to run project tests ', & ' ', & 'SYNOPSIS ', & - ' fpm test [[--target] NAME(s)] [--profile PROF] [--flag FFLAGS] ', & - ' [--compiler COMPILER_NAME ] [--runner "CMD"] [--list] ', & - ' [-- ARGS] [--config-file PATH] ', & + ' fpm test [[--target] NAME(s)] [--profile PROF] [--features LIST] ', & + ' [--flag FFLAGS] [--compiler COMPILER_NAME] [--runner "CMD"] ', & + ' [--list] [-- ARGS] [--config-file PATH] ', & ' ', & ' fpm test --help|--version ', & ' ', & @@ -1387,7 +1400,8 @@ subroutine set_help() ' # run a specific test and pass arguments to the command ', & ' fpm test mytest -- -x 10 -y 20 --title "my title line" ', & ' ', & - ' fpm test tst1 tst2 --profile PROF # run production version of two tests', & + ' fpm test tst1 tst2 --profile release # run release version of tests ', & + ' fpm test --features debug,mpi # run tests with specific features ', & '' ] help_update=[character(len=80) :: & 'NAME', & @@ -1606,6 +1620,7 @@ subroutine build_settings(self, list, show_model, build_tests, config_file) character(len=:), allocatable :: comp, ccomp, cxcomp, arch character(len=:), allocatable :: fflags, cflags, cxxflags, ldflags character(len=:), allocatable :: prof, cfg, dump, dir + character(len=:), allocatable :: feats ! Read CLI/env values (sget returns what set_args registered, including defaults) ! This is equivalent to check_build_vals @@ -1615,6 +1630,7 @@ subroutine build_settings(self, list, show_model, build_tests, config_file) cxxflags = ' ' // sget('cxx-flag') ldflags = ' ' // sget('link-flag') prof = sget('profile') + feats = sget('features') ! Set and validate build directory dir = sget('build-dir') @@ -1642,8 +1658,14 @@ subroutine build_settings(self, list, show_model, build_tests, config_file) cfg = sget('config-file') end if + ! Validate mutually exclusive options + if (specified('profile') .and. specified('features')) then + call fpm_stop(1, 'Error: --profile and --features cannot be used together') + end if + ! Assign into this (polymorphic) object; allocatable chars auto-allocate self%profile = prof + self%features = feats self%prune = .not. lget('no-prune') self%compiler = comp self%c_compiler = ccomp From 698e9ceef1ae7093f2dbac400e5ff0f4eb3dbd3e Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 7 Sep 2025 16:35:08 +0200 Subject: [PATCH 05/59] CLI features: make it a string array --- src/fpm_command_line.f90 | 49 +++++++++++++++++++++++++++++++++++++--- src/fpm_strings.f90 | 30 +++++++++++++++++++++++- 2 files changed, 75 insertions(+), 4 deletions(-) diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 924f1bb1ec..6d3116f0cf 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -29,7 +29,7 @@ module fpm_command_line use M_CLI2, only : set_args, lget, sget, unnamed, remaining, specified use M_CLI2, only : get_subcommand, CLI_RESPONSE_FILE use fpm_strings, only : lower, split, to_fortran_name, is_fortran_name, remove_characters_in_set, & - string_t, glob + string_t, glob, is_valid_feature_name use fpm_filesystem, only : basename, canon_path, which, run use fpm_environment, only : get_command_arguments_quoted use fpm_error, only : fpm_stop, error_t @@ -84,7 +84,7 @@ module fpm_command_line character(len=:),allocatable :: cxx_compiler character(len=:),allocatable :: archiver character(len=:),allocatable :: profile - character(len=:),allocatable :: features + type(string_t), allocatable :: features(:) character(len=:),allocatable :: flag character(len=:),allocatable :: cflag character(len=:),allocatable :: cxxflag @@ -1663,9 +1663,15 @@ subroutine build_settings(self, list, show_model, build_tests, config_file) call fpm_stop(1, 'Error: --profile and --features cannot be used together') end if + ! Parse comma-separated features + if (specified('features') .and. len_trim(feats) > 0) then + call parse_features(feats, self%features) + else + allocate(self%features(0)) + end if + ! Assign into this (polymorphic) object; allocatable chars auto-allocate self%profile = prof - self%features = feats self%prune = .not. lget('no-prune') self%compiler = comp self%c_compiler = ccomp @@ -1686,5 +1692,42 @@ subroutine build_settings(self, list, show_model, build_tests, config_file) if (present(build_tests)) self%build_tests = build_tests end subroutine build_settings + !> Parse comma-separated features string into string_t array + subroutine parse_features(features_str, features_array) + character(len=*), intent(in) :: features_str + type(string_t), allocatable, intent(out) :: features_array(:) + + character(len=:), allocatable :: trimmed_features(:) + integer :: i + + ! Split by comma + call split(features_str, trimmed_features, delimiters=',') + + ! Validate and clean feature names + if (size(trimmed_features) == 0) then + call fpm_stop(1, 'Error: Empty features list provided') + end if + + allocate(features_array(size(trimmed_features))) + + do i = 1, size(trimmed_features) + ! Trim whitespace + trimmed_features(i) = trim(adjustl(trimmed_features(i))) + + ! Validate feature name + if (len_trim(trimmed_features(i)) == 0) then + call fpm_stop(1, 'Error: Empty feature name in features list') + end if + + ! Check for valid feature name (similar to Fortran identifier rules) + if (.not. is_valid_feature_name(trimmed_features(i))) then + call fpm_stop(1, 'Error: Invalid feature name "'//trimmed_features(i)//'"') + end if + + features_array(i)%s = trimmed_features(i) + end do + + end subroutine parse_features + end module fpm_command_line diff --git a/src/fpm_strings.f90 b/src/fpm_strings.f90 index b039271994..4442fc9882 100644 --- a/src/fpm_strings.f90 +++ b/src/fpm_strings.f90 @@ -43,7 +43,7 @@ module fpm_strings private public :: f_string, lower, upper, split, split_first_last, split_lines_first_last, str_ends_with, string_t, str_begins_with_str -public :: to_fortran_name, is_fortran_name +public :: to_fortran_name, is_fortran_name, is_valid_feature_name public :: string_array_contains, string_cat, len_trim, operator(.in.), fnv_1a public :: replace, resize, str, join, glob public :: notabs, dilate, remove_newline_characters, remove_characters_in_set @@ -1659,4 +1659,32 @@ function dilate(instr) result(outstr) end function dilate +!> Check if feature name is valid (alphanumeric, underscore, dash allowed) +logical function is_valid_feature_name(name) result(valid) + character(len=*), intent(in) :: name + integer :: i + character :: c + + valid = .false. + + ! Must not be empty and not too long + if (len_trim(name) == 0 .or. len_trim(name) > 64) return + + ! First character must be alphabetic or underscore + c = name(1:1) + if (.not. ((c >= 'a' .and. c <= 'z') .or. (c >= 'A' .and. c <= 'Z') .or. c == '_')) return + + ! Remaining characters can be alphanumeric, underscore, or dash + do i = 2, len_trim(name) + c = name(i:i) + if (.not. ((c >= 'a' .and. c <= 'z') .or. (c >= 'A' .and. c <= 'Z') .or. & + (c >= '0' .and. c <= '9') .or. c == '_' .or. c == '-')) then + return + end if + end do + + valid = .true. + +end function is_valid_feature_name + end module fpm_strings From 152e4ca310e2223a88ff2adbb3e0cca77868f7db Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 7 Sep 2025 16:48:05 +0200 Subject: [PATCH 06/59] add CLI tests --- test/cli_test/cli_test.f90 | 34 ++++++++++++++++++++++++++++++---- 1 file changed, 30 insertions(+), 4 deletions(-) diff --git a/test/cli_test/cli_test.f90 b/test/cli_test/cli_test.f90 index 581b89cafe..e80e28ac8d 100644 --- a/test/cli_test/cli_test.f90 +++ b/test/cli_test/cli_test.f90 @@ -18,6 +18,7 @@ program main ! assuming no name over 15 characters to make output have shorter lines character(len=15),allocatable :: name(:),act_name(:) ; namelist/act_cli/act_name +character(len=15),allocatable :: features(:),act_features(:) ; namelist/act_cli/act_features integer,parameter :: max_names=10 character(len=:),allocatable :: command @@ -40,7 +41,7 @@ program main character(len=:), allocatable :: profile,act_profile ; namelist/act_cli/act_profile character(len=:), allocatable :: args,act_args ; namelist/act_cli/act_args -namelist/expected/cmd,cstat,estat,w_e,w_t,c_s,c_a,c_t,c_apps,c_ex,reg_c,name,profile,args,show_v,show_u_d,dry_run,token +namelist/expected/cmd,cstat,estat,w_e,w_t,c_s,c_a,c_t,c_apps,c_ex,reg_c,name,features,profile,args,show_v,show_u_d,dry_run,token integer :: lun logical,allocatable :: tally(:) logical,allocatable :: subtally(:) @@ -71,10 +72,13 @@ program main 'CMD="test proj1 p2 project3 --profile debug", NAME="proj1","p2","project3",profile="debug",', & 'CMD="test proj1 p2 project3 --profile release", NAME="proj1","p2","project3",profile="release",', & 'CMD="test proj1 p2 project3 --profile release -- arg1 -x ""and a long one""", & - &NAME="proj1","p2","project3",profile="release" ARGS="""arg1"" ""-x"" ""and a long one""", ', & + &NAME="proj1","p2","project3",profile="release",ARGS="""arg1"" ""-x"" ""and a long one""", ', & -'CMD="build", NAME=, profile="",ARGS="",', & -'CMD="build --profile release", NAME=, profile="release",ARGS="",', & +'CMD="build", NAME=, profile="",features=,ARGS="",', & +'CMD="build --profile release", NAME=, profile="release",features=,ARGS="",', & +'CMD="build --features debug,mpi", NAME=, profile="",features="debug","mpi",ARGS="",', & +'CMD="build --features single_feature", NAME=, profile="",features="single_feature",ARGS="",', & +'CMD="test --features debug,openmp", NAME=, profile="",features="debug","openmp",ARGS="",', & 'CMD="clean", NAME=, ARGS="",', & 'CMD="clean --skip", C_S=T, NAME=, ARGS="",', & @@ -115,6 +119,8 @@ program main endif ! blank out name group EXPECTED name=[(repeat(' ',len(name)),i=1,max_names)] ! the words on the command line sans the subcommand name + if(.not.allocated(features)) allocate(character(len=15) :: features(max_names)) + features=[(repeat(' ',15),i=1,max_names)] ! the features on the command line profile='' ! --profile PROF w_e=.false. ! --app w_t=.false. ! --test @@ -139,6 +145,8 @@ program main if(estat==0)then open(file='_test_cli',newunit=lun,delim='quote') act_name=[(repeat(' ',len(act_name)),i=1,max_names)] + if(.not.allocated(act_features)) allocate(character(len=15) :: act_features(max_names)) + act_features=[(repeat(' ',15),i=1,max_names)] act_profile='' act_w_e=.false. act_w_t=.false. @@ -158,6 +166,7 @@ program main ! compare results to expected values subtally=[logical ::] call test_test('NAME',all(act_name==name)) + call test_test('FEATURES',all(act_features==features)) call test_test('PROFILE',act_profile==profile) call test_test('SKIP',act_c_s.eqv.c_s) call test_test('ALL',act_c_a.eqv.c_a) @@ -250,6 +259,8 @@ subroutine parse() call get_command_line_settings(cmd_settings) allocate (character(len=len(name)) :: act_name(0) ) +allocate(character(len=15) :: act_features(max_names)) +act_features=[(repeat(' ',15),i=1,max_names)] act_args='' act_w_e=.false. act_w_t=.false. @@ -269,12 +280,27 @@ subroutine parse() act_name=[trim(settings%name)] type is (fpm_build_settings) act_profile=settings%profile + if (allocated(settings%features)) then + do i = 1, min(size(settings%features),size(act_features)) + act_features(i) = settings%features(i)%s + end do + end if type is (fpm_run_settings) act_profile=settings%profile + if (allocated(settings%features)) then + do i = 1, min(size(settings%features),size(act_features)) + act_features(i) = settings%features(i)%s + end do + end if act_name=settings%name if (allocated(settings%args)) act_args=settings%args type is (fpm_test_settings) act_profile=settings%profile + if (allocated(settings%features)) then + do i = 1, min(size(settings%features),size(act_features)) + act_features(i) = settings%features(i)%s + end do + end if act_name=settings%name if (allocated(settings%args)) act_args=settings%args type is (fpm_clean_settings) From b3a97c4e1f94647169ef5167cc30a52c264c1ba7 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 7 Sep 2025 16:58:54 +0200 Subject: [PATCH 07/59] implement default profiles --- src/fpm/manifest/package.f90 | 7 ++++--- src/fpm/manifest/profiles.f90 | 27 ++++++++++++++++++++++++++- 2 files changed, 30 insertions(+), 4 deletions(-) diff --git a/src/fpm/manifest/package.f90 b/src/fpm/manifest/package.f90 index 624e519a23..37c3428a0c 100644 --- a/src/fpm/manifest/package.f90 +++ b/src/fpm/manifest/package.f90 @@ -36,7 +36,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, 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_fortran, only : fortran_config_t, new_fortran_config @@ -188,8 +188,9 @@ subroutine new_package(self, table, root, error) call new_profiles(self%profiles, child, error) if (allocated(error)) return else - ! Leave profiles unallocated for now - allocate(self%profiles(0)) + ! Set default profiles: debug = ["debug"], release = ["release"] + call get_default_profiles(self%profiles, error) + if (allocated(error)) return end if call get_value(table, "features", child, requested=.false.) diff --git a/src/fpm/manifest/profiles.f90 b/src/fpm/manifest/profiles.f90 index e3c162e8f0..e96248d833 100644 --- a/src/fpm/manifest/profiles.f90 +++ b/src/fpm/manifest/profiles.f90 @@ -21,7 +21,7 @@ module fpm_manifest_profile implicit none private - public :: profile_config_t, new_profile, new_profiles + public :: profile_config_t, new_profile, new_profiles, get_default_profiles !> Configuration data for a profile type, extends(serializable_t) :: profile_config_t @@ -238,4 +238,29 @@ subroutine load_from_toml(self, table, error) end subroutine load_from_toml + + !> Create default profiles with standard features + subroutine get_default_profiles(profiles, error) + + !> Instance of the profile configuration array + type(profile_config_t), allocatable, intent(out) :: profiles(:) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + ! Create two default profiles: debug and release + allocate(profiles(2)) + + ! Debug profile with "debug" feature + profiles(1)%name = "debug" + allocate(profiles(1)%features(1)) + profiles(1)%features(1)%s = "debug" + + ! Release profile with "release" feature + profiles(2)%name = "release" + allocate(profiles(2)%features(1)) + profiles(2)%features(1)%s = "release" + + end subroutine get_default_profiles + end module fpm_manifest_profile From bbbec6aa94d650953a6d9a9b83e8bed05ba0f6e7 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 7 Sep 2025 17:29:14 +0200 Subject: [PATCH 08/59] validate profiles; add default "debug" and "release" --- src/fpm/manifest/feature_collection.f90 | 116 ++++++++++++++---------- src/fpm/manifest/package.f90 | 103 +++++++++++++++++++-- src/fpm/manifest/profiles.f90 | 69 +++++++++++++- test/fpm_test/test_manifest.f90 | 11 ++- 4 files changed, 240 insertions(+), 59 deletions(-) diff --git a/src/fpm/manifest/feature_collection.f90 b/src/fpm/manifest/feature_collection.f90 index 8856270e2a..55220f8a54 100644 --- a/src/fpm/manifest/feature_collection.f90 +++ b/src/fpm/manifest/feature_collection.f90 @@ -25,7 +25,8 @@ module fpm_manifest_feature_collection private public :: new_collections, get_default_features, & - get_default_features_as_features, default_debug_feature, default_release_feature + default_debug_feature, default_release_feature, & + add_default_features !> Feature configuration data type, public, extends(serializable_t) :: feature_collection_t @@ -749,52 +750,6 @@ subroutine get_default_features(collections, error) end subroutine get_default_features - !> Convert feature collections to individual features (for backward compatibility) - subroutine get_default_features_as_features(features, error) - - !> Features array to populate (backward compatible) - type(feature_config_t), allocatable, intent(out) :: features(:) - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(feature_collection_t), allocatable :: collections(:) - integer :: total_features, ifeature, icol, ivar - - ! Get the feature collections - call get_default_features(collections, error) - if (allocated(error)) return - - ! Count total features needed - total_features = 0 - do icol = 1, size(collections) - total_features = total_features + 1 ! base feature - if (allocated(collections(icol)%variants)) then - total_features = total_features + size(collections(icol)%variants) - end if - end do - - ! Allocate features array - allocate(features(total_features)) - - ! Copy features from collections - ifeature = 1 - do icol = 1, size(collections) - ! Add base feature - features(ifeature) = collections(icol)%base - ifeature = ifeature + 1 - - ! Add variants - if (allocated(collections(icol)%variants)) then - do ivar = 1, size(collections(icol)%variants) - features(ifeature) = collections(icol)%variants(ivar) - ifeature = ifeature + 1 - end do - end if - end do - - end subroutine get_default_features_as_features - !> Helper to create a feature variant function default_variant(name, compiler_id, os_type, flags) result(feature) character(len=*), intent(in) :: name @@ -1055,5 +1010,72 @@ function extract_for_target(self, target) result(feature) end if end function extract_for_target + + + !> Add default features to existing features array if they don't already exist + subroutine add_default_features(features, error) + + !> Instance of the feature collections array (will be resized) + type(feature_collection_t), allocatable, intent(inout) :: features(:) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(feature_collection_t), allocatable :: temp_features(:) + type(feature_collection_t), allocatable :: default_features(:) + logical :: debug_exists, release_exists + integer :: i, current_size, new_size + + ! Get default features + call get_default_features(default_features, error) + if (allocated(error)) return + + ! Check if debug and release features already exist + debug_exists = .false. + release_exists = .false. + + if (allocated(features)) then + do i = 1, size(features) + if (allocated(features(i)%base%name)) then + if (features(i)%base%name == "debug") debug_exists = .true. + if (features(i)%base%name == "release") release_exists = .true. + end if + end do + current_size = size(features) + else + current_size = 0 + end if + + ! Calculate how many features to add + new_size = current_size + if (.not. debug_exists) new_size = new_size + 1 + if (.not. release_exists) new_size = new_size + 1 + + ! If nothing to add, return + if (new_size == current_size) return + + ! Create new array with existing + missing defaults + allocate(temp_features(new_size)) + + ! Copy existing features + if (current_size > 0) then + temp_features(1:current_size) = features(1:current_size) + end if + + ! Add missing defaults + i = current_size + if (.not. debug_exists) then + i = i + 1 + temp_features(i) = default_features(1) ! debug feature + end if + if (.not. release_exists) then + i = i + 1 + temp_features(i) = default_features(2) ! release feature + end if + + ! Replace the features array + call move_alloc(temp_features, features) + + end subroutine add_default_features end module fpm_manifest_feature_collection diff --git a/src/fpm/manifest/package.f90 b/src/fpm/manifest/package.f90 index 37c3428a0c..0a4c2d85f0 100644 --- a/src/fpm/manifest/package.f90 +++ b/src/fpm/manifest/package.f90 @@ -36,7 +36,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, get_default_profiles + use fpm_manifest_profile, only : profile_config_t, new_profiles, add_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_fortran, only : fortran_config_t, new_fortran_config @@ -45,7 +45,7 @@ module fpm_manifest_package use fpm_manifest_test, only : test_config_t, new_test use fpm_manifest_preprocess, only : preprocess_config_t, new_preprocessors use fpm_manifest_feature, only: feature_config_t, init_feature_components - use fpm_manifest_feature_collection, only: feature_collection_t, get_default_features, new_collections + use fpm_manifest_feature_collection, only: feature_collection_t, new_collections, add_default_features use fpm_manifest_platform, only: platform_config_t use fpm_strings, only: string_t use fpm_filesystem, only : exists, getline, join_path @@ -96,6 +96,9 @@ module fpm_manifest_package !> Export package configuration with features applied procedure :: export_config + !> Find feature by name, returns index or 0 if not found + procedure :: find_feature + end type package_config_t character(len=*), parameter, private :: class_name = 'package_config_t' @@ -188,9 +191,8 @@ subroutine new_package(self, table, root, error) call new_profiles(self%profiles, child, error) if (allocated(error)) return else - ! Set default profiles: debug = ["debug"], release = ["release"] - call get_default_profiles(self%profiles, error) - if (allocated(error)) return + ! No profiles defined - start with empty array + allocate(self%profiles(0)) end if call get_value(table, "features", child, requested=.false.) @@ -199,11 +201,21 @@ subroutine new_package(self, table, root, error) call new_collections(self%features, child, error) if (allocated(error)) return else - ! Initialize with default feature collections (debug and release) - call get_default_features(self%features, error) - if (allocated(error)) return + ! No features defined - start with empty array + allocate(self%features(0)) end if + ! Add default features and profiles if they don't already exist + call add_default_features(self%features, error) + if (allocated(error)) return + + call add_default_profiles(self%profiles, error) + if (allocated(error)) return + + ! Validate profiles after all features and profiles have been loaded + call validate_profiles(self, error) + if (allocated(error)) return + end subroutine new_package @@ -581,4 +593,79 @@ type(package_config_t) function export_config(self, platform, features) result(c end function export_config + !> Find feature by name, returns index or 0 if not found + function find_feature(self, feature_name) result(idx) + + !> Instance of the package configuration + class(package_config_t), intent(in) :: self + + !> Name of the feature to find + character(len=*), intent(in) :: feature_name + + !> Index of the feature (0 if not found) + integer :: idx + + integer :: i + + idx = 0 + + ! Check if features are allocated + if (.not. allocated(self%features)) return + + ! Search through features array + do i = 1, size(self%features) + if (allocated(self%features(i)%base%name)) then + if (self%features(i)%base%name == feature_name) then + idx = i + return + end if + end if + end do + + end function find_feature + + + !> Validate profiles - check for duplicate names and valid feature references + subroutine validate_profiles(self, error) + + !> Instance of the package configuration + class(package_config_t), intent(in) :: self + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: i, j + + ! Check if profiles are allocated + if (.not. allocated(self%profiles)) return + + ! Check for duplicate profile names + do i = 1, size(self%profiles) + do j = i + 1, size(self%profiles) + if (allocated(self%profiles(i)%name) .and. allocated(self%profiles(j)%name)) then + if (self%profiles(i)%name == self%profiles(j)%name) then + call syntax_error(error, "Duplicate profile name '" // self%profiles(i)%name // "'") + return + end if + end if + end do + end do + + ! Check that all profile features reference valid features + do i = 1, size(self%profiles) + if (allocated(self%profiles(i)%features)) then + do j = 1, size(self%profiles(i)%features) + ! Check if feature exists (case sensitive) + if (self%find_feature(self%profiles(i)%features(j)%s) == 0) then + call syntax_error(error, "Profile '" // self%profiles(i)%name // & + "' references undefined feature '" // self%profiles(i)%features(j)%s // "'") + return + end if + end do + end if + end do + + end subroutine validate_profiles + + end module fpm_manifest_package diff --git a/src/fpm/manifest/profiles.f90 b/src/fpm/manifest/profiles.f90 index e96248d833..36133f2ab2 100644 --- a/src/fpm/manifest/profiles.f90 +++ b/src/fpm/manifest/profiles.f90 @@ -21,7 +21,7 @@ module fpm_manifest_profile implicit none private - public :: profile_config_t, new_profile, new_profiles, get_default_profiles + public :: profile_config_t, new_profile, new_profiles, get_default_profiles, add_default_profiles !> Configuration data for a profile type, extends(serializable_t) :: profile_config_t @@ -263,4 +263,71 @@ subroutine get_default_profiles(profiles, error) end subroutine get_default_profiles + + !> Add default profiles to existing profiles array if they don't already exist + subroutine add_default_profiles(profiles, error) + + !> Instance of the profile configuration array (will be resized) + type(profile_config_t), allocatable, intent(inout) :: profiles(:) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(profile_config_t), allocatable :: temp_profiles(:) + type(profile_config_t), allocatable :: default_profiles(:) + logical :: debug_exists, release_exists + integer :: i, current_size, new_size + + ! Get default profiles + call get_default_profiles(default_profiles, error) + if (allocated(error)) return + + ! Check if debug and release profiles already exist + debug_exists = .false. + release_exists = .false. + + if (allocated(profiles)) then + do i = 1, size(profiles) + if (allocated(profiles(i)%name)) then + if (profiles(i)%name == "debug") debug_exists = .true. + if (profiles(i)%name == "release") release_exists = .true. + end if + end do + current_size = size(profiles) + else + current_size = 0 + end if + + ! Calculate how many profiles to add + new_size = current_size + if (.not. debug_exists) new_size = new_size + 1 + if (.not. release_exists) new_size = new_size + 1 + + ! If nothing to add, return + if (new_size == current_size) return + + ! Create new array with existing + missing defaults + allocate(temp_profiles(new_size)) + + ! Copy existing profiles + if (current_size > 0) then + temp_profiles(1:current_size) = profiles(1:current_size) + end if + + ! Add missing defaults + i = current_size + if (.not. debug_exists) then + i = i + 1 + temp_profiles(i) = default_profiles(1) ! debug profile + end if + if (.not. release_exists) then + i = i + 1 + temp_profiles(i) = default_profiles(2) ! release profile + end if + + ! Replace the profiles array + call move_alloc(temp_profiles, profiles) + + end subroutine add_default_profiles + end module fpm_manifest_profile diff --git a/test/fpm_test/test_manifest.f90 b/test/fpm_test/test_manifest.f90 index 68a6a431f7..1f2d37306c 100644 --- a/test/fpm_test/test_manifest.f90 +++ b/test/fpm_test/test_manifest.f90 @@ -550,7 +550,11 @@ subroutine test_profiles(error) & '[profiles]', & & 'development = ["debug", "testing"]', & & 'release = ["optimized"]', & - & 'full-test = ["debug", "testing", "benchmarks"]' + & 'full-test = ["debug", "testing", "benchmarks"]', & + & '[features]', & + & 'testing.flags = " -g"', & + & 'optimized.flags = " -O2"', & + & 'benchmarks.flags = " -O3"' close(unit) call get_package_data(package, manifest, error) @@ -566,8 +570,9 @@ subroutine test_profiles(error) return end if - if (size(package%profiles) /= 3) then - call test_failed(error, "Unexpected number of profiles, should be 3") + ! debug, release, development, full-test + if (size(package%profiles) /= 4) then + call test_failed(error, "Unexpected number of profiles, should be 4") return end if From 9c4cac1c8d41d1e990bfb82396db86ccfb8701ad Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 7 Sep 2025 17:40:24 +0200 Subject: [PATCH 09/59] feature collection: extend export_config --- src/fpm.f90 | 6 +++-- src/fpm/manifest/feature_collection.f90 | 32 ++++++++++++++++++++++++- src/fpm/manifest/package.f90 | 16 +++++++++++-- 3 files changed, 49 insertions(+), 5 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 400ef5322a..435d980512 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -82,7 +82,8 @@ subroutine build_model(model, settings, package_config, error) model%include_tests = settings%build_tests ! Extract the current package configuration request - package = package_config%export_config(target_platform) + package = package_config%export_config(target_platform,error=error) + if (allocated(error)) return ! Resolve meta-dependencies into the package and the model call resolve_metapackages(model,package,settings,error) @@ -128,7 +129,8 @@ subroutine build_model(model, settings, package_config, error) if (allocated(error)) exit ! Adapt it to the current profile/platform - dependency = dependency_config%export_config(target_platform) + dependency = dependency_config%export_config(target_platform,error=error) + if (allocated(error)) exit manifest => dependency end if diff --git a/src/fpm/manifest/feature_collection.f90 b/src/fpm/manifest/feature_collection.f90 index 55220f8a54..9347f5fcdb 100644 --- a/src/fpm/manifest/feature_collection.f90 +++ b/src/fpm/manifest/feature_collection.f90 @@ -26,7 +26,7 @@ module fpm_manifest_feature_collection public :: new_collections, get_default_features, & default_debug_feature, default_release_feature, & - add_default_features + add_default_features, collection_from_feature !> Feature configuration data type, public, extends(serializable_t) :: feature_collection_t @@ -49,6 +49,11 @@ module fpm_manifest_feature_collection end type feature_collection_t + !> Interface for feature_collection_t constructor + interface feature_collection_t + module procedure collection_from_feature + end interface feature_collection_t + contains !> Equality (semantic): base and variants (size + element-wise) @@ -1077,5 +1082,30 @@ subroutine add_default_features(features, error) call move_alloc(temp_features, features) end subroutine add_default_features + + + !> Create a feature collection from a single feature_config_t + !> The feature becomes the base configuration for all OS/compiler combinations + type(feature_collection_t) function collection_from_feature(self) result(collection) + + !> Feature configuration to convert + class(feature_config_t), intent(in) :: self + + ! Copy the feature into the base configuration + collection%base = self + + ! Set platform to all OS and all compilers for the base + collection%base%platform%os_type = OS_ALL + collection%base%platform%compiler = id_all + + ! Copy the name if available + if (allocated(self%name)) then + collection%base%name = self%name + end if + + ! No variants initially - just the base configuration + ! (variants can be added later if needed) + + end function collection_from_feature end module fpm_manifest_feature_collection diff --git a/src/fpm/manifest/package.f90 b/src/fpm/manifest/package.f90 index 0a4c2d85f0..bf4ade9cb1 100644 --- a/src/fpm/manifest/package.f90 +++ b/src/fpm/manifest/package.f90 @@ -551,7 +551,7 @@ subroutine load_from_toml(self, table, error) end subroutine load_from_toml !> Export package configuration for a given (OS+compiler) platform - type(package_config_t) function export_config(self, platform, features) result(cfg) + type(package_config_t) function export_config(self, platform, features, profile, error) result(cfg) !> Instance of the package configuration class(package_config_t), intent(in) :: self @@ -559,9 +559,21 @@ type(package_config_t) function export_config(self, platform, features) result(c !> Target platform type(platform_config_t), intent(in) :: platform - !> Optional list of features to apply (currently idle) + !> Optional list of features to apply (cannot be used with profile) type(string_t), optional, intent(in) :: features(:) + !> Optional profile name to apply (cannot be used with features) + character(len=*), optional, intent(in) :: profile + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + ! Validate that both profile and features are not specified simultaneously + if (present(profile) .and. present(features)) then + call syntax_error(error, "Cannot specify both 'profile' and 'features' parameters simultaneously") + return + end if + ! Copy the entire package configuration cfg = self From 1f4a489ba1742ef0a2c465033e89397abe8d3329 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 7 Sep 2025 18:01:03 +0200 Subject: [PATCH 10/59] merge features into package configuration --- src/fpm.f90 | 2 +- src/fpm/manifest/feature_collection.f90 | 36 +++++++++--- src/fpm/manifest/package.f90 | 74 +++++++++++++++++++++++-- test/fpm_test/test_features.f90 | 30 ++++++---- 4 files changed, 116 insertions(+), 26 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 435d980512..063cca2dd5 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -82,7 +82,7 @@ subroutine build_model(model, settings, package_config, error) model%include_tests = settings%build_tests ! Extract the current package configuration request - package = package_config%export_config(target_platform,error=error) + package = package_config%export_config(target_platform,settings%features,settings%profile,error) if (allocated(error)) return ! Resolve meta-dependencies into the package and the model diff --git a/src/fpm/manifest/feature_collection.f90 b/src/fpm/manifest/feature_collection.f90 index 9347f5fcdb..3164973013 100644 --- a/src/fpm/manifest/feature_collection.f90 +++ b/src/fpm/manifest/feature_collection.f90 @@ -46,6 +46,7 @@ module fpm_manifest_feature_collection procedure :: push_variant procedure :: extract_for_target procedure :: check => check_collection + procedure :: merge_into_package end type feature_collection_t @@ -987,16 +988,37 @@ subroutine simulate_merge(target, source) target%library = source%library end if end subroutine simulate_merge + + !> Merge a feature configuration into an existing global package + subroutine merge_into_package(self, package, target, error) + class(feature_collection_t), intent(in) :: self + + class(feature_config_t), intent(inout) :: package + + type(platform_config_t), intent(in) :: target + + type(error_t), allocatable, intent(out) :: error + + type(feature_config_t) :: feature + + ! Extract the feature configuration for the target platform + feature = self%extract_for_target(target, error) + if (allocated(error)) return + + ! Merge the extracted feature into the package + call merge_feature_configs(package, feature, error) + if (allocated(error)) return + + end subroutine merge_into_package !> Extract a merged feature configuration for the given target platform - function extract_for_target(self, target) result(feature) + type(feature_config_t) function extract_for_target(self, target, error) result(feature) class(feature_collection_t), intent(in) :: self type(platform_config_t), intent(in) :: target - type(feature_config_t) :: feature + type(error_t), allocatable, intent(out) :: error integer :: i - type(error_t), allocatable :: error - + ! Start with base feature as foundation feature = self%base @@ -1006,17 +1028,13 @@ function extract_for_target(self, target) result(feature) if (self%variants(i)%platform%matches(target)) then ! Merge this variant into the feature call merge_feature_configs(feature, self%variants(i), error) - if (allocated(error)) then - ! If merge fails, just continue with what we have - deallocate(error) - end if + if (allocated(error)) return end if end do end if end function extract_for_target - !> Add default features to existing features array if they don't already exist subroutine add_default_features(features, error) diff --git a/src/fpm/manifest/package.f90 b/src/fpm/manifest/package.f90 index bf4ade9cb1..872d2a74db 100644 --- a/src/fpm/manifest/package.f90 +++ b/src/fpm/manifest/package.f90 @@ -554,13 +554,13 @@ end subroutine load_from_toml type(package_config_t) function export_config(self, platform, features, profile, error) result(cfg) !> Instance of the package configuration - class(package_config_t), intent(in) :: self + class(package_config_t), intent(in), target :: self !> Target platform type(platform_config_t), intent(in) :: platform !> Optional list of features to apply (cannot be used with profile) - type(string_t), optional, intent(in) :: features(:) + type(string_t), optional, intent(in), target :: features(:) !> Optional profile name to apply (cannot be used with features) character(len=*), optional, intent(in) :: profile @@ -568,6 +568,9 @@ type(package_config_t) function export_config(self, platform, features, profile, !> Error handling type(error_t), allocatable, intent(out) :: error + integer :: i, idx + type(string_t), pointer :: want_features(:) + ! Validate that both profile and features are not specified simultaneously if (present(profile) .and. present(features)) then call syntax_error(error, "Cannot specify both 'profile' and 'features' parameters simultaneously") @@ -577,6 +580,38 @@ type(package_config_t) function export_config(self, platform, features, profile, ! Copy the entire package configuration cfg = self + ! TODO: Feature processing will be implemented here + ! For now, features parameter is ignored as requested + if (present(features)) then + want_features => features + elseif (present(profile)) then + idx = find_profile(self, profile) + if (idx<=0) then + call fatal_error(error, "Cannot find profile "//profile) + return + end if + want_features => self%profiles(idx)%features + else + nullify(want_features) + endif + + apply_features: if (associated(want_features)) then + do i=1,size(want_features) + + ! Find feature + idx = self%find_feature(want_features(i)%s) + if (idx<=0) then + call fatal_error(error, "Cannot find feature "//want_features(i)%s) + return + end if + + ! Add it to the current configuration + call self%features(idx)%merge_into_package(cfg, platform, error) + if (allocated(error)) return + + end do + end if apply_features + ! Ensure allocatable fields are always allocated with default values if not already set if (.not. allocated(cfg%build)) then allocate(cfg%build) @@ -597,13 +632,40 @@ type(package_config_t) function export_config(self, platform, features, profile, cfg%fortran%implicit_typing = .false. cfg%fortran%implicit_external = .false. cfg%fortran%source_form = 'free' - end if - - ! TODO: Feature processing will be implemented here - ! For now, features parameter is ignored as requested + end if end function export_config + !> Find profile by name, returns index or 0 if not found + function find_profile(self, profile_name) result(idx) + + !> Instance of the package configuration + class(package_config_t), intent(in) :: self + + !> Name of the feature to find + character(len=*), intent(in) :: profile_name + + !> Index of the feature (0 if not found) + integer :: idx + + integer :: i + + idx = 0 + + ! Check if features are allocated + if (.not. allocated(self%profiles)) return + + ! Search through features array + do i = 1, size(self%profiles) + if (allocated(self%profiles(i)%name)) then + if (self%profiles(i)%name == profile_name) then + idx = i + return + end if + end if + end do + + end function find_profile !> Find feature by name, returns index or 0 if not found function find_feature(self, feature_name) result(idx) diff --git a/test/fpm_test/test_features.f90 b/test/fpm_test/test_features.f90 index 8743517c4c..b3a1cbd26d 100644 --- a/test/fpm_test/test_features.f90 +++ b/test/fpm_test/test_features.f90 @@ -271,7 +271,8 @@ subroutine test_feature_collection_extract(error) ! Test extraction for gfortran on linux target_platform%compiler = id_gcc target_platform%os_type = OS_LINUX - extracted_feature = package%features(i)%extract_for_target(target_platform) + extracted_feature = package%features(i)%extract_for_target(target_platform, error=error) + if (allocated(error)) return ! Should have both base and gfortran-specific flags if (.not. allocated(extracted_feature%flags)) then @@ -288,7 +289,8 @@ subroutine test_feature_collection_extract(error) ! Test extraction for ifort target_platform%compiler = id_intel_classic_nix - extracted_feature = package%features(i)%extract_for_target(target_platform) + extracted_feature = package%features(i)%extract_for_target(target_platform, error=error) + if (allocated(error)) return if (.not. allocated(extracted_feature%flags)) then call test_failed(error, "Extracted ifort feature missing flags") @@ -458,7 +460,8 @@ subroutine test_feature_flag_addition(error) ! Test extraction for gfortran on linux (should get all three flags) target_platform%compiler = id_gcc target_platform%os_type = OS_LINUX - extracted_feature = package%features(i)%extract_for_target(target_platform) + extracted_feature = package%features(i)%extract_for_target(target_platform, error=error) + if (allocated(error)) return ! Should have flags from base, gfortran, and linux variants if (.not. allocated(extracted_feature%flags)) then @@ -530,7 +533,8 @@ subroutine test_feature_metapackage_addition(error) ! Test extraction for gfortran on linux (should get all three metapackages) target_platform%compiler = id_gcc target_platform%os_type = OS_LINUX - extracted_feature = package%features(i)%extract_for_target(target_platform) + extracted_feature = package%features(i)%extract_for_target(target_platform, error=error) + if (allocated(error)) return if (.not. package%features(i)%base%meta%openmp%on) then call test_failed(error, "Missing base openmp metapackage") @@ -604,7 +608,8 @@ subroutine test_feature_extract_gfortran_linux(error) do i = 1, size(package%features) if (package%features(i)%base%name == "debug") then target_platform = platform_config_t(id_gcc, OS_LINUX) - extracted_feature = package%features(i)%extract_for_target(target_platform) + extracted_feature = package%features(i)%extract_for_target(target_platform, error=error) + if (allocated(error)) return ! Check flags are combined correctly if (.not. allocated(extracted_feature%flags)) then @@ -688,7 +693,8 @@ subroutine test_feature_extract_ifort_windows(error) do i = 1, size(package%features) if (package%features(i)%base%name == "debug") then target_platform = platform_config_t("ifort", OS_WINDOWS) - extracted_feature = package%features(i)%extract_for_target(target_platform) + extracted_feature = package%features(i)%extract_for_target(target_platform, error=error) + if (allocated(error)) return ! Check flags: should have base + ifort + windows (but NOT linux) if (.not. allocated(extracted_feature%flags)) then @@ -781,7 +787,8 @@ subroutine test_feature_extract_dependencies_examples(error) do i = 1, size(package%features) if (package%features(i)%base%name == "testing") then target_platform = platform_config_t(id_gcc, OS_MACOS) - extracted_feature = package%features(i)%extract_for_target(target_platform) + extracted_feature = package%features(i)%extract_for_target(target_platform, error=error) + if (allocated(error)) return ! Check that all dependencies are combined (base + gfortran + macos) if (.not. allocated(extracted_feature%dependency)) then @@ -870,7 +877,8 @@ subroutine test_feature_extract_build_configs(error) do i = 1, size(package%features) if (package%features(i)%base%name == "optimization") then target_platform = platform_config_t(id_intel_classic_nix, OS_LINUX) - extracted_feature = package%features(i)%extract_for_target(target_platform) + extracted_feature = package%features(i)%extract_for_target(target_platform, error=error) + if (allocated(error)) return ! Check that build config is present if (.not. allocated(extracted_feature%build)) then @@ -952,7 +960,8 @@ subroutine test_feature_extract_test_configs(error) do i = 1, size(package%features) if (package%features(i)%base%name == "testing") then target_platform = platform_config_t(id_gcc, OS_WINDOWS) - extracted_feature = package%features(i)%extract_for_target(target_platform) + extracted_feature = package%features(i)%extract_for_target(target_platform, error=error) + if (allocated(error)) return ! Check that all test configs are combined (base + gfortran + windows + gfortran.windows) if (.not. allocated(extracted_feature%test) .or. size(extracted_feature%test) < 4) then @@ -1045,7 +1054,8 @@ subroutine test_feature_extract_example_configs(error) do i = 1, size(package%features) if (package%features(i)%base%name == "showcase") then target_platform = platform_config_t(id_intel_llvm_nix, OS_MACOS) - extracted_feature = package%features(i)%extract_for_target(target_platform) + extracted_feature = package%features(i)%extract_for_target(target_platform, error=error) + if (allocated(error)) return ! Check that all example configs are combined (base + ifx + macos + ifx.macos) if (.not. allocated(extracted_feature%example) .or. size(extracted_feature%example) < 4) then From 07988e1e1fc54d2e0a3c88365f42070f1c1c28d0 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 7 Sep 2025 18:40:10 +0200 Subject: [PATCH 11/59] implement features in the dependency config --- src/fpm/dependency.f90 | 2 +- src/fpm/manifest/dependency.f90 | 33 ++++++- src/fpm/manifest/package.f90 | 5 +- src/fpm/toml.f90 | 5 +- test/fpm_test/test_manifest.f90 | 169 ++++++++++++++++++++++++++++++++ 5 files changed, 206 insertions(+), 8 deletions(-) diff --git a/src/fpm/dependency.f90 b/src/fpm/dependency.f90 index a136fb0a7a..dee4fd750d 100644 --- a/src/fpm/dependency.f90 +++ b/src/fpm/dependency.f90 @@ -96,7 +96,7 @@ module fpm_dependency logical :: update = .false. !> Dependency was loaded from a cache logical :: cached = .false. - !> Package dependencies of this node + !> Internal: package dependencies of this node type(string_t), allocatable :: package_dep(:) contains diff --git a/src/fpm/manifest/dependency.f90 b/src/fpm/manifest/dependency.f90 index c2bfa619a0..b03d545c4d 100644 --- a/src/fpm/manifest/dependency.f90 +++ b/src/fpm/manifest/dependency.f90 @@ -28,7 +28,7 @@ module fpm_manifest_dependency & git_target_revision, git_target_default, git_matches_manifest use tomlf, only: toml_table, toml_key, toml_stat use fpm_toml, only: get_value, check_keys, serializable_t, add_table, & - & set_value, set_string + & set_value, set_string, get_list, set_list use fpm_filesystem, only: windows_path, join_path use fpm_environment, only: get_os_type, OS_WINDOWS use fpm_manifest_metapackages, only: metapackage_config_t, is_meta_package, new_meta_config, & @@ -62,6 +62,9 @@ module fpm_manifest_dependency !> Requested macros for the dependency type(preprocess_config_t), allocatable :: preprocess(:) + + !> Requested features for the dependency + type(string_t), allocatable :: features(:) !> Git descriptor type(git_target_t), allocatable :: git @@ -128,6 +131,10 @@ subroutine new_dependency(self, table, root, error) call new_preprocessors(self%preprocess, child, error) if (allocated(error)) return endif + + !> Get optional features list + call get_list(table, "features", self%features, error) + if (allocated(error)) return call get_value(table, "path", uri) if (allocated(uri)) then @@ -176,6 +183,7 @@ subroutine check(table, error) type(error_t), allocatable, intent(out) :: error character(len=:), allocatable :: name + type(string_t), allocatable :: string_list(:) type(toml_key), allocatable :: list(:) type(toml_table), pointer :: child @@ -188,7 +196,8 @@ subroutine check(table, error) "tag", & "branch", & "rev", & - "preprocess" & + "preprocess", & + "features" & & ] call table%get_key(name) @@ -243,7 +252,7 @@ subroutine check(table, error) end if end if - + end subroutine check !> Construct new dependency array from a TOML data structure @@ -341,7 +350,7 @@ subroutine info(self, unit, verbosity) !> Verbosity of the printout integer, intent(in), optional :: verbosity - integer :: pr + integer :: pr, ilink character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)' if (present(verbosity)) then @@ -365,6 +374,13 @@ subroutine info(self, unit, verbosity) write (unit, fmt) "- path", self%path end if + if (allocated(self%features)) then + write(unit, fmt) " - features" + do ilink = 1, size(self%features) + write(unit, fmt) " - " // self%features(ilink)%s + end do + end if + end subroutine info !> Check if two dependency configurations are different @@ -401,6 +417,7 @@ elemental subroutine dependency_destroy(self) if (allocated(self%namespace)) deallocate(self%namespace) if (allocated(self%requested_version)) deallocate(self%requested_version) if (allocated(self%git)) deallocate(self%git) + if (allocated(self%features)) deallocate(self%features) end subroutine dependency_destroy @@ -430,6 +447,10 @@ logical function dependency_is_same(this,that) if (allocated(this%requested_version)) then if (.not.(this%requested_version==other%requested_version)) return endif + if (allocated(this%features).neqv.allocated(other%features)) return + if (allocated(this%features)) then + if (.not.(this%features==other%features)) return + endif if ((allocated(this%git).neqv.allocated(other%git))) return if (allocated(this%git)) then @@ -471,6 +492,8 @@ subroutine dump_to_toml(self, table, error) call set_string(table, "requested_version", self%requested_version%s(), error, 'dependency_config_t') if (allocated(error)) return endif + call set_list(table, "features", self%features, error) + if (allocated(error)) return if (allocated(self%git)) then call add_table(table, "git", ptr, error) @@ -513,6 +536,8 @@ subroutine load_from_toml(self, table, error) return endif end if + call get_list(table, "features", self%features, error) + if (allocated(error)) return call table%get_keys(list) add_git: do ii = 1, size(list) diff --git a/src/fpm/manifest/package.f90 b/src/fpm/manifest/package.f90 index 872d2a74db..c454f058ec 100644 --- a/src/fpm/manifest/package.f90 +++ b/src/fpm/manifest/package.f90 @@ -587,7 +587,7 @@ type(package_config_t) function export_config(self, platform, features, profile, elseif (present(profile)) then idx = find_profile(self, profile) if (idx<=0) then - call fatal_error(error, "Cannot find profile "//profile) + call fatal_error(error, "Cannot find profile "//profile//" in package "//self%name) return end if want_features => self%profiles(idx)%features @@ -601,7 +601,8 @@ type(package_config_t) function export_config(self, platform, features, profile, ! Find feature idx = self%find_feature(want_features(i)%s) if (idx<=0) then - call fatal_error(error, "Cannot find feature "//want_features(i)%s) + call fatal_error(error, "Cannot find feature "//want_features(i)%s//& + " in package "//self%name) return end if diff --git a/src/fpm/toml.f90 b/src/fpm/toml.f90 index af3f93353e..ce4d91a340 100644 --- a/src/fpm/toml.f90 +++ b/src/fpm/toml.f90 @@ -821,7 +821,10 @@ subroutine check_keys(table, valid_keys, error) end if ! Check if value can be mapped or else (wrong type) show error message with the error location. - ! Right now, it can only be mapped to a string or to a child node, but this can be extended in the future. + ! Right now, it can only be mapped to a string or to a list or a child node, but this can be + ! extended in the future. + if (has_list(table, keys(ikey)%key)) cycle + call get_value(table, keys(ikey)%key, value) if (.not. allocated(value)) then diff --git a/test/fpm_test/test_manifest.f90 b/test/fpm_test/test_manifest.f90 index 1f2d37306c..43ffb305f9 100644 --- a/test/fpm_test/test_manifest.f90 +++ b/test/fpm_test/test_manifest.f90 @@ -38,6 +38,9 @@ subroutine collect_manifest(testsuite) & new_unittest("dependency-invalid-git", test_dependency_invalid_git, should_fail=.true.), & & new_unittest("dependency-no-namespace", test_dependency_no_namespace, should_fail=.true.), & & new_unittest("dependency-redundant-v", test_dependency_redundant_v, should_fail=.true.), & + & new_unittest("dependency-features-present", test_dependency_features_present), & + & new_unittest("dependency-features-absent", test_dependency_features_absent), & + & new_unittest("dependency-features-empty", test_dependency_features_empty), & & 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.), & @@ -1559,4 +1562,170 @@ subroutine test_macro_parsing_dependency(error) end subroutine test_macro_parsing_dependency + !> Ensure dependency "features" array is correctly parsed when present + subroutine test_dependency_features_present(error) + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_config_t) :: package + character(:), allocatable :: temp_file + integer :: unit, i, idx_dep0, idx_dep1, idx_dep2 + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'name = "example"', & + & 'version = "0.1.0"', & + & '[dependencies]', & + & '"dep0" = { path = "local/dep0", features = ["featA", "featB"] }', & + & '"dep1" = { git = "https://example.com/repo.git", tag = "v1.2.3", features = ["only"] }', & + & '"dep2" = { path = "other/dep2" }' + close(unit) + + call get_package_data(package, temp_file, error) + if (allocated(error)) return + + if (.not.allocated(package%dependency)) then + call test_failed(error, 'No dependencies parsed from manifest') + return + end if + + idx_dep0 = 0; idx_dep1 = 0; idx_dep2 = 0 + do i = 1, size(package%dependency) + select case (package%dependency(i)%name) + case ('dep0'); idx_dep0 = i + case ('dep1'); idx_dep1 = i + case ('dep2'); idx_dep2 = i + end select + end do + + if (idx_dep0 == 0 .or. idx_dep1 == 0 .or. idx_dep2 == 0) then + call test_failed(error, 'Expected dependencies dep0/dep1/dep2 not found') + return + end if + + ! dep0: features = ["featA","featB"] + if (.not.allocated(package%dependency(idx_dep0)%features)) then + call test_failed(error, 'dep0 features not allocated') + return + end if + if (size(package%dependency(idx_dep0)%features) /= 2) then + call test_failed(error, 'dep0 features size /= 2') + return + end if + if (package%dependency(idx_dep0)%features(1)%s /= 'featA' .or. & + & package%dependency(idx_dep0)%features(2)%s /= 'featB') then + call test_failed(error, 'dep0 features values mismatch') + return + end if + + ! dep1: features = ["only"] + if (.not.allocated(package%dependency(idx_dep1)%features)) then + call test_failed(error, 'dep1 features not allocated') + return + end if + if (size(package%dependency(idx_dep1)%features) /= 1) then + call test_failed(error, 'dep1 features size /= 1') + return + end if + if (package%dependency(idx_dep1)%features(1)%s /= 'only') then + call test_failed(error, 'dep1 features value mismatch') + return + end if + + ! dep2: no features key -> should be NOT allocated + if (allocated(package%dependency(idx_dep2)%features)) then + call test_failed(error, 'dep2 features should be unallocated when key is absent') + return + end if + end subroutine test_dependency_features_present + + + !> Ensure a dependency without "features" key is accepted (no allocation) + subroutine test_dependency_features_absent(error) + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_config_t) :: package + character(:), allocatable :: temp_file + integer :: unit, i + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'name = "example"', & + & '[dependencies]', & + & '"a" = { path = "a" }', & + & '"b" = { git = "https://example.org/b.git", branch = "main" }' + close(unit) + + call get_package_data(package, temp_file, error) + if (allocated(error)) return + + if (.not.allocated(package%dependency)) then + call test_failed(error, 'No dependencies parsed from manifest') + return + end if + + do i = 1, size(package%dependency) + if (allocated(package%dependency(i)%features)) then + call test_failed(error, 'features should be unallocated when not specified') + return + end if + end do + end subroutine test_dependency_features_absent + + + !> Accept an explicit empty "features = []" list + subroutine test_dependency_features_empty(error) + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_config_t) :: package + character(:), allocatable :: temp_file + integer :: unit, i, idx + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'name = "example"', & + & '[dependencies]', & + & '"empty" = { path = "local/empty", features = [] }' + close(unit) + + call get_package_data(package, temp_file, error) + if (allocated(error)) return + + idx = -1 + if (.not.allocated(package%dependency)) then + call test_failed(error, 'No dependencies parsed from manifest') + return + end if + + do i = 1, size(package%dependency) + if (package%dependency(i)%name == 'empty') then + idx = i + exit + end if + end do + + if (idx < 1) then + call test_failed(error, 'Dependency "empty" not found') + return + end if + + if (.not.allocated(package%dependency(idx)%features)) then + call test_failed(error, 'features should be allocated (size=0) for empty list') + return + end if + if (size(package%dependency(idx)%features) /= 0) then + call test_failed(error, 'features size should be zero for empty list') + return + end if + end subroutine test_dependency_features_empty + + end module test_manifest From cc73d56732918ebbfc150b8be5428e587d31ced5 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 7 Sep 2025 20:31:44 +0200 Subject: [PATCH 12/59] apply features to the dependency config --- src/fpm.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 063cca2dd5..ccddc2bd48 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -129,7 +129,8 @@ subroutine build_model(model, settings, package_config, error) if (allocated(error)) exit ! Adapt it to the current profile/platform - dependency = dependency_config%export_config(target_platform,error=error) + dependency = dependency_config%export_config(target_platform, & + dep%features,error=error) if (allocated(error)) exit manifest => dependency From 546482b828f50be863188d0ba944dae0aa5a4621 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 7 Sep 2025 21:38:49 +0200 Subject: [PATCH 13/59] test dependency propagation --- test/fpm_test/test_features.f90 | 198 +++++++++++++++++++++++++++++++- 1 file changed, 197 insertions(+), 1 deletion(-) diff --git a/test/fpm_test/test_features.f90 b/test/fpm_test/test_features.f90 index b3a1cbd26d..4fcc02e31e 100644 --- a/test/fpm_test/test_features.f90 +++ b/test/fpm_test/test_features.f90 @@ -39,7 +39,9 @@ subroutine collect_features(testsuite) & new_unittest("feature-extract-dependencies-examples", test_feature_extract_dependencies_examples), & & new_unittest("feature-extract-build-configs", test_feature_extract_build_configs), & & new_unittest("feature-extract-test-configs", test_feature_extract_test_configs), & - & new_unittest("feature-extract-example-configs", test_feature_extract_example_configs) & + & new_unittest("feature-extract-example-configs", test_feature_extract_example_configs), & + & new_unittest("dependency-feature-propagation", test_dependency_feature_propagation), & + & new_unittest("dependency-features-specification", test_dependency_features_specification) & & ] end subroutine collect_features @@ -1107,4 +1109,198 @@ subroutine test_feature_extract_example_configs(error) end subroutine test_feature_extract_example_configs + !> Test that dependency features are correctly propagated and applied + subroutine test_dependency_feature_propagation(error) + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_config_t) :: dependency_config, exported_config + character(:), allocatable :: temp_file + integer :: unit + type(platform_config_t) :: target_platform + type(string_t), allocatable :: test_features(:) + + allocate(temp_file, source=get_temp_filename()) + + ! Create a dependency manifest with features + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'name = "test-dependency"', & + & 'version = "0.1.0"', & + & '[features]', & + & 'debug.flags = "-g -DDEBUG"', & + & 'debug.gfortran.flags = "-fcheck=bounds"', & + & 'mpi.flags = "-DUSE_MPI"', & + & 'mpi.dependencies.mpi = "*"', & + & '[[features.debug.executable]]', & + & 'name = "debug_tool"', & + & 'source-dir = "debug_tools"' + close(unit) + + ! Load the dependency configuration + call get_package_data(dependency_config, temp_file, error) + if (allocated(error)) return + + ! Simulate dependency requesting specific features (like dep%features from build_model) + allocate(test_features(2)) + test_features(1)%s = "debug" + test_features(2)%s = "mpi" + + ! Test export_config with these features (mimics line 132-133 in fpm.f90) + target_platform = platform_config_t(id_gcc, OS_LINUX) + exported_config = dependency_config%export_config(target_platform, test_features, error=error) + if (allocated(error)) return + + ! Verify that debug feature flags were applied + if (.not. allocated(exported_config%flags)) then + call test_failed(error, "Dependency export_config missing flags from debug feature") + return + end if + + if (index(exported_config%flags, "-g") == 0 .or. & + index(exported_config%flags, "-DDEBUG") == 0) then + call test_failed(error, "Dependency missing debug flags: got '" // exported_config%flags // "'") + return + end if + + if (index(exported_config%flags, "-fcheck=bounds") == 0) then + call test_failed(error, "Dependency missing gfortran-specific debug flags") + return + end if + + ! Verify that mpi feature flags were applied + if (index(exported_config%flags, "-DUSE_MPI") == 0) then + call test_failed(error, "Dependency missing mpi flags") + return + end if + + ! Verify that mpi metapackage was enabled + if (.not. exported_config%meta%mpi%on) then + call test_failed(error, "Dependency mpi metapackage not enabled") + return + end if + + ! Verify that debug executable was included + if (.not. allocated(exported_config%executable)) then + call test_failed(error, "Dependency debug executable not included") + return + end if + + if (size(exported_config%executable) < 1) then + call test_failed(error, "Dependency should have debug executable") + return + end if + + if (exported_config%executable(1)%name /= "debug_tool") then + call test_failed(error, "Dependency debug executable has wrong name") + return + end if + + end subroutine test_dependency_feature_propagation + + !> Test that main package can specify features for its dependencies + subroutine test_dependency_features_specification(error) + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_config_t) :: main_package + character(:), allocatable :: temp_file + integer :: unit, i + logical :: found_tomlf_dep + + allocate(temp_file, source=get_temp_filename()) + + ! Create a main package manifest that specifies features for dependencies + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'name = "main-package"', & + & 'version = "0.1.0"', & + & '[dependencies]', & + & '"dep-a" = { path = "../dep-a", features = ["openmp", "json"] }', & + & '"dep-b" = { path = "../dep-b", features = ["debug"] }' + close(unit) + + ! Load the main package configuration + call get_package_data(main_package, temp_file, error) + if (allocated(error)) return + + ! Verify dependencies were parsed correctly + if (.not. allocated(main_package%dependency)) then + call test_failed(error, "Main package dependencies not allocated") + return + end if + + if (size(main_package%dependency) /= 2) then + call test_failed(error, "Expected 2 dependencies, got " // & + char(size(main_package%dependency) + ichar('0'))) + return + end if + + ! Find and verify dep-a dependency with features + found_tomlf_dep = .false. + do i = 1, size(main_package%dependency) + if (main_package%dependency(i)%name == "dep-a") then + found_tomlf_dep = .true. + + ! Verify path configuration exists + if (.not. allocated(main_package%dependency(i)%path)) then + call test_failed(error, "dep-a dependency missing path configuration") + return + end if + + ! Path gets canonicalized, so just check it ends with the relative path + if (index(main_package%dependency(i)%path, "../dep-a") == 0) then + call test_failed(error, "dep-a dependency path should contain '../dep-a', got: '" // & + main_package%dependency(i)%path // "'") + return + end if + + ! Verify features array - this is the key test + if (.not. allocated(main_package%dependency(i)%features)) then + call test_failed(error, "dep-a dependency features not allocated") + return + end if + + if (size(main_package%dependency(i)%features) /= 2) then + call test_failed(error, "dep-a dependency should have 2 features") + return + end if + + if (main_package%dependency(i)%features(1)%s /= "openmp" .or. & + main_package%dependency(i)%features(2)%s /= "json") then + call test_failed(error, "dep-a dependency has wrong feature names") + return + end if + exit + end if + end do + + if (.not. found_tomlf_dep) then + call test_failed(error, "dep-a dependency not found") + return + end if + + ! Verify dep-b dependency has features + do i = 1, size(main_package%dependency) + if (main_package%dependency(i)%name == "dep-b") then + if (.not. allocated(main_package%dependency(i)%features)) then + call test_failed(error, "dep-b dependency features not allocated") + return + end if + + if (size(main_package%dependency(i)%features) /= 1) then + call test_failed(error, "dep-b dependency should have 1 feature") + return + end if + + if (main_package%dependency(i)%features(1)%s /= "debug") then + call test_failed(error, "dep-b dependency has wrong feature name") + return + end if + exit + end if + end do + + end subroutine test_dependency_features_specification + end module test_features From f2bb830342c1a5b48339446fd17f72d2a9aa466c Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 7 Sep 2025 22:10:09 +0200 Subject: [PATCH 14/59] fix profile/feature CLI --- src/fpm_command_line.f90 | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 6d3116f0cf..44e13b5115 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -1663,15 +1663,20 @@ subroutine build_settings(self, list, show_model, build_tests, config_file) call fpm_stop(1, 'Error: --profile and --features cannot be used together') end if - ! Parse comma-separated features + ! Parse comma-separated features and profiles if (specified('features') .and. len_trim(feats) > 0) then call parse_features(feats, self%features) else - allocate(self%features(0)) + if (allocated(self%features)) deallocate(self%features) end if - ! Assign into this (polymorphic) object; allocatable chars auto-allocate - self%profile = prof + if (specified('profile') .and. len_trim(prof) > 0) then + self%profile = prof + else + if (allocated(self%profile)) deallocate(self%profile) + end if + + ! Assign into this (polymorphic) object; allocatable chars auto-allocate self%prune = .not. lget('no-prune') self%compiler = comp self%c_compiler = ccomp From 9449c6e880e86f373342dd513512bf82c1265eec Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 8 Sep 2025 09:06:20 +0200 Subject: [PATCH 15/59] add tests on invalid chains --- src/fpm/manifest/feature_collection.f90 | 21 ++- test/fpm_test/test_features.f90 | 166 +++++++++++++++++++++++- 2 files changed, 185 insertions(+), 2 deletions(-) diff --git a/src/fpm/manifest/feature_collection.f90 b/src/fpm/manifest/feature_collection.f90 index 3164973013..fede6821fb 100644 --- a/src/fpm/manifest/feature_collection.f90 +++ b/src/fpm/manifest/feature_collection.f90 @@ -309,7 +309,17 @@ recursive subroutine traverse_feature_table(collection, table, feature_name, & ! Check if this key is an OS name os_type = match_os_type(keys(i)%key) if (os_type /= OS_UNKNOWN) then - ! This is an OS constraint - get subtable and recurse + ! This is an OS constraint + + ! Check for chained OS commands (e.g., feature.windows.linux) + if (constraint%os_type /= OS_ALL) then + call fatal_error(error, "Cannot chain OS constraints: '" // & + constraint%os_name() // "." // keys(i)%key // & + "' - OS was already specified") + return + end if + + ! Get subtable and recurse call get_value(table, keys(i)%key, subtable, stat=stat) if (stat == toml_stat%success) then platform = platform_config_t(constraint%compiler,os_type) @@ -323,6 +333,15 @@ recursive subroutine traverse_feature_table(collection, table, feature_name, & ! Check if this key is a compiler name compiler_type = match_compiler_type(keys(i)%key) if (compiler_type /= id_unknown) then + + ! Check for chained compiler commands (e.g., feature.gfortran.ifort) + if (constraint%compiler /= id_all) then + call fatal_error(error, "Cannot chain compiler constraints: '" // & + constraint%compiler_name() // "." // keys(i)%key // & + "' - compiler was already specified") + return + end if + ! This is a compiler constraint - get subtable and recurse call get_value(table, keys(i)%key, subtable, stat=stat) if (stat == toml_stat%success) then diff --git a/test/fpm_test/test_features.f90 b/test/fpm_test/test_features.f90 index 4fcc02e31e..c487a35370 100644 --- a/test/fpm_test/test_features.f90 +++ b/test/fpm_test/test_features.f90 @@ -41,7 +41,12 @@ subroutine collect_features(testsuite) & new_unittest("feature-extract-test-configs", test_feature_extract_test_configs), & & new_unittest("feature-extract-example-configs", test_feature_extract_example_configs), & & new_unittest("dependency-feature-propagation", test_dependency_feature_propagation), & - & new_unittest("dependency-features-specification", test_dependency_features_specification) & + & new_unittest("dependency-features-specification", test_dependency_features_specification), & + & new_unittest("feature-chained-os-commands", test_feature_chained_os_commands, should_fail=.true.), & + & new_unittest("feature-chained-compiler-commands", test_feature_chained_compiler_commands, should_fail=.true.), & + & new_unittest("feature-complex-chain-compiler-os-compiler", test_feature_complex_chain_compiler_os_compiler, should_fail=.true.), & + & new_unittest("feature-complex-chain-os-compiler-os", test_feature_complex_chain_os_compiler_os, should_fail=.true.), & + & new_unittest("feature-mixed-valid-chains", test_feature_mixed_valid_chains) & & ] end subroutine collect_features @@ -1303,4 +1308,163 @@ subroutine test_dependency_features_specification(error) end subroutine test_dependency_features_specification + !> Test that chained OS commands are rejected (should fail) + subroutine test_feature_chained_os_commands(error) + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_config_t) :: package + character(:), allocatable :: temp_file + integer :: unit + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'name = "chained-os-test"', & + & 'version = "0.1.0"', & + & '[features]', & + & 'myfeature.windows.linux.flags = "-invalid"' ! Chained OS: windows.linux + close(unit) + + call get_package_data(package, temp_file, error) + + ! This should fail due to chained OS commands + + end subroutine test_feature_chained_os_commands + + !> Test that chained compiler commands are rejected (should fail) + subroutine test_feature_chained_compiler_commands(error) + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_config_t) :: package + character(:), allocatable :: temp_file + integer :: unit + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'name = "chained-compiler-test"', & + & 'version = "0.1.0"', & + & '[features]', & + & 'myfeature.gfortran.ifort.flags = "-invalid"' ! Chained compiler: gfortran.ifort + close(unit) + + call get_package_data(package, temp_file, error) + + ! This should fail due to chained compiler commands + + end subroutine test_feature_chained_compiler_commands + + !> Test complex chaining: compiler.os.compiler (should fail) + subroutine test_feature_complex_chain_compiler_os_compiler(error) + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_config_t) :: package + character(:), allocatable :: temp_file + integer :: unit + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'name = "complex-chain-test"', & + & 'version = "0.1.0"', & + & '[features]', & + & 'myfeature.gfortran.windows.ifort.flags = "-invalid"' ! gfortran.windows.ifort chain + close(unit) + + call get_package_data(package, temp_file, error) + + ! This should fail due to chained compiler constraints: gfortran -> windows (OK) -> ifort (ERROR) + + end subroutine test_feature_complex_chain_compiler_os_compiler + + !> Test complex chaining: os.compiler.os (should fail) + subroutine test_feature_complex_chain_os_compiler_os(error) + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_config_t) :: package + character(:), allocatable :: temp_file + integer :: unit + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'name = "complex-chain-test2"', & + & 'version = "0.1.0"', & + & '[features]', & + & 'myfeature.windows.ifx.macos.flags = "-invalid"' ! windows.ifx.macos chain + close(unit) + + call get_package_data(package, temp_file, error) + + ! This should fail due to chained OS constraints: windows -> ifx (OK) -> macos (ERROR) + + end subroutine test_feature_complex_chain_os_compiler_os + + !> Test mixed valid chains (should pass) + subroutine test_feature_mixed_valid_chains(error) + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_config_t) :: package + character(:), allocatable :: temp_file + integer :: unit + integer :: i + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'name = "valid-chains-test"', & + & 'version = "0.1.0"', & + & '[features]', & + & 'debug.flags = "-g"', & ! Base feature (all OS, all compilers) + & 'debug.gfortran.flags = "-Wall"', & ! Compiler-specific (gfortran, all OS) + & 'debug.windows.flags = "-DWINDOWS"', & ! OS-specific (all compilers, Windows) + & 'debug.gfortran.windows.flags = "-fbacktrace"', & ! Target-specific (gfortran + Windows) + & 'debug.linux.ifort.flags = "-check all"', & ! Target-specific (Linux + ifort) + & 'release.ifx.macos.flags = "-O3"' ! Another valid target-specific (ifx + macOS) + close(unit) + + call get_package_data(package, temp_file, error) + if (allocated(error)) return + + ! Verify that valid chains are accepted and collections created + if (.not. allocated(package%features)) then + call test_failed(error, "No feature collections found for valid chains test") + return + end if + + ! Should have debug and release features + if (size(package%features) < 2) then + call test_failed(error, "Expected at least 2 feature collections for valid chains") + return + end if + + ! Check that debug feature has multiple variants + do i = 1, size(package%features) + if (package%features(i)%base%name == "debug") then + if (.not. allocated(package%features(i)%variants)) then + call test_failed(error, "Debug collection should have variants for valid chains") + return + end if + + ! Should have multiple variants: gfortran, windows, gfortran.windows, linux.ifort + if (size(package%features(i)%variants) < 4) then + call test_failed(error, "Debug collection should have at least 4 variants for valid chains") + return + end if + exit + end if + end do + + end subroutine test_feature_mixed_valid_chains + end module test_features From 258f35c11ed074bf5782a492538ec09e4d27a30f Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 8 Sep 2025 09:54:07 +0200 Subject: [PATCH 16/59] fix merging of preprocessor collections --- src/fpm/manifest/feature_collection.f90 | 72 ++++++++++++++++++++++--- 1 file changed, 64 insertions(+), 8 deletions(-) diff --git a/src/fpm/manifest/feature_collection.f90 b/src/fpm/manifest/feature_collection.f90 index fede6821fb..1198a2b29c 100644 --- a/src/fpm/manifest/feature_collection.f90 +++ b/src/fpm/manifest/feature_collection.f90 @@ -583,13 +583,15 @@ subroutine merge_test_arrays(target, source) end if end subroutine merge_test_arrays - !> Merge preprocess arrays by appending source to target + !> Merge preprocess arrays by merging configurations for same preprocessor names + !> and appending new ones subroutine merge_preprocess_arrays(target, source) type(preprocess_config_t), allocatable, intent(inout) :: target(:) type(preprocess_config_t), allocatable, intent(in) :: source(:) type(preprocess_config_t), allocatable :: temp(:) - integer :: target_size, source_size + integer :: target_size, source_size, i, j, new_count + integer, allocatable :: source_to_target_map(:) ! Maps source index to target index (0 = new) if (.not. allocated(source)) return @@ -597,16 +599,70 @@ subroutine merge_preprocess_arrays(target, source) if (source_size == 0) return if (.not. allocated(target)) then - allocate(target(source_size)) - target = source - else - target_size = size(target) - allocate(temp(target_size + source_size)) + allocate(target(source_size), source=source) + return + end if + + target_size = size(target) + + ! Create mapping arrays in a single pass + allocate(source_to_target_map(source_size), source=0) + + ! Single loop to build the mapping + do i = 1, source_size + if (allocated(source(i)%name)) then + do j = 1, target_size + if (allocated(target(j)%name)) then + if (target(j)%name == source(i)%name) then + source_to_target_map(i) = j + exit + end if + end if + end do + end if + end do + + ! Merge overlapping configurations + do i = 1, source_size + j = source_to_target_map(i) + if (j==0) cycle ! new config + call merge_preprocessor_config(target(j), source(i)) + end do + + ! Count and add new preprocessors + new_count = count(source_to_target_map==0) + if (new_count > 0) then + allocate(temp(target_size + new_count)) temp(1:target_size) = target - temp(target_size+1:target_size+source_size) = source + + ! Add new preprocessors in a single pass + j = target_size + do i = 1, source_size + if (source_to_target_map(i)==0) then + j = j + 1 + temp(j) = source(i) + end if + end do + call move_alloc(temp, target) end if end subroutine merge_preprocess_arrays + + !> Helper to merge two preprocessor configurations with the same name + subroutine merge_preprocessor_config(target, source) + type(preprocess_config_t), intent(inout) :: target + type(preprocess_config_t), intent(in) :: source + + ! Merge suffixes arrays + call merge_string_arrays(target%suffixes, source%suffixes) + + ! Merge directories arrays + call merge_string_arrays(target%directories, source%directories) + + ! Merge macros arrays + call merge_string_arrays(target%macros, source%macros) + + end subroutine merge_preprocessor_config !> Merge string arrays by appending source to target subroutine merge_string_arrays(target, source) From 6efba869df7bdd193389f42bdd74bcd125f46539 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 8 Sep 2025 09:54:16 +0200 Subject: [PATCH 17/59] test merging of preprocessor collections --- test/fpm_test/test_manifest.f90 | 83 ++++++++++++++++++++++++++++++++- 1 file changed, 82 insertions(+), 1 deletion(-) diff --git a/test/fpm_test/test_manifest.f90 b/test/fpm_test/test_manifest.f90 index 43ffb305f9..64483f8c65 100644 --- a/test/fpm_test/test_manifest.f90 +++ b/test/fpm_test/test_manifest.f90 @@ -83,7 +83,8 @@ subroutine collect_manifest(testsuite) & new_unittest("preprocessors-empty", test_preprocessors_empty, should_fail=.true.), & & new_unittest("macro-parsing", test_macro_parsing, should_fail=.false.), & & new_unittest("macro-parsing-dependency", & - & test_macro_parsing_dependency, should_fail=.false.) & + & test_macro_parsing_dependency, should_fail=.false.), & + & new_unittest("features-demo-serialization", test_features_demo_serialization) & & ] end subroutine collect_manifest @@ -1727,5 +1728,85 @@ subroutine test_dependency_features_empty(error) end if end subroutine test_dependency_features_empty + !> Test features demo manifest serialization (from example_packages/features_demo/fpm.toml) + subroutine test_features_demo_serialization(error) + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_config_t) :: package + character(:), allocatable :: temp_file + integer :: unit + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'name = "features_demo"', & + & 'version = "0.1.0"', & + & 'license = "MIT"', & + & 'description = "Demo package for FPM features functionality"', & + & '', & + & '[[executable]]', & + & 'name = "features_demo"', & + & 'source-dir = "app"', & + & 'main = "main.f90"', & + & '', & + & '[features]', & + & '# Base debug feature', & + & 'debug.flags = "-g"', & + & 'debug.preprocess.cpp.macros = "DEBUG"', & + & '', & + & '# Release feature', & + & 'release.flags = "-O3"', & + & 'release.preprocess.cpp.macros = "RELEASE"', & + & '', & + & '# Compiler-specific features', & + & 'debug.gfortran.flags = "-Wall -fcheck=bounds"', & + & 'release.gfortran.flags = "-march=native"', & + & '', & + & '# Platform-specific features', & + & 'linux.preprocess.cpp.macros = "LINUX_BUILD"', & + & '', & + & '# Parallel features', & + & 'mpi.preprocess.cpp.macros = "USE_MPI"', & + & 'mpi.dependencies.mpi = "*"', & + & 'openmp.preprocess.cpp.macros = "USE_OPENMP"', & + & 'openmp.dependencies.openmp = "*"', & + & '', & + & '[profiles]', & + & 'development = ["debug"]', & + & 'production = ["release", "openmp"]' + close(unit) + + call get_package_data(package, temp_file, error) + if (allocated(error)) return + + ! Verify basic package structure + if (package%name /= "features_demo") then + call test_failed(error, "Package name should be 'features_demo'") + return + end if + + if (.not. allocated(package%features)) then + call test_failed(error, "Features should be allocated") + return + end if + + if (.not. allocated(package%profiles)) then + call test_failed(error, "Profiles should be allocated") + return + end if + + if (.not. allocated(package%executable)) then + call test_failed(error, "Executables should be allocated") + return + end if + + ! Test package serialization roundtrip + call package%test_serialization('test_features_demo_serialization', error) + if (allocated(error)) return + + end subroutine test_features_demo_serialization + end module test_manifest From 9beb972bb37bda7f9f5e2c894364719fd606cc7a Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 8 Sep 2025 10:07:19 +0200 Subject: [PATCH 18/59] ensure metapackage names are always set --- src/fpm/manifest/feature_collection.f90 | 1 + src/fpm/manifest/meta.f90 | 13 +++++++++++-- src/fpm/manifest/package.f90 | 5 ++++- 3 files changed, 16 insertions(+), 3 deletions(-) diff --git a/src/fpm/manifest/feature_collection.f90 b/src/fpm/manifest/feature_collection.f90 index 1198a2b29c..d61c875cac 100644 --- a/src/fpm/manifest/feature_collection.f90 +++ b/src/fpm/manifest/feature_collection.f90 @@ -697,6 +697,7 @@ subroutine merge_metapackages_additive(target, source) ! OR logic: if either requests a metapackage, turn it on if (source%on) then target%on = .true. + target%name = source%name ! Use source version if target doesn't have one if (allocated(source%version) .and. .not. allocated(target%version)) then target%version = source%version diff --git a/src/fpm/manifest/meta.f90 b/src/fpm/manifest/meta.f90 index 50d8d667a3..51b972f45f 100644 --- a/src/fpm/manifest/meta.f90 +++ b/src/fpm/manifest/meta.f90 @@ -67,7 +67,10 @@ module fpm_manifest_metapackages contains procedure :: get_requests + + ! Cleanup configuration; assert package names final :: meta_config_final + procedure :: reset => meta_config_reset procedure :: serializable_is_same => meta_config_same procedure :: dump_to_toml => meta_config_dump @@ -384,7 +387,13 @@ end subroutine meta_config_dump ! Ensure the names of all packages are always defined subroutine meta_config_final(self) - type(metapackage_config_t), intent(inout) :: self + type(metapackage_config_t), intent(inout) :: self + call meta_config_reset(self) + end subroutine meta_config_final + + ! Ensure the names of all packages are always defined + subroutine meta_config_reset(self) + class(metapackage_config_t), intent(inout) :: self call request_destroy(self%openmp); self%openmp%name = "openmp" call request_destroy(self%stdlib); self%stdlib%name = "stdlib" @@ -394,7 +403,7 @@ subroutine meta_config_final(self) call request_destroy(self%netcdf); self%netcdf%name = "netcdf" call request_destroy(self%blas); self%blas%name = "blas" - end subroutine meta_config_final + end subroutine meta_config_reset subroutine meta_config_load(self, table, error) class(metapackage_config_t), intent(inout) :: self diff --git a/src/fpm/manifest/package.f90 b/src/fpm/manifest/package.f90 index c454f058ec..13d9138a67 100644 --- a/src/fpm/manifest/package.f90 +++ b/src/fpm/manifest/package.f90 @@ -215,7 +215,10 @@ subroutine new_package(self, table, root, error) ! Validate profiles after all features and profiles have been loaded call validate_profiles(self, error) if (allocated(error)) return - + + ! Ensure metapackage data is initialized although off + call self%meta%reset() + end subroutine new_package From 6ff7d700e8a01792135a5bf807f3eaae01ec6653 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 8 Sep 2025 10:31:56 +0200 Subject: [PATCH 19/59] do not allow multiple definitions --- src/fpm/manifest/feature_collection.f90 | 116 ++++++++++++++++++++---- 1 file changed, 96 insertions(+), 20 deletions(-) diff --git a/src/fpm/manifest/feature_collection.f90 b/src/fpm/manifest/feature_collection.f90 index d61c875cac..17f70607a3 100644 --- a/src/fpm/manifest/feature_collection.f90 +++ b/src/fpm/manifest/feature_collection.f90 @@ -457,11 +457,21 @@ subroutine merge_feature_configs(target, source, error) end if ! ADDITIVE: Array properties - append source to target - call merge_executable_arrays(target%executable, source%executable) - call merge_dependency_arrays(target%dependency, source%dependency) - call merge_dependency_arrays(target%dev_dependency, source%dev_dependency) - call merge_example_arrays(target%example, source%example) - call merge_test_arrays(target%test, source%test) + call merge_executable_arrays(target%executable, source%executable, error) + if (allocated(error)) return + + call merge_dependency_arrays(target%dependency, source%dependency, error) + if (allocated(error)) return + + call merge_dependency_arrays(target%dev_dependency, source%dev_dependency, error) + if (allocated(error)) return + + call merge_example_arrays(target%example, source%example, error) + if (allocated(error)) return + + call merge_test_arrays(target%test, source%test, error) + if (allocated(error)) return + call merge_preprocess_arrays(target%preprocess, source%preprocess) call merge_string_arrays(target%requires_features, source%requires_features) @@ -470,19 +480,36 @@ subroutine merge_feature_configs(target, source, error) end subroutine merge_feature_configs - !> Merge executable arrays by appending source to target - subroutine merge_executable_arrays(target, source) + !> Merge executable arrays by appending source to target, checking for duplicates + subroutine merge_executable_arrays(target, source, error) type(executable_config_t), allocatable, intent(inout) :: target(:) type(executable_config_t), allocatable, intent(in) :: source(:) + type(error_t), allocatable, intent(out) :: error type(executable_config_t), allocatable :: temp(:) - integer :: target_size, source_size + integer :: target_size, source_size, i, j if (.not. allocated(source)) return source_size = size(source) if (source_size == 0) return + ! Check for duplicates between source and target + if (allocated(target)) then + target_size = size(target) + do i = 1, source_size + do j = 1, target_size + if (allocated(source(i)%name) .and. allocated(target(j)%name)) then + if (source(i)%name == target(j)%name) then + call fatal_error(error, "Duplicate executable '"//source(i)%name//"' found. " // & + "Multiple definitions of the same executable are not currently allowed.") + return + end if + end if + end do + end do + end if + if (.not. allocated(target)) then allocate(target(source_size), source=source) else @@ -495,19 +522,36 @@ subroutine merge_executable_arrays(target, source) end subroutine merge_executable_arrays - !> Merge dependency arrays by appending source to target - subroutine merge_dependency_arrays(target, source) + !> Merge dependency arrays by appending source to target, checking for duplicates + subroutine merge_dependency_arrays(target, source, error) type(dependency_config_t), allocatable, intent(inout) :: target(:) type(dependency_config_t), allocatable, intent(in) :: source(:) + type(error_t), allocatable, intent(out) :: error type(dependency_config_t), allocatable :: temp(:) - integer :: target_size, source_size + integer :: target_size, source_size, i, j if (.not. allocated(source)) return source_size = size(source) if (source_size == 0) return + ! Check for duplicates between source and target + if (allocated(target)) then + target_size = size(target) + do i = 1, source_size + do j = 1, target_size + if (allocated(source(i)%name) .and. allocated(target(j)%name)) then + if (source(i)%name == target(j)%name) then + call fatal_error(error, "Duplicate dependency '"//source(i)%name//"' found. " // & + "Multiple definitions of the same dependency are not currently allowed.") + return + end if + end if + end do + end do + end if + if (.not. allocated(target)) then allocate(target(source_size), source=source) else @@ -534,19 +578,36 @@ subroutine merge_string_additive(target, source) end if end subroutine merge_string_additive - !> Merge example arrays by appending source to target - subroutine merge_example_arrays(target, source) + !> Merge example arrays by appending source to target, checking for duplicates + subroutine merge_example_arrays(target, source, error) type(example_config_t), allocatable, intent(inout) :: target(:) type(example_config_t), allocatable, intent(in) :: source(:) + type(error_t), allocatable, intent(out) :: error type(example_config_t), allocatable :: temp(:) - integer :: target_size, source_size + integer :: target_size, source_size, i, j if (.not. allocated(source)) return source_size = size(source) if (source_size == 0) return + ! Check for duplicates between source and target + if (allocated(target)) then + target_size = size(target) + do i = 1, source_size + do j = 1, target_size + if (allocated(source(i)%name) .and. allocated(target(j)%name)) then + if (source(i)%name == target(j)%name) then + call fatal_error(error, "Duplicate example '"//source(i)%name//"' found. " // & + "Multiple definitions of the same example are not currently allowed.") + return + end if + end if + end do + end do + end if + if (.not. allocated(target)) then allocate(target(source_size), source=source) else @@ -558,19 +619,36 @@ subroutine merge_example_arrays(target, source) end if end subroutine merge_example_arrays - !> Merge test arrays by appending source to target - subroutine merge_test_arrays(target, source) + !> Merge test arrays by appending source to target, checking for duplicates + subroutine merge_test_arrays(target, source, error) type(test_config_t), allocatable, intent(inout) :: target(:) type(test_config_t), allocatable, intent(in) :: source(:) + type(error_t), allocatable, intent(out) :: error type(test_config_t), allocatable :: temp(:) - integer :: target_size, source_size + integer :: target_size, source_size, i, j if (.not. allocated(source)) return source_size = size(source) if (source_size == 0) return + ! Check for duplicates between source and target + if (allocated(target)) then + target_size = size(target) + do i = 1, source_size + do j = 1, target_size + if (allocated(source(i)%name) .and. allocated(target(j)%name)) then + if (source(i)%name == target(j)%name) then + call fatal_error(error, "Duplicate test '"//source(i)%name//"' found. " // & + "Multiple definitions of the same test are not currently allowed.") + return + end if + end if + end do + end do + end if + if (.not. allocated(target)) then allocate(target(source_size)) target = source @@ -1193,9 +1271,7 @@ type(feature_collection_t) function collection_from_feature(self) result(collect collection%base%platform%compiler = id_all ! Copy the name if available - if (allocated(self%name)) then - collection%base%name = self%name - end if + if (allocated(self%name)) collection%base%name = self%name ! No variants initially - just the base configuration ! (variants can be added later if needed) From d748c9295e2523c495ffc606e705c0e493b74fab Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 8 Sep 2025 10:55:36 +0200 Subject: [PATCH 20/59] preprocessing fix: must be on if *any* features - even not active - has it --- src/fpm.f90 | 6 +++++- src/fpm/manifest/feature.f90 | 21 ++++++++++++++++++++- src/fpm/manifest/feature_collection.f90 | 19 +++++++++++++++++++ src/fpm/manifest/package.f90 | 21 +++++++++++++++++++++ src/fpm/manifest/preprocess.f90 | 2 +- 5 files changed, 66 insertions(+), 3 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index ccddc2bd48..a4ae917d91 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -112,7 +112,11 @@ subroutine build_model(model, settings, package_config, error) end if allocate(model%packages(model%deps%ndep)) - has_cpp = .false. + + ! The current configuration may not have preprocessing, but some of its features may. + ! This means there will be directives that need to be considered even if not currently + ! active. Turn preprocessing on even in this case + has_cpp = package_config%has_cpp() .or. package%has_cpp() do i = 1, model%deps%ndep associate(dep => model%deps%dep(i)) diff --git a/src/fpm/manifest/feature.f90 b/src/fpm/manifest/feature.f90 index 0059a0dd54..e556e1bc2b 100644 --- a/src/fpm/manifest/feature.f90 +++ b/src/fpm/manifest/feature.f90 @@ -105,7 +105,7 @@ module fpm_manifest_feature character(len=:), allocatable :: cxx_flags character(len=:), allocatable :: link_time_flags - !> Feature dependencies + !> Feature dependencies (not active yet) type(string_t), allocatable :: requires_features(:) !> Is this feature enabled by default @@ -121,6 +121,9 @@ module fpm_manifest_feature !> Get manifest name procedure :: manifest_name + + !> Check if there is a cpp configuration + procedure :: has_cpp !> Serialization interface procedure :: serializable_is_same => feature_is_same @@ -1198,5 +1201,21 @@ function manifest_name(self) result(name) end if end function manifest_name + + !> Check if there is a CPP preprocessor configuration + elemental logical function has_cpp(self) + class(feature_config_t), intent(in) :: self + + integer :: i + + has_cpp = .false. + if (.not.allocated(self%preprocess)) return + + do i=1,size(self%preprocess) + has_cpp = self%preprocess(i)%is_cpp() + if (has_cpp) return + end do + + end function has_cpp end module fpm_manifest_feature diff --git a/src/fpm/manifest/feature_collection.f90 b/src/fpm/manifest/feature_collection.f90 index 17f70607a3..dd77a1ec3c 100644 --- a/src/fpm/manifest/feature_collection.f90 +++ b/src/fpm/manifest/feature_collection.f90 @@ -47,6 +47,7 @@ module fpm_manifest_feature_collection procedure :: extract_for_target procedure :: check => check_collection procedure :: merge_into_package + procedure :: has_cpp end type feature_collection_t @@ -1278,4 +1279,22 @@ type(feature_collection_t) function collection_from_feature(self) result(collect end function collection_from_feature + + !> Check if there is a CPP preprocessor configuration + elemental logical function has_cpp(self) + class(feature_collection_t), intent(in) :: self + + integer :: i + + has_cpp = self%base%has_cpp() + if (has_cpp) return + if (.not.allocated(self%variants)) return + + do i=1,size(self%variants) + has_cpp = self%variants(i)%has_cpp() + if (has_cpp) return + end do + + end function has_cpp + end module fpm_manifest_feature_collection diff --git a/src/fpm/manifest/package.f90 b/src/fpm/manifest/package.f90 index 13d9138a67..f27e8fd24d 100644 --- a/src/fpm/manifest/package.f90 +++ b/src/fpm/manifest/package.f90 @@ -92,6 +92,9 @@ module fpm_manifest_package procedure :: serializable_is_same => manifest_is_same procedure :: dump_to_toml procedure :: load_from_toml + + !> Check if any features has a cpp configuration + procedure :: has_cpp !> Export package configuration with features applied procedure :: export_config @@ -609,6 +612,8 @@ type(package_config_t) function export_config(self, platform, features, profile, return end if + print *, 'merge feature ',want_features(i)%s,' into ',cfg%name + ! Add it to the current configuration call self%features(idx)%merge_into_package(cfg, platform, error) if (allocated(error)) return @@ -745,5 +750,21 @@ subroutine validate_profiles(self, error) end subroutine validate_profiles + !> Check if there is a CPP preprocessor configuration + elemental logical function has_cpp(self) + class(package_config_t), intent(in) :: self + + integer :: i + + has_cpp = self%feature_config_t%has_cpp() + if (has_cpp) return + if (.not.allocated(self%features)) return + + do i=1,size(self%features) + has_cpp = self%features(i)%has_cpp() + if (has_cpp) return + end do + + end function has_cpp end module fpm_manifest_package diff --git a/src/fpm/manifest/preprocess.f90 b/src/fpm/manifest/preprocess.f90 index 34f95beb96..da0c74fd4d 100644 --- a/src/fpm/manifest/preprocess.f90 +++ b/src/fpm/manifest/preprocess.f90 @@ -355,7 +355,7 @@ subroutine add_config(this,that) end subroutine add_config ! Check cpp - logical function is_cpp(this) + elemental logical function is_cpp(this) class(preprocess_config_t), intent(in) :: this is_cpp = .false. if (allocated(this%name)) is_cpp = this%name == "cpp" From cf4a7044b8b9a51c11124a5ea12cffd1e2860b5b Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 8 Sep 2025 19:40:01 +0200 Subject: [PATCH 21/59] fix --- src/fpm/installer.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/fpm/installer.f90 b/src/fpm/installer.f90 index 704c10a243..1a8a98ee94 100644 --- a/src/fpm/installer.f90 +++ b/src/fpm/installer.f90 @@ -208,6 +208,7 @@ subroutine install_executable(self, executable, error) end if call self%install(executable, self%bindir, error) + if (allocated(error)) return ! on MacOS, add two relative paths for search of dynamic library dependencies: add_rpath: if (self%os==OS_MACOS) then From f3356a712b4fa12720ed62e46922f44a735b60c6 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 8 Sep 2025 19:41:14 +0200 Subject: [PATCH 22/59] Update test_features.f90 --- test/fpm_test/test_features.f90 | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/test/fpm_test/test_features.f90 b/test/fpm_test/test_features.f90 index c487a35370..c20623540a 100644 --- a/test/fpm_test/test_features.f90 +++ b/test/fpm_test/test_features.f90 @@ -43,9 +43,12 @@ subroutine collect_features(testsuite) & new_unittest("dependency-feature-propagation", test_dependency_feature_propagation), & & new_unittest("dependency-features-specification", test_dependency_features_specification), & & new_unittest("feature-chained-os-commands", test_feature_chained_os_commands, should_fail=.true.), & - & new_unittest("feature-chained-compiler-commands", test_feature_chained_compiler_commands, should_fail=.true.), & - & new_unittest("feature-complex-chain-compiler-os-compiler", test_feature_complex_chain_compiler_os_compiler, should_fail=.true.), & - & new_unittest("feature-complex-chain-os-compiler-os", test_feature_complex_chain_os_compiler_os, should_fail=.true.), & + & new_unittest("feature-chained-compiler-commands", & + & test_feature_chained_compiler_commands, should_fail=.true.), & + & new_unittest("feature-complex-chain-compiler-os-compiler", & + & test_feature_complex_chain_compiler_os_compiler, should_fail=.true.), & + & new_unittest("feature-complex-chain-os-compiler-os", & + & test_feature_complex_chain_os_compiler_os, should_fail=.true.), & & new_unittest("feature-mixed-valid-chains", test_feature_mixed_valid_chains) & & ] From a1171159e3ad4ab4aecd4b45574899afdaf371b6 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 8 Sep 2025 20:10:18 +0200 Subject: [PATCH 23/59] generalize test for windows --- test/fpm_test/test_features.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/fpm_test/test_features.f90 b/test/fpm_test/test_features.f90 index c20623540a..ef5e98b342 100644 --- a/test/fpm_test/test_features.f90 +++ b/test/fpm_test/test_features.f90 @@ -1257,8 +1257,8 @@ subroutine test_dependency_features_specification(error) end if ! Path gets canonicalized, so just check it ends with the relative path - if (index(main_package%dependency(i)%path, "../dep-a") == 0) then - call test_failed(error, "dep-a dependency path should contain '../dep-a', got: '" // & + if (index(main_package%dependency(i)%path, "dep-a") == 0) then + call test_failed(error, "dep-a dependency path should contain 'dep-a', got: '" // & main_package%dependency(i)%path // "'") return end if From 663fa0f7eec6949d37378737882cbfaf6a8b4887 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 8 Sep 2025 20:12:47 +0200 Subject: [PATCH 24/59] intel fix --- test/cli_test/cli_test.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/test/cli_test/cli_test.f90 b/test/cli_test/cli_test.f90 index e80e28ac8d..fe54edb937 100644 --- a/test/cli_test/cli_test.f90 +++ b/test/cli_test/cli_test.f90 @@ -279,14 +279,14 @@ subroutine parse() act_w_t=settings%with_test act_name=[trim(settings%name)] type is (fpm_build_settings) - act_profile=settings%profile + if (allocated(settings%profile) act_profile=settings%profile if (allocated(settings%features)) then do i = 1, min(size(settings%features),size(act_features)) act_features(i) = settings%features(i)%s end do end if type is (fpm_run_settings) - act_profile=settings%profile + if (allocated(settings%profile) act_profile=settings%profile if (allocated(settings%features)) then do i = 1, min(size(settings%features),size(act_features)) act_features(i) = settings%features(i)%s @@ -295,7 +295,7 @@ subroutine parse() act_name=settings%name if (allocated(settings%args)) act_args=settings%args type is (fpm_test_settings) - act_profile=settings%profile + if (allocated(settings%profile) act_profile=settings%profile if (allocated(settings%features)) then do i = 1, min(size(settings%features),size(act_features)) act_features(i) = settings%features(i)%s From a4b36146f28dc6021448d2da6e88dfcca227c63b Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 8 Sep 2025 20:28:20 +0200 Subject: [PATCH 25/59] fix --- test/cli_test/cli_test.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/test/cli_test/cli_test.f90 b/test/cli_test/cli_test.f90 index fe54edb937..7df098b2cb 100644 --- a/test/cli_test/cli_test.f90 +++ b/test/cli_test/cli_test.f90 @@ -279,14 +279,14 @@ subroutine parse() act_w_t=settings%with_test act_name=[trim(settings%name)] type is (fpm_build_settings) - if (allocated(settings%profile) act_profile=settings%profile + if (allocated(settings%profile)) act_profile=settings%profile if (allocated(settings%features)) then do i = 1, min(size(settings%features),size(act_features)) act_features(i) = settings%features(i)%s end do end if type is (fpm_run_settings) - if (allocated(settings%profile) act_profile=settings%profile + if (allocated(settings%profile)) act_profile=settings%profile if (allocated(settings%features)) then do i = 1, min(size(settings%features),size(act_features)) act_features(i) = settings%features(i)%s @@ -295,7 +295,7 @@ subroutine parse() act_name=settings%name if (allocated(settings%args)) act_args=settings%args type is (fpm_test_settings) - if (allocated(settings%profile) act_profile=settings%profile + if (allocated(settings%profile)) act_profile=settings%profile if (allocated(settings%features)) then do i = 1, min(size(settings%features),size(act_features)) act_features(i) = settings%features(i)%s From 81af006a85bc9c0aacea915531475638488892b0 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 8 Sep 2025 20:39:00 +0200 Subject: [PATCH 26/59] create features test --- ci/run_tests.sh | 4 + ci/test_features.sh | 160 ++++++++++++++++++ .../features_demo/app/debug_demo.f90 | 16 ++ example_packages/features_demo/app/main.f90 | 12 ++ example_packages/features_demo/fpm.toml | 35 ++++ .../features_demo/src/features_demo.f90 | 78 +++++++++ .../features_with_dependency/app/main.f90 | 13 ++ .../features_with_dependency/fpm.toml | 41 +++++ .../src/features_with_dependency.f90 | 39 +++++ example_packages/test_duplicates/app/main.f90 | 3 + example_packages/test_duplicates/fpm.toml | 21 +++ 11 files changed, 422 insertions(+) create mode 100755 ci/test_features.sh create mode 100644 example_packages/features_demo/app/debug_demo.f90 create mode 100644 example_packages/features_demo/app/main.f90 create mode 100644 example_packages/features_demo/fpm.toml create mode 100644 example_packages/features_demo/src/features_demo.f90 create mode 100644 example_packages/features_with_dependency/app/main.f90 create mode 100644 example_packages/features_with_dependency/fpm.toml create mode 100644 example_packages/features_with_dependency/src/features_with_dependency.f90 create mode 100644 example_packages/test_duplicates/app/main.f90 create mode 100644 example_packages/test_duplicates/fpm.toml diff --git a/ci/run_tests.sh b/ci/run_tests.sh index 350afd1e74..7b92dead68 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -369,5 +369,9 @@ popd # Test custom build directory functionality bash "../ci/test_custom_build_dir.sh" "$fpm" hello_world +# Test FPM features functionality +echo "=== Testing FPM Features Functionality ===" +bash "../ci/test_features.sh" "$fpm" + # Cleanup rm -rf ./*/build diff --git a/ci/test_features.sh b/ci/test_features.sh new file mode 100755 index 0000000000..4081f05cf3 --- /dev/null +++ b/ci/test_features.sh @@ -0,0 +1,160 @@ +#!/usr/bin/env bash +set -ex + +# Test script for FPM features functionality +# Usage: ./test_features.sh [fpm_executable] +# Note: This script should be run from the repo root or integrated into run_tests.sh + +if [ "$1" ]; then + fpm="$1" +else + # Default to the fpm passed from run_tests.sh or system fpm + fpm="${fpm:-fpm}" +fi + +echo "Testing FPM features functionality" + +echo "=== Testing features_demo package ===" + +# Test 1: Basic features - debug feature +pushd "features_demo" +echo "Test 1: Basic debug feature" +rm -rf build +"$fpm" run --features debug | tee output.txt +grep -q "DEBUG mode enabled" output.txt +grep -q "✓ DEBUG mode enabled" output.txt +echo "✓ Debug feature works" + +# Test 2: Profile usage - development profile (includes debug) +echo "Test 2: Development profile (debug feature)" +rm -rf build +"$fpm" run --profile development --target features_demo | tee output.txt +grep -q "DEBUG mode enabled" output.txt +echo "✓ Development profile works" + +# Test 3: Multiple features +echo "Test 3: Multiple features (debug + openmp)" +rm -rf build +"$fpm" run --features debug,openmp --target features_demo | tee output.txt +grep -q "DEBUG mode enabled" output.txt +grep -q "OpenMP support enabled" output.txt +echo "✓ Multiple features work" + +# Test 4: Feature-specific executable (debug_demo only available with debug feature) +echo "Test 4: Feature-specific executable" +rm -rf build +"$fpm" run --feature debug --target debug_demo | tee output.txt +grep -q "Debug Demo Program" output.txt +grep -q "Debug mode: ON" output.txt +echo "✓ Feature-specific executable works" + +# Test 5: Profile with multiple features - production profile (release + openmp) +echo "Test 5: Production profile (release + openmp)" +rm -rf build +"$fpm" run --profile production --target features_demo | tee output.txt +grep -q "RELEASE mode enabled" output.txt +grep -q "OpenMP support enabled" output.txt +# Should NOT have debug +! grep -q "DEBUG mode enabled" output.txt +echo "✓ Production profile works" + +# Test 6: No features - baseline behavior +echo "Test 6: No features (baseline)" +rm -rf build +"$fpm" run --target features_demo | tee output.txt +# Should have neither DEBUG nor RELEASE without explicit features +! grep -q "DEBUG mode enabled" output.txt || true +! grep -q "RELEASE mode enabled" output.txt || true +grep -q "Features: NONE" output.txt || grep -q "Demo completed successfully" output.txt +echo "✓ Baseline (no features) works" + +# Test 7: Build listing with features +echo "Test 7: Build listing with features" +rm -rf build +"$fpm" build --feature debug --list | tee build_list.txt +grep -q "debug_demo" build_list.txt +grep -q "features_demo" build_list.txt +echo "✓ Build listing with features works" + +# Test 8: Error handling - invalid feature +echo "Test 8: Error handling for invalid feature" +rm -rf build +if "$fpm" run --feature nonexistent --target features_demo 2>&1 | grep -q "undefined feature"; then + echo "✓ Correctly rejected invalid feature" +else + echo "ERROR: Should reject invalid feature" && exit 1 +fi + +# Test 9: Error handling - invalid profile +echo "Test 9: Error handling for invalid profile" +rm -rf build +if "$fpm" run --profile nonexistent --target features_demo 2>&1 | grep -q "undefined profile"; then + echo "✓ Correctly rejected invalid profile" +else + echo "ERROR: Should reject invalid profile" && exit 1 +fi + +# Test 10: Features and profile mutual exclusion +echo "Test 10: Features and profile mutual exclusion" +rm -rf build +if "$fpm" run --feature debug --profile development --target features_demo 2>&1 | grep -q "cannot specify both"; then + echo "✓ Correctly rejected features + profile combination" +else + echo "ERROR: Should reject features + profile combination" && exit 1 +fi + +# Cleanup +rm -rf build output.txt build_list.txt +popd + +echo "=== Testing features_with_dependency package ===" + +# Test dependency features +pushd "features_with_dependency" + +# Test 11: No features - should show NONE for both local and dependency +echo "Test 11: Dependency package without features" +rm -rf build +"$fpm" run | tee output.txt +grep -q "NONE - no local features active" output.txt +grep -q "Features: NONE" output.txt +echo "✓ Dependency package baseline works" + +# Test 12: Debug dependency feature +echo "Test 12: Debug dependency feature" +rm -rf build +"$fpm" run --features with_feat_debug | tee output.txt +grep -q "WITH_DEBUG_DEPENDENCY" output.txt +grep -q "DEBUG mode enabled" output.txt +echo "✓ Debug dependency feature works" + +# Test 13: Release dependency feature +echo "Test 13: Release dependency feature" +rm -rf build +"$fpm" run --features with_feat_release | tee output.txt +grep -q "WITH_RELEASE_DEPENDENCY" output.txt +grep -q "RELEASE mode enabled" output.txt +echo "✓ Release dependency feature works" + +# Test 14: Multi dependency feature +echo "Test 14: Multi dependency feature" +rm -rf build +"$fpm" run --features with_feat_multi | tee output.txt +grep -q "WITH_MULTI_DEPENDENCY" output.txt +grep -q "DEBUG mode enabled" output.txt +grep -q "MPI support enabled" output.txt +echo "✓ Multi dependency feature works" + +# Test 15: Profile with dependency features +echo "Test 15: Debug dependency profile" +rm -rf build +"$fpm" run --profile debug_dep | tee output.txt +grep -q "WITH_DEBUG_DEPENDENCY" output.txt +grep -q "DEBUG mode enabled" output.txt +echo "✓ Debug dependency profile works" + +# Cleanup +rm -rf build output.txt +popd + +echo "All FPM features tests passed!" \ No newline at end of file diff --git a/example_packages/features_demo/app/debug_demo.f90 b/example_packages/features_demo/app/debug_demo.f90 new file mode 100644 index 0000000000..6b7a44c768 --- /dev/null +++ b/example_packages/features_demo/app/debug_demo.f90 @@ -0,0 +1,16 @@ +program debug_demo + use features_demo + implicit none + + write(*,*) 'Debug Demo Program' + write(*,*) '==================' + +#ifdef DEBUG + write(*,*) 'Debug mode: ON' +#else + write(*,*) 'Debug mode: OFF' +#endif + + call show_features() + +end program debug_demo diff --git a/example_packages/features_demo/app/main.f90 b/example_packages/features_demo/app/main.f90 new file mode 100644 index 0000000000..fcabe98cb6 --- /dev/null +++ b/example_packages/features_demo/app/main.f90 @@ -0,0 +1,12 @@ +program main + use features_demo + implicit none + + call show_features() + + write(*,*) '' + write(*,*) get_build_info() + write(*,*) '' + write(*,*) 'Demo completed successfully!' + +end program main \ No newline at end of file diff --git a/example_packages/features_demo/fpm.toml b/example_packages/features_demo/fpm.toml new file mode 100644 index 0000000000..2f03836dc3 --- /dev/null +++ b/example_packages/features_demo/fpm.toml @@ -0,0 +1,35 @@ +name = "features_demo" +version = "0.1.0" +license = "MIT" +description = "Demo package for FPM features functionality" + +[[executable]] +name = "features_demo" +source-dir = "app" +main = "main.f90" + +[features] +# Base debug feature +debug.flags = "-g" +debug.preprocess.cpp.macros = "DEBUG" + +# Release feature +release.flags = "-O3" +release.preprocess.cpp.macros = "RELEASE" + +# Compiler-specific features +debug.gfortran.flags = "-Wall -fcheck=bounds" +release.gfortran.flags = "-march=native" + +# Platform-specific features +linux.preprocess.cpp.macros = "LINUX_BUILD" + +# Parallel features +mpi.preprocess.cpp.macros = "USE_MPI" +mpi.dependencies.mpi = "*" +openmp.preprocess.cpp.macros = "USE_OPENMP" +openmp.dependencies.openmp = "*" + +[profiles] +development = ["debug"] +production = ["release", "openmp"] diff --git a/example_packages/features_demo/src/features_demo.f90 b/example_packages/features_demo/src/features_demo.f90 new file mode 100644 index 0000000000..b3de35e0d3 --- /dev/null +++ b/example_packages/features_demo/src/features_demo.f90 @@ -0,0 +1,78 @@ +module features_demo + implicit none + private + public :: show_features, get_build_info + +contains + + !> Display which features are enabled + subroutine show_features() + write(*,*) 'FPM Features Demo' + write(*,*) '=================' + + ! Debug/Release flags +#ifdef DEBUG + write(*,*) '✓ DEBUG mode enabled' +#endif +#ifdef RELEASE + write(*,*) '✓ RELEASE mode enabled' +#endif + + ! Platform detection +#ifdef LINUX_BUILD + write(*,*) '✓ Linux platform detected' +#endif +#ifdef WINDOWS_BUILD + write(*,*) '✓ Windows platform detected' +#endif + + ! Parallel features +#ifdef USE_MPI + write(*,*) '✓ MPI support enabled' +#endif +#ifdef USE_OPENMP + write(*,*) '✓ OpenMP support enabled' +#endif + + ! Compiler info (if available) + write(*,*) 'Build configuration:' + call show_compiler_info() + + end subroutine show_features + + !> Show compiler information + subroutine show_compiler_info() +#ifdef __GFORTRAN__ + write(*,*) ' - Compiler: GNU Fortran' +#endif +#ifdef __INTEL_COMPILER + write(*,*) ' - Compiler: Intel Fortran' +#endif + end subroutine show_compiler_info + + !> Get build information as a string + function get_build_info() result(info) + character(len=200) :: info + + info = 'Features: ' + +#ifdef DEBUG + info = trim(info) // 'DEBUG ' +#endif +#ifdef RELEASE + info = trim(info) // 'RELEASE ' +#endif +#ifdef USE_MPI + info = trim(info) // 'MPI ' +#endif +#ifdef USE_OPENMP + info = trim(info) // 'OPENMP ' +#endif + + if (len_trim(info) == 10) then ! Only "Features: " + info = trim(info) // 'NONE' + end if + + end function get_build_info + +end module features_demo \ No newline at end of file diff --git a/example_packages/features_with_dependency/app/main.f90 b/example_packages/features_with_dependency/app/main.f90 new file mode 100644 index 0000000000..8cc1197a7c --- /dev/null +++ b/example_packages/features_with_dependency/app/main.f90 @@ -0,0 +1,13 @@ +program features_with_dependency + use features_with_dependency, only: show_features + implicit none + + print *, "=== Features with Dependency Demo ===" + print *, "" + + call show_features() + + print *, "" + print *, "This demonstrates feature propagation to dependencies." + +end program features_with_dependency diff --git a/example_packages/features_with_dependency/fpm.toml b/example_packages/features_with_dependency/fpm.toml new file mode 100644 index 0000000000..48766ce727 --- /dev/null +++ b/example_packages/features_with_dependency/fpm.toml @@ -0,0 +1,41 @@ +name = "features_with_dependency" +version = "0.1.0" +license = "MIT" +description = "Demo package testing dependency features" + +[[executable]] +name = "features_with_dependency" +source-dir = "app" +main = "main.f90" + +# Enable cpp preprocessing on the main program +[preprocess.cpp] + +[dependencies] +# Base dependencies (none for this demo - features will add them) + +[features] +# Feature that enables debug mode in the dependency +with_feat_debug.dependencies.features_demo = { path = "../features_demo", features = ["debug"] } +with_feat_debug.preprocess.cpp.macros = "WITH_DEBUG_DEPENDENCY" + +# Feature that enables release mode in the dependency +with_feat_release.dependencies.features_demo = { path = "../features_demo", features = ["release"] } +with_feat_release.preprocess.cpp.macros = "WITH_RELEASE_DEPENDENCY" + +# Feature that enables multiple dependency features +with_feat_multi.dependencies.features_demo = { path = "../features_demo", features = ["debug", "mpi"] } +with_feat_multi.preprocess.cpp.macros = "WITH_MULTI_DEPENDENCY" + +# Feature for platform-specific dependency features +linux_specific.linux.dependencies.features_demo = { path = "../features_demo", features = ["linux"] } +linux_specific.preprocess.cpp.macros = "LINUX_FEATURES" + +# Feature combining compiler and dependency features +gfortran_optimized.gfortran.dependencies.features_demo = { path = "../features_demo", features = ["release", "gfortran"] } +gfortran_optimized.gfortran.flags = "-O3 -march=native" + +[profiles] +debug_dep = ["with_feat_debug"] +release_dep = ["with_feat_release"] +full_test = ["with_feat_multi", "linux_specific"] diff --git a/example_packages/features_with_dependency/src/features_with_dependency.f90 b/example_packages/features_with_dependency/src/features_with_dependency.f90 new file mode 100644 index 0000000000..2f49c45727 --- /dev/null +++ b/example_packages/features_with_dependency/src/features_with_dependency.f90 @@ -0,0 +1,39 @@ +module features_with_dependency + use features_demo, only: show_features => show_features, get_build_info + implicit none + private + public :: show_features => show_local_features + +contains + + subroutine show_local_features() + print *, "Local package features:" + +#ifdef WITH_DEBUG_DEPENDENCY + print *, "✓ WITH_DEBUG_DEPENDENCY - dependency built with debug features" +#endif + +#ifdef WITH_RELEASE_DEPENDENCY + print *, "✓ WITH_RELEASE_DEPENDENCY - dependency built with release features" +#endif + +#ifdef WITH_MULTI_DEPENDENCY + print *, "✓ WITH_MULTI_DEPENDENCY - dependency built with debug+mpi features" +#endif + +#ifdef LINUX_FEATURES + print *, "✓ LINUX_FEATURES - Linux-specific dependency features" +#endif + + ! If no local features are active +#if !defined(WITH_DEBUG_DEPENDENCY) && !defined(WITH_RELEASE_DEPENDENCY) && !defined(WITH_MULTI_DEPENDENCY) && !defined(LINUX_FEATURES) + print *, " NONE - no local features active" +#endif + + print *, "" + print *, "Dependency (features_demo) status:" + call show_features() ! Call features_demo's show_features + + end subroutine show_local_features + +end module features_with_dependency \ No newline at end of file diff --git a/example_packages/test_duplicates/app/main.f90 b/example_packages/test_duplicates/app/main.f90 new file mode 100644 index 0000000000..d7544d4ec3 --- /dev/null +++ b/example_packages/test_duplicates/app/main.f90 @@ -0,0 +1,3 @@ +program test_program + print *, "Hello from test program" +end program test_program \ No newline at end of file diff --git a/example_packages/test_duplicates/fpm.toml b/example_packages/test_duplicates/fpm.toml new file mode 100644 index 0000000000..69cbb4a6fc --- /dev/null +++ b/example_packages/test_duplicates/fpm.toml @@ -0,0 +1,21 @@ +name = "test_duplicates" +version = "0.1.0" + +[[executable]] +name = "test_program" +source-dir = "app" +main = "main.f90" + +[features] +# This should cause a duplicate executable error when features are combined +feature1.executable.name = "my_exe" +feature1.executable.source-dir = "app1" +feature1.executable.main = "main1.f90" + +feature2.executable.name = "my_exe" # Same name - should cause duplicate error +feature2.executable.source-dir = "app2" +feature2.executable.main = "main2.f90" + +[profiles] +# This profile combines features with duplicate executables +combined = ["feature1", "feature2"] \ No newline at end of file From 2c2159f4052636256ed30b31cd8a362ea7417fb7 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 8 Sep 2025 22:12:27 +0200 Subject: [PATCH 27/59] add macos fix --- src/fpm_targets.f90 | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index a1635848bf..3be8c1c02d 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -1238,11 +1238,10 @@ subroutine resolve_target_linking(targets, model, library, error) error=error, & exclude_self=.not.has_self_lib) - - ! On macOS, add room for 2 install_name_tool paths - target%link_flags = target%link_flags // model%compiler%get_headerpad_flags() - end if + + ! On macOS, add room for 2 install_name_tool paths + target%link_flags = target%link_flags // model%compiler%get_headerpad_flags() if (allocated(target%link_libraries)) then if (size(target%link_libraries) > 0) then From ca94a39c1d52be30c322f1a92c750bc10f880efe Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 8 Sep 2025 22:17:37 +0200 Subject: [PATCH 28/59] fix features test --- ci/test_features.sh | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/ci/test_features.sh b/ci/test_features.sh index 4081f05cf3..b1054f403a 100755 --- a/ci/test_features.sh +++ b/ci/test_features.sh @@ -43,7 +43,7 @@ echo "✓ Multiple features work" # Test 4: Feature-specific executable (debug_demo only available with debug feature) echo "Test 4: Feature-specific executable" rm -rf build -"$fpm" run --feature debug --target debug_demo | tee output.txt +"$fpm" run --features debug --target debug_demo | tee output.txt grep -q "Debug Demo Program" output.txt grep -q "Debug mode: ON" output.txt echo "✓ Feature-specific executable works" @@ -71,7 +71,7 @@ echo "✓ Baseline (no features) works" # Test 7: Build listing with features echo "Test 7: Build listing with features" rm -rf build -"$fpm" build --feature debug --list | tee build_list.txt +"$fpm" build --features debug --list | tee build_list.txt grep -q "debug_demo" build_list.txt grep -q "features_demo" build_list.txt echo "✓ Build listing with features works" @@ -79,7 +79,7 @@ echo "✓ Build listing with features works" # Test 8: Error handling - invalid feature echo "Test 8: Error handling for invalid feature" rm -rf build -if "$fpm" run --feature nonexistent --target features_demo 2>&1 | grep -q "undefined feature"; then +if "$fpm" run --features nonexistent --target features_demo 2>&1 | grep -q "undefined feature"; then echo "✓ Correctly rejected invalid feature" else echo "ERROR: Should reject invalid feature" && exit 1 @@ -97,7 +97,7 @@ fi # Test 10: Features and profile mutual exclusion echo "Test 10: Features and profile mutual exclusion" rm -rf build -if "$fpm" run --feature debug --profile development --target features_demo 2>&1 | grep -q "cannot specify both"; then +if "$fpm" run --features debug --profile development --target features_demo 2>&1 | grep -q "cannot specify both"; then echo "✓ Correctly rejected features + profile combination" else echo "ERROR: Should reject features + profile combination" && exit 1 @@ -157,4 +157,4 @@ echo "✓ Debug dependency profile works" rm -rf build output.txt popd -echo "All FPM features tests passed!" \ No newline at end of file +echo "All FPM features tests passed!" From 9ec4ebb7bccf82a615ea7d562bd9efb982ac4e13 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 8 Sep 2025 22:35:45 +0200 Subject: [PATCH 29/59] fix most tests --- ci/test_features.sh | 111 ++++++++++++++++++----------------- src/fpm/manifest/package.f90 | 2 - 2 files changed, 57 insertions(+), 56 deletions(-) diff --git a/ci/test_features.sh b/ci/test_features.sh index b1054f403a..6bbc32e346 100755 --- a/ci/test_features.sh +++ b/ci/test_features.sh @@ -21,41 +21,43 @@ pushd "features_demo" echo "Test 1: Basic debug feature" rm -rf build "$fpm" run --features debug | tee output.txt -grep -q "DEBUG mode enabled" output.txt -grep -q "✓ DEBUG mode enabled" output.txt +grep -q "DEBUG mode enabled" output.txt || { echo "ERROR: DEBUG mode not enabled"; exit 1; } echo "✓ Debug feature works" # Test 2: Profile usage - development profile (includes debug) echo "Test 2: Development profile (debug feature)" rm -rf build "$fpm" run --profile development --target features_demo | tee output.txt -grep -q "DEBUG mode enabled" output.txt +grep -q "DEBUG mode enabled" output.txt || { echo "ERROR: DEBUG mode not enabled in development profile"; exit 1; } echo "✓ Development profile works" # Test 3: Multiple features echo "Test 3: Multiple features (debug + openmp)" rm -rf build "$fpm" run --features debug,openmp --target features_demo | tee output.txt -grep -q "DEBUG mode enabled" output.txt -grep -q "OpenMP support enabled" output.txt +grep -q "DEBUG mode enabled" output.txt || { echo "ERROR: DEBUG mode not enabled with multiple features"; exit 1; } +grep -q "OpenMP support enabled" output.txt || { echo "ERROR: OpenMP not enabled with multiple features"; exit 1; } echo "✓ Multiple features work" # Test 4: Feature-specific executable (debug_demo only available with debug feature) echo "Test 4: Feature-specific executable" rm -rf build "$fpm" run --features debug --target debug_demo | tee output.txt -grep -q "Debug Demo Program" output.txt -grep -q "Debug mode: ON" output.txt +grep -q "Debug Demo Program" output.txt || { echo "ERROR: Debug Demo Program not found"; exit 1; } +grep -q "Debug mode: ON" output.txt || { echo "ERROR: Debug mode not ON in debug_demo"; exit 1; } echo "✓ Feature-specific executable works" # Test 5: Profile with multiple features - production profile (release + openmp) echo "Test 5: Production profile (release + openmp)" rm -rf build "$fpm" run --profile production --target features_demo | tee output.txt -grep -q "RELEASE mode enabled" output.txt -grep -q "OpenMP support enabled" output.txt +grep -q "RELEASE mode enabled" output.txt || { echo "ERROR: RELEASE mode not enabled in production profile"; exit 1; } +grep -q "OpenMP support enabled" output.txt || { echo "ERROR: OpenMP not enabled in production profile"; exit 1; } # Should NOT have debug -! grep -q "DEBUG mode enabled" output.txt +if grep -q "DEBUG mode enabled" output.txt; then + echo "ERROR: DEBUG mode should not be enabled in production profile" + exit 1 +fi echo "✓ Production profile works" # Test 6: No features - baseline behavior @@ -63,42 +65,43 @@ echo "Test 6: No features (baseline)" rm -rf build "$fpm" run --target features_demo | tee output.txt # Should have neither DEBUG nor RELEASE without explicit features -! grep -q "DEBUG mode enabled" output.txt || true -! grep -q "RELEASE mode enabled" output.txt || true -grep -q "Features: NONE" output.txt || grep -q "Demo completed successfully" output.txt +if grep -q "DEBUG mode enabled" output.txt; then + echo "ERROR: DEBUG mode should not be enabled in baseline" + exit 1 +fi +if grep -q "RELEASE mode enabled" output.txt; then + echo "ERROR: RELEASE mode should not be enabled in baseline" + exit 1 +fi +if ! grep -q "Features: NONE" output.txt && ! grep -q "Demo completed successfully" output.txt; then + echo "ERROR: Expected baseline features output not found" + exit 1 +fi echo "✓ Baseline (no features) works" -# Test 7: Build listing with features -echo "Test 7: Build listing with features" -rm -rf build -"$fpm" build --features debug --list | tee build_list.txt -grep -q "debug_demo" build_list.txt -grep -q "features_demo" build_list.txt -echo "✓ Build listing with features works" - -# Test 8: Error handling - invalid feature -echo "Test 8: Error handling for invalid feature" +# Test 7: Error handling - invalid feature +echo "Test 7: Error handling for invalid feature" rm -rf build -if "$fpm" run --features nonexistent --target features_demo 2>&1 | grep -q "undefined feature"; then - echo "✓ Correctly rejected invalid feature" +if ! "$fpm" run --features nonexistent --target features_demo > /dev/null 2>&1; then + echo "Correctly rejected invalid feature" else echo "ERROR: Should reject invalid feature" && exit 1 fi -# Test 9: Error handling - invalid profile -echo "Test 9: Error handling for invalid profile" +# Test 8: Error handling - invalid profile +echo "Test 8: Error handling for invalid profile" rm -rf build -if "$fpm" run --profile nonexistent --target features_demo 2>&1 | grep -q "undefined profile"; then - echo "✓ Correctly rejected invalid profile" +if ! "$fpm" run --profile nonexistent --target features_demo > /dev/null 2>&1; then + echo "Correctly rejected invalid profile" else echo "ERROR: Should reject invalid profile" && exit 1 fi -# Test 10: Features and profile mutual exclusion -echo "Test 10: Features and profile mutual exclusion" +# Test 9: Features and profile mutual exclusion +echo "Test 9: Features and profile mutual exclusion" rm -rf build -if "$fpm" run --features debug --profile development --target features_demo 2>&1 | grep -q "cannot specify both"; then - echo "✓ Correctly rejected features + profile combination" +if ! "$fpm" run --features debug --profile development --target features_demo > /dev/null 2>&1; then + echo "Correctly rejected features + profile combination" else echo "ERROR: Should reject features + profile combination" && exit 1 fi @@ -112,45 +115,45 @@ echo "=== Testing features_with_dependency package ===" # Test dependency features pushd "features_with_dependency" -# Test 11: No features - should show NONE for both local and dependency -echo "Test 11: Dependency package without features" +# Test 10: No features - should show NONE for both local and dependency +echo "Test 10: Dependency package without features" rm -rf build "$fpm" run | tee output.txt -grep -q "NONE - no local features active" output.txt -grep -q "Features: NONE" output.txt +grep -q "NONE - no local features active" output.txt || { echo "ERROR: Local features NONE message not found"; exit 1; } +grep -q "Features: NONE" output.txt || { echo "ERROR: Features NONE not found in dependency test"; exit 1; } echo "✓ Dependency package baseline works" -# Test 12: Debug dependency feature -echo "Test 12: Debug dependency feature" +# Test 11: Debug dependency feature +echo "Test 11: Debug dependency feature" rm -rf build "$fpm" run --features with_feat_debug | tee output.txt -grep -q "WITH_DEBUG_DEPENDENCY" output.txt -grep -q "DEBUG mode enabled" output.txt +grep -q "WITH_DEBUG_DEPENDENCY" output.txt || { echo "ERROR: WITH_DEBUG_DEPENDENCY not found"; exit 1; } +grep -q "DEBUG mode enabled" output.txt || { echo "ERROR: DEBUG mode not enabled in dependency test"; exit 1; } echo "✓ Debug dependency feature works" -# Test 13: Release dependency feature -echo "Test 13: Release dependency feature" +# Test 12: Release dependency feature +echo "Test 12: Release dependency feature" rm -rf build "$fpm" run --features with_feat_release | tee output.txt -grep -q "WITH_RELEASE_DEPENDENCY" output.txt -grep -q "RELEASE mode enabled" output.txt +grep -q "WITH_RELEASE_DEPENDENCY" output.txt || { echo "ERROR: WITH_RELEASE_DEPENDENCY not found"; exit 1; } +grep -q "RELEASE mode enabled" output.txt || { echo "ERROR: RELEASE mode not enabled in dependency test"; exit 1; } echo "✓ Release dependency feature works" -# Test 14: Multi dependency feature -echo "Test 14: Multi dependency feature" +# Test 13: Multi dependency feature +echo "Test 13: Multi dependency feature" rm -rf build "$fpm" run --features with_feat_multi | tee output.txt -grep -q "WITH_MULTI_DEPENDENCY" output.txt -grep -q "DEBUG mode enabled" output.txt -grep -q "MPI support enabled" output.txt +grep -q "WITH_MULTI_DEPENDENCY" output.txt || { echo "ERROR: WITH_MULTI_DEPENDENCY not found"; exit 1; } +grep -q "DEBUG mode enabled" output.txt || { echo "ERROR: DEBUG mode not enabled in multi dependency test"; exit 1; } +grep -q "MPI support enabled" output.txt || { echo "ERROR: MPI support not enabled in multi dependency test"; exit 1; } echo "✓ Multi dependency feature works" -# Test 15: Profile with dependency features -echo "Test 15: Debug dependency profile" +# Test 14: Profile with dependency features +echo "Test 14: Debug dependency profile" rm -rf build "$fpm" run --profile debug_dep | tee output.txt -grep -q "WITH_DEBUG_DEPENDENCY" output.txt -grep -q "DEBUG mode enabled" output.txt +grep -q "WITH_DEBUG_DEPENDENCY" output.txt || { echo "ERROR: WITH_DEBUG_DEPENDENCY not found in profile test"; exit 1; } +grep -q "DEBUG mode enabled" output.txt || { echo "ERROR: DEBUG mode not enabled in dependency profile test"; exit 1; } echo "✓ Debug dependency profile works" # Cleanup diff --git a/src/fpm/manifest/package.f90 b/src/fpm/manifest/package.f90 index f27e8fd24d..9c4d665245 100644 --- a/src/fpm/manifest/package.f90 +++ b/src/fpm/manifest/package.f90 @@ -612,8 +612,6 @@ type(package_config_t) function export_config(self, platform, features, profile, return end if - print *, 'merge feature ',want_features(i)%s,' into ',cfg%name - ! Add it to the current configuration call self%features(idx)%merge_into_package(cfg, platform, error) if (allocated(error)) return From 8e3773717d3e8e0d41d0c99ea48306ff79692112 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 9 Sep 2025 09:02:32 +0200 Subject: [PATCH 30/59] update features_with_dependency test --- .../features_with_dependency/fpm.toml | 13 ++++++------ .../src/features_with_dependency.f90 | 20 ++++++++++++------- 2 files changed, 19 insertions(+), 14 deletions(-) diff --git a/example_packages/features_with_dependency/fpm.toml b/example_packages/features_with_dependency/fpm.toml index 48766ce727..055c6dbffd 100644 --- a/example_packages/features_with_dependency/fpm.toml +++ b/example_packages/features_with_dependency/fpm.toml @@ -8,32 +8,31 @@ name = "features_with_dependency" source-dir = "app" main = "main.f90" -# Enable cpp preprocessing on the main program -[preprocess.cpp] - [dependencies] # Base dependencies (none for this demo - features will add them) [features] # Feature that enables debug mode in the dependency with_feat_debug.dependencies.features_demo = { path = "../features_demo", features = ["debug"] } -with_feat_debug.preprocess.cpp.macros = "WITH_DEBUG_DEPENDENCY" +with_feat_debug.preprocess.cpp.macros = ["WITH_DEMO","WITH_DEBUG_DEPENDENCY"] # Feature that enables release mode in the dependency with_feat_release.dependencies.features_demo = { path = "../features_demo", features = ["release"] } -with_feat_release.preprocess.cpp.macros = "WITH_RELEASE_DEPENDENCY" +with_feat_release.preprocess.cpp.macros = ["WITH_DEMO","WITH_RELEASE_DEPENDENCY"] # Feature that enables multiple dependency features with_feat_multi.dependencies.features_demo = { path = "../features_demo", features = ["debug", "mpi"] } -with_feat_multi.preprocess.cpp.macros = "WITH_MULTI_DEPENDENCY" +with_feat_multi.preprocess.cpp.macros = ["WITH_DEMO","WITH_MULTI_DEPENDENCY"] # Feature for platform-specific dependency features linux_specific.linux.dependencies.features_demo = { path = "../features_demo", features = ["linux"] } -linux_specific.preprocess.cpp.macros = "LINUX_FEATURES" +linux_specific.preprocess.cpp.macros = ["WITH_DEMO","LINUX_FEATURES"] # Feature combining compiler and dependency features gfortran_optimized.gfortran.dependencies.features_demo = { path = "../features_demo", features = ["release", "gfortran"] } gfortran_optimized.gfortran.flags = "-O3 -march=native" +gfortran_optimized.preprocess.cpp.macros = ["WITH_DEMO"] + [profiles] debug_dep = ["with_feat_debug"] diff --git a/example_packages/features_with_dependency/src/features_with_dependency.f90 b/example_packages/features_with_dependency/src/features_with_dependency.f90 index 2f49c45727..b8eccdf7a3 100644 --- a/example_packages/features_with_dependency/src/features_with_dependency.f90 +++ b/example_packages/features_with_dependency/src/features_with_dependency.f90 @@ -1,12 +1,14 @@ module features_with_dependency - use features_demo, only: show_features => show_features, get_build_info +#ifdef WITH_DEMO + use features_demo, only: show_demo_features => show_features +#endif implicit none private - public :: show_features => show_local_features + public :: show_features contains - subroutine show_local_features() + subroutine show_features() print *, "Local package features:" #ifdef WITH_DEBUG_DEPENDENCY @@ -31,9 +33,13 @@ subroutine show_local_features() #endif print *, "" - print *, "Dependency (features_demo) status:" - call show_features() ! Call features_demo's show_features +#ifdef WITH_DEMO + print *, "Dependency (features_demo) status:" + call show_demo_features() ! Call features_demo's show_features +#else + print *, "Dependency (features_demo) is not attached" +#endif - end subroutine show_local_features + end subroutine show_features -end module features_with_dependency \ No newline at end of file +end module features_with_dependency From 1a1676f48936755b8044a6c39a2e59b656021cfa Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 11 Sep 2025 15:04:42 +0200 Subject: [PATCH 31/59] intel fix: do not access unallocated `flags` --- src/fpm.f90 | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 33452e24af..38844f432c 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -318,15 +318,19 @@ subroutine new_compiler_flags(model,settings) character(len=:), allocatable :: flags, cflags, cxxflags, ldflags - if (settings%flag == '') then - flags = model%compiler%get_default_flags(settings%profile == "release") - else + if (len(settings%flag)>0) then + flags = settings%flag + + elseif (allocated(settings%profile)) then + select case(settings%profile) case("release", "debug") - flags = flags // model%compiler%get_default_flags(settings%profile == "release") - end select - end if + flags = model%compiler%get_default_flags(release = .true.) + case ("debug") + flags = model%compiler%get_default_flags(release = .false.) + end select + end if cflags = trim(settings%cflag) cxxflags = trim(settings%cxxflag) From 1135492986d60e5125146f349eec2841fd30ab84 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 11 Sep 2025 15:17:09 +0200 Subject: [PATCH 32/59] typo --- src/fpm.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 38844f432c..1fd40bb24d 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -325,7 +325,7 @@ subroutine new_compiler_flags(model,settings) elseif (allocated(settings%profile)) then select case(settings%profile) - case("release", "debug") + case("release") flags = model%compiler%get_default_flags(release = .true.) case ("debug") flags = model%compiler%get_default_flags(release = .false.) From e83c1c6f515cfec8bd435163b1edbcfcb83a2188 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 11 Sep 2025 15:26:28 +0200 Subject: [PATCH 33/59] deactivate blank case --- ci/test_features.sh | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/ci/test_features.sh b/ci/test_features.sh index 6bbc32e346..d0436d1cfd 100755 --- a/ci/test_features.sh +++ b/ci/test_features.sh @@ -115,13 +115,14 @@ echo "=== Testing features_with_dependency package ===" # Test dependency features pushd "features_with_dependency" +# RE-ENABLE AFTER MERGING fpm WITH CPP PARSING PR # Test 10: No features - should show NONE for both local and dependency -echo "Test 10: Dependency package without features" +# echo "Test 10: Dependency package without features" rm -rf build -"$fpm" run | tee output.txt -grep -q "NONE - no local features active" output.txt || { echo "ERROR: Local features NONE message not found"; exit 1; } -grep -q "Features: NONE" output.txt || { echo "ERROR: Features NONE not found in dependency test"; exit 1; } -echo "✓ Dependency package baseline works" +#"$fpm" run | tee output.txt +# grep -q "NONE - no local features active" output.txt || { echo "ERROR: Local features NONE message not found"; exit 1; } +# grep -q "Features: NONE" output.txt || { echo "ERROR: Features NONE not found in dependency test"; exit 1; } +# echo "✓ Dependency package baseline works" # Test 11: Debug dependency feature echo "Test 11: Debug dependency feature" From dcca0fe16a038e7699810d7a70b37f0fa05d7401 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 11 Sep 2025 18:08:24 +0200 Subject: [PATCH 34/59] metapackage fix: clean before reading manifest, not after; refactor intel fix --- src/fpm.f90 | 33 ++++++++++++++++++++------------- src/fpm/manifest/package.f90 | 6 +++--- 2 files changed, 23 insertions(+), 16 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 1fd40bb24d..e1ce1b6dd3 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -317,20 +317,27 @@ subroutine new_compiler_flags(model,settings) type(fpm_build_settings), intent(in) :: settings character(len=:), allocatable :: flags, cflags, cxxflags, ldflags - - if (len(settings%flag)>0) then - + logical :: release_profile + + if (allocated(settings%profile)) then + release_profile = settings%profile == "release" + else + release_profile = .false. + end if + + if (.not.allocated(settings%flag)) then + flags = model%compiler%get_default_flags(release_profile) + elseif (settings%flag == '') then + flags = model%compiler%get_default_flags(release_profile) + else flags = settings%flag - - elseif (allocated(settings%profile)) then - - select case(settings%profile) - case("release") - flags = model%compiler%get_default_flags(release = .true.) - case ("debug") - flags = model%compiler%get_default_flags(release = .false.) - end select - end if + if (allocated(settings%profile)) then + select case(settings%profile) + case("release", "debug") + flags = flags // model%compiler%get_default_flags(release_profile) + end select + endif + end if cflags = trim(settings%cflag) cxxflags = trim(settings%cxxflag) diff --git a/src/fpm/manifest/package.f90 b/src/fpm/manifest/package.f90 index 9c4d665245..cf8e80a121 100644 --- a/src/fpm/manifest/package.f90 +++ b/src/fpm/manifest/package.f90 @@ -133,6 +133,9 @@ subroutine new_package(self, table, root, error) type(toml_array), pointer :: children character(len=:), allocatable :: version, version_file integer :: ii, nn, stat, io + + ! Ensure metapackage data is initialized although off + call self%meta%reset() call check(table, error) if (allocated(error)) return @@ -219,9 +222,6 @@ subroutine new_package(self, table, root, error) call validate_profiles(self, error) if (allocated(error)) return - ! Ensure metapackage data is initialized although off - call self%meta%reset() - end subroutine new_package From 1c664a7b009cc66f2b36c700b26fb748d57084fd Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 11 Sep 2025 18:20:26 +0200 Subject: [PATCH 35/59] gcc-15 fix --- ci/meta_tests.sh | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ci/meta_tests.sh b/ci/meta_tests.sh index 6c1754e491..f0c9eb53db 100755 --- a/ci/meta_tests.sh +++ b/ci/meta_tests.sh @@ -28,8 +28,8 @@ pushd metapackage_stdlib popd pushd metapackage_minpack -"$fpm" build --verbose -"$fpm" run --verbose +"$fpm" build --verbose --flag " -Wno-external-argument-mismatch" +"$fpm" run --verbose --flag " -Wno-external-argument-mismatch" popd pushd metapackage_mpi From 6ae0ba1ab697d940d573b3cce9ce9d7e6bed9746 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 11 Sep 2025 18:39:56 +0200 Subject: [PATCH 36/59] intel fix: change program name --- example_packages/features_with_dependency/app/main.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/example_packages/features_with_dependency/app/main.f90 b/example_packages/features_with_dependency/app/main.f90 index 8cc1197a7c..d0039204e2 100644 --- a/example_packages/features_with_dependency/app/main.f90 +++ b/example_packages/features_with_dependency/app/main.f90 @@ -1,4 +1,4 @@ -program features_with_dependency +program features_with_dependency_demo use features_with_dependency, only: show_features implicit none @@ -10,4 +10,4 @@ program features_with_dependency print *, "" print *, "This demonstrates feature propagation to dependencies." -end program features_with_dependency +end program features_with_dependency_demo From 4af88dffb7d7d86e26870ca9551716280b58754c Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 15 Sep 2025 09:47:20 +0200 Subject: [PATCH 37/59] Update src/fpm_targets.f90 Co-authored-by: Copilot <175728472+Copilot@users.noreply.github.com> --- src/fpm_targets.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index eb313c9fbd..8c5872a239 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -1244,7 +1244,6 @@ subroutine resolve_target_linking(targets, model, library, error) target%link_flags = target%link_flags // model%compiler%get_headerpad_flags() ! On macOS, add room for 2 install_name_tool paths (always needed for executables) - target%link_flags = target%link_flags // model%compiler%get_headerpad_flags() if (allocated(target%link_libraries)) then if (size(target%link_libraries) > 0) then From 2e94e79e567ac1f45aeee4918544e5744bd9eb92 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 21 Sep 2025 11:10:03 +0200 Subject: [PATCH 38/59] fix example --- example_packages/features_demo/src/features_demo.f90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/example_packages/features_demo/src/features_demo.f90 b/example_packages/features_demo/src/features_demo.f90 index b3de35e0d3..86984ee56a 100644 --- a/example_packages/features_demo/src/features_demo.f90 +++ b/example_packages/features_demo/src/features_demo.f90 @@ -57,16 +57,16 @@ function get_build_info() result(info) info = 'Features: ' #ifdef DEBUG - info = trim(info) // 'DEBUG ' + info = trim(info) // ' DEBUG' #endif #ifdef RELEASE - info = trim(info) // 'RELEASE ' + info = trim(info) // ' RELEASE' #endif #ifdef USE_MPI - info = trim(info) // 'MPI ' + info = trim(info) // ' MPI' #endif #ifdef USE_OPENMP - info = trim(info) // 'OPENMP ' + info = trim(info) // ' OPENMP' #endif if (len_trim(info) == 10) then ! Only "Features: " @@ -75,4 +75,4 @@ function get_build_info() result(info) end function get_build_info -end module features_demo \ No newline at end of file +end module features_demo From d5ca48abe665b378fc0bcb3d5dae36d28369d204 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 21 Sep 2025 11:10:19 +0200 Subject: [PATCH 39/59] generalize compile flags --- src/fpm.f90 | 81 +++++++++++++++++++++--------------- src/fpm/manifest/package.f90 | 3 ++ 2 files changed, 50 insertions(+), 34 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index e1ce1b6dd3..0f2bc0c3c7 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -75,15 +75,20 @@ subroutine build_model(model, settings, package_config, error) ! Extract the target platform for this build target_platform = model%target_platform() - - call new_compiler_flags(model,settings) + model%build_dir = settings%build_dir model%build_prefix = join_path(settings%build_dir, basename(model%compiler%fc)) - model%include_tests = settings%build_tests - + model%include_tests = settings%build_tests + + if (allocated(settings%features)) print *, 'features: ',(settings%features(i)%s//' ',i=1,size(settings%features)) + if (allocated(settings%profile)) print *, 'profile: ',settings%profile + ! Extract the current package configuration request package = package_config%export_config(target_platform,settings%features,settings%profile,error) - if (allocated(error)) return + if (allocated(error)) return + + ! Initialize compiler flags using the feature-enabled package configuration + call new_compiler_flags(model, settings, package) ! Resolve meta-dependencies into the package and the model call resolve_metapackages(model,package,settings,error) @@ -311,42 +316,50 @@ subroutine build_model(model, settings, package_config, error) end if end subroutine build_model -!> Initialize model compiler flags -subroutine new_compiler_flags(model,settings) +!> Helper: safely get string from either CLI or package, with fallback +pure function assemble_flags(cli_flag, package_flag, fallback) result(flags) + character(len=*), optional, intent(in) :: cli_flag, package_flag, fallback + character(len=:), allocatable :: flags + + allocate(character(len=0) :: flags) + + if (present(cli_flag)) flags = flags // ' ' // trim(cli_flag) + if (present(package_flag)) flags = flags // ' ' // trim(package_flag) + if (present(fallback)) flags = flags // ' ' // trim(fallback) + +end function assemble_flags + +!> Initialize model compiler flags from CLI settings and package configuration +subroutine new_compiler_flags(model, settings, package) type(fpm_model_t), intent(inout) :: model type(fpm_build_settings), intent(in) :: settings + type(package_config_t), intent(in) :: package - character(len=:), allocatable :: flags, cflags, cxxflags, ldflags - logical :: release_profile + logical :: release_profile, debug_profile - if (allocated(settings%profile)) then - release_profile = settings%profile == "release" + release_profile = .false. + debug_profile = .false. + if (allocated(settings%profile)) release_profile = settings%profile == "release" + if (allocated(settings%profile)) debug_profile = settings%profile == "debug" + + ! Debug./Release profile requested but not defined: + ! fallback to backward-compatible behavior + if ( (release_profile .and. package%find_profile("release")==0) & + .or. (debug_profile .and. package%find_profile("debug")==0) ) then + + model%fortran_compile_flags = assemble_flags(settings%flag,package%flags,& + model%compiler%get_default_flags(release_profile)) + + else - release_profile = .false. + + model%fortran_compile_flags = assemble_flags(settings%flag, package%flags) + end if - if (.not.allocated(settings%flag)) then - flags = model%compiler%get_default_flags(release_profile) - elseif (settings%flag == '') then - flags = model%compiler%get_default_flags(release_profile) - else - flags = settings%flag - if (allocated(settings%profile)) then - select case(settings%profile) - case("release", "debug") - flags = flags // model%compiler%get_default_flags(release_profile) - end select - endif - end if - - cflags = trim(settings%cflag) - cxxflags = trim(settings%cxxflag) - ldflags = trim(settings%ldflag) - - model%fortran_compile_flags = flags - model%c_compile_flags = cflags - model%cxx_compile_flags = cxxflags - model%link_flags = ldflags + model%c_compile_flags = assemble_flags(settings%cflag, package%c_flags) + model%cxx_compile_flags = assemble_flags(settings%cxxflag, package%cxx_flags) + model%link_flags = assemble_flags(settings%ldflag, package%link_time_flags) end subroutine new_compiler_flags diff --git a/src/fpm/manifest/package.f90 b/src/fpm/manifest/package.f90 index cf8e80a121..6bd8f75dc0 100644 --- a/src/fpm/manifest/package.f90 +++ b/src/fpm/manifest/package.f90 @@ -101,6 +101,9 @@ module fpm_manifest_package !> Find feature by name, returns index or 0 if not found procedure :: find_feature + + !> Find profile by name, returns index or 0 if not found + procedure :: find_profile end type package_config_t From f5563212982355569fda6c1ec47f628b0b5f7d3b Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 21 Sep 2025 11:30:08 +0200 Subject: [PATCH 40/59] new test: compiler flags --- src/fpm.f90 | 5 +- test/fpm_test/test_features.f90 | 135 +++++++++++++++++++++++++++++++- 2 files changed, 135 insertions(+), 5 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 0f2bc0c3c7..6ad89e7d81 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -33,7 +33,7 @@ module fpm implicit none private public :: cmd_build, cmd_run, cmd_clean -public :: build_model, check_modules_for_duplicates +public :: build_model, check_modules_for_duplicates, new_compiler_flags contains @@ -80,9 +80,6 @@ subroutine build_model(model, settings, package_config, error) model%build_prefix = join_path(settings%build_dir, basename(model%compiler%fc)) model%include_tests = settings%build_tests - if (allocated(settings%features)) print *, 'features: ',(settings%features(i)%s//' ',i=1,size(settings%features)) - if (allocated(settings%profile)) print *, 'profile: ',settings%profile - ! Extract the current package configuration request package = package_config%export_config(target_platform,settings%features,settings%profile,error) if (allocated(error)) return diff --git a/test/fpm_test/test_features.f90 b/test/fpm_test/test_features.f90 index ef5e98b342..07509dbe00 100644 --- a/test/fpm_test/test_features.f90 +++ b/test/fpm_test/test_features.f90 @@ -49,7 +49,8 @@ subroutine collect_features(testsuite) & test_feature_complex_chain_compiler_os_compiler, should_fail=.true.), & & new_unittest("feature-complex-chain-os-compiler-os", & & test_feature_complex_chain_os_compiler_os, should_fail=.true.), & - & new_unittest("feature-mixed-valid-chains", test_feature_mixed_valid_chains) & + & new_unittest("feature-mixed-valid-chains", test_feature_mixed_valid_chains), & + & new_unittest("feature-compiler-flags-integration", test_feature_compiler_flags_integration) & & ] end subroutine collect_features @@ -1470,4 +1471,136 @@ subroutine test_feature_mixed_valid_chains(error) end subroutine test_feature_mixed_valid_chains + !> Test integration of feature compiler flags with new_compiler_flags + subroutine test_feature_compiler_flags_integration(error) + use fpm, only: new_compiler_flags + use fpm_model, only: fpm_model_t + use fpm_command_line, only: fpm_build_settings + use fpm_compiler, only: new_compiler, id_gcc + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_config_t) :: package_config,package + type(fpm_model_t) :: model + type(fpm_build_settings) :: settings + type(platform_config_t) :: target_platform + character(:), allocatable :: temp_file + integer :: unit + + allocate(temp_file, source=get_temp_filename()) + + ! Create a test package with feature-based compiler flags + open(newunit=unit, file=temp_file, status='unknown') + write(unit, '(a)') 'name = "test_flags"' + write(unit, '(a)') 'version = "0.1.0"' + write(unit, '(a)') '' + write(unit, '(a)') '[library]' + write(unit, '(a)') 'source-dir = "src"' + write(unit, '(a)') '' + write(unit, '(a)') '[features]' + write(unit, '(a)') 'debug.gfortran.flags = "-g -Wall -fcheck=bounds"' + write(unit, '(a)') 'debug.flags = "-g"' + write(unit, '(a)') 'release.gfortran.flags = "-O3 -march=native"' + write(unit, '(a)') 'release.flags = "-O2"' + write(unit, '(a)') '' + write(unit, '(a)') '[profiles]' + write(unit, '(a)') 'development = ["debug"]' + write(unit, '(a)') 'production = ["release"]' + close(unit) + + ! Set up build settings without CLI flags + settings%flag = "" + settings%cflag = "" + settings%cxxflag = "" + settings%ldflag = "" + + ! Load the package configuration + call get_package_data(package_config, temp_file, error, apply_defaults=.true.) + if (allocated(error)) return + + ! 1) Choose first desired target platform: gfortran on Linux with development profile + target_platform = platform_config_t(id_gcc, OS_LINUX) + settings%profile = "development" ! This should activate debug features + + ! Extract the current package configuration request + package = package_config%export_config(target_platform, profile=settings%profile, error=error) + if (allocated(error)) return + + ! Set up model with mock compiler + call new_compiler(model%compiler, "gfortran", "gcc", "g++", echo=.false., verbose=.false.) + + ! Test that package flags are used when no CLI flags provided + call new_compiler_flags(model, settings, package) + + ! 2) Ensure flags are picked from gfortran platform (should include both base debug and gfortran-specific) + if (.not. allocated(model%fortran_compile_flags)) then + call test_failed(error, "Expected fortran_compile_flags to be allocated for gfortran") + return + end if + + if (index(model%fortran_compile_flags, "-g") == 0) then + call test_failed(error, "Expected debug flags to contain '-g' for gfortran platform") + return + end if + + if (index(model%fortran_compile_flags, "-Wall") == 0) then + call test_failed(error, "Expected gfortran-specific flags to contain '-Wall'") + return + end if + + if (index(model%fortran_compile_flags, "-fcheck=bounds") == 0) then + call test_failed(error, "Expected gfortran-specific flags to contain '-fcheck=bounds'") + return + end if + + ! 3) Choose another target platform: gfortran on Linux with production profile + settings%profile = "production" ! This should activate release features + + ! Extract the new package configuration request + package = package_config%export_config(target_platform, profile=settings%profile, error=error) + if (allocated(error)) return + + ! Reset flags and test production profile + call new_compiler_flags(model, settings, package) + + ! 4) Ensure flags are picked from the release platform (should include release flags) + if (.not. allocated(model%fortran_compile_flags)) then + call test_failed(error, "Expected fortran_compile_flags to be allocated for release") + return + end if + + if (index(model%fortran_compile_flags, "-O3") == 0) then + call test_failed(error, "Expected release gfortran flags to contain '-O3'") + return + end if + + if (index(model%fortran_compile_flags, "-march=native") == 0) then + call test_failed(error, "Expected release gfortran flags to contain '-march=native'") + return + end if + + if (index(model%fortran_compile_flags, "-O2") == 0) then + call test_failed(error, "Expected base release flags to contain '-O2'") + return + end if + + ! Test CLI flags still override package flags + settings%flag = "-O1 -DCUSTOM" + call new_compiler_flags(model, settings, package) + + if (index(model%fortran_compile_flags, "-O1") == 0) then + call test_failed(error, "Expected CLI flags to be used when provided") + return + end if + + if (index(model%fortran_compile_flags, "-DCUSTOM") == 0) then + call test_failed(error, "Expected CLI flags to contain custom flags") + return + end if + + ! Clean up - file was already closed after writing + + end subroutine test_feature_compiler_flags_integration + end module test_features From acb7f344758392355831dbb2e6c41110e75cde60 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 21 Sep 2025 15:43:24 +0200 Subject: [PATCH 41/59] example package: features_per_compiler --- ci/test_features.sh | 132 +++++++++++ .../features_per_compiler/.gitignore | 1 + .../features_per_compiler/app/main.f90 | 213 ++++++++++++++++++ .../features_per_compiler/fpm.toml | 55 +++++ 4 files changed, 401 insertions(+) create mode 100644 example_packages/features_per_compiler/.gitignore create mode 100644 example_packages/features_per_compiler/app/main.f90 create mode 100644 example_packages/features_per_compiler/fpm.toml diff --git a/ci/test_features.sh b/ci/test_features.sh index d0436d1cfd..fb6c3d15e3 100755 --- a/ci/test_features.sh +++ b/ci/test_features.sh @@ -161,4 +161,136 @@ echo "✓ Debug dependency profile works" rm -rf build output.txt popd +echo "=== Testing features_per_compiler package ===" + +# Test features per compiler package +pushd "features_per_compiler" + +# Test 15: Development profile (debug + verbose) +echo "Test 15: Features per compiler - development profile" +rm -rf build +if "$fpm" run --profile development | tee output.txt; then + echo "✓ Exit code 0 (success) as expected" +else + echo "ERROR: Expected exit code 0 but got non-zero exit code" + exit 1 +fi +grep -q "Features Per Compiler Demo" output.txt || { echo "ERROR: Features Per Compiler Demo not found"; exit 1; } +grep -q "✓ DEBUG: -g flag found" output.txt || { echo "ERROR: Debug feature not detected"; exit 1; } +grep -q "✓ VERBOSE: -v flag found" output.txt || { echo "ERROR: Verbose feature not detected"; exit 1; } +grep -q "✓ All compiler flag checks PASSED" output.txt || { echo "ERROR: Expected all checks to pass"; exit 1; } +# Check compiler-specific flags (will depend on detected compiler) +if grep -q "Detected compiler: gfortran" output.txt; then + grep -q "✓ Debug: -Wall found" output.txt || { echo "ERROR: gfortran debug flag -Wall not found"; exit 1; } + grep -q "✓ Debug: -fcheck=bounds found" output.txt || { echo "ERROR: gfortran debug flag -fcheck=bounds not found"; exit 1; } +fi +echo "✓ Development profile works" + +# Test 16: Production profile (release + fast) +echo "Test 16: Features per compiler - production profile" +rm -rf build +if "$fpm" run --profile production | tee output.txt; then + echo "✓ Exit code 0 (success) as expected" +else + echo "ERROR: Expected exit code 0 but got non-zero exit code" + exit 1 +fi +grep -q "Features Per Compiler Demo" output.txt || { echo "ERROR: Features Per Compiler Demo not found"; exit 1; } +grep -q "✓ RELEASE: -O flags found" output.txt || { echo "ERROR: Release feature not detected"; exit 1; } +grep -q "✓ FAST: fast optimization flags found" output.txt || { echo "ERROR: Fast feature not detected"; exit 1; } +grep -q "✓ All compiler flag checks PASSED" output.txt || { echo "ERROR: Expected all checks to pass"; exit 1; } +# Check compiler-specific flags (will depend on detected compiler) +if grep -q "Detected compiler: gfortran" output.txt; then + # Check for either -march=native or -mcpu (Apple Silicon uses -mcpu) + if ! (grep -q "✓ Release: -march=native found" output.txt || grep -q "✓ Release: -mcpu found" output.txt); then + echo "ERROR: gfortran release architecture flag (-march=native or -mcpu) not found" + exit 1 + fi + grep -q "✓ Fast: -Ofast found" output.txt || { echo "ERROR: gfortran fast flag -Ofast not found"; exit 1; } +fi +echo "✓ Production profile works" + +# Test 17: Testing profile (debug + strict) +echo "Test 17: Features per compiler - testing profile" +rm -rf build +if "$fpm" run --profile testing | tee output.txt; then + echo "✓ Exit code 0 (success) as expected" +else + echo "ERROR: Expected exit code 0 but got non-zero exit code" + exit 1 +fi +grep -q "Features Per Compiler Demo" output.txt || { echo "ERROR: Features Per Compiler Demo not found"; exit 1; } +grep -q "✓ DEBUG: -g flag found" output.txt || { echo "ERROR: Debug feature not detected"; exit 1; } +grep -q "✓ STRICT: standard compliance flags found" output.txt || { echo "ERROR: Strict feature not detected"; exit 1; } +grep -q "✓ All compiler flag checks PASSED" output.txt || { echo "ERROR: Expected all checks to pass"; exit 1; } +# Check compiler-specific flags (will depend on detected compiler) +if grep -q "Detected compiler: gfortran" output.txt; then + grep -q "✓ Strict: -Wpedantic found" output.txt || { echo "ERROR: gfortran strict flag -Wpedantic not found"; exit 1; } +fi +echo "✓ Testing profile works" + +# Test 18: Individual features - debug only +echo "Test 18: Features per compiler - debug feature only" +rm -rf build +if "$fpm" run --features debug | tee output.txt; then + echo "✓ Exit code 0 (success) as expected" +else + echo "ERROR: Expected exit code 0 but got non-zero exit code" + exit 1 +fi +grep -q "Features Per Compiler Demo" output.txt || { echo "ERROR: Features Per Compiler Demo not found"; exit 1; } +grep -q "✓ DEBUG: -g flag found" output.txt || { echo "ERROR: Debug feature not detected"; exit 1; } +grep -q "✓ All compiler flag checks PASSED" output.txt || { echo "ERROR: Expected all checks to pass"; exit 1; } +# Should NOT have release or fast flags +if grep -q "✓ RELEASE: -O flags found" output.txt; then + echo "ERROR: Release flags should not be present with debug only" + exit 1 +fi +echo "✓ Debug feature works" + +# Test 19: Individual features - release only +echo "Test 19: Features per compiler - release feature only" +rm -rf build +if "$fpm" run --features release | tee output.txt; then + echo "✓ Exit code 0 (success) as expected" +else + echo "ERROR: Expected exit code 0 but got non-zero exit code" + exit 1 +fi +grep -q "Features Per Compiler Demo" output.txt || { echo "ERROR: Features Per Compiler Demo not found"; exit 1; } +grep -q "✓ RELEASE: -O flags found" output.txt || { echo "ERROR: Release feature not detected"; exit 1; } +grep -q "✓ All compiler flag checks PASSED" output.txt || { echo "ERROR: Expected all checks to pass"; exit 1; } +# Should NOT have debug flags +if grep -q "✓ DEBUG: -g flag found" output.txt; then + echo "ERROR: Debug flags should not be present with release only" + exit 1 +fi +echo "✓ Release feature works" + +# Test 20: No profile/features - baseline +echo "Test 20: Features per compiler - baseline (no profile)" +rm -rf build +if "$fpm" run | tee output.txt; then + echo "✓ Exit code 0 (success) as expected" +else + echo "ERROR: Expected exit code 0 but got non-zero exit code" + exit 1 +fi +grep -q "Features Per Compiler Demo" output.txt || { echo "ERROR: Features Per Compiler Demo not found"; exit 1; } +grep -q "✓ All compiler flag checks PASSED" output.txt || { echo "ERROR: Expected all checks to pass"; exit 1; } +# Should NOT have any feature flags in baseline +if grep -q "✓ DEBUG: -g flag found" output.txt; then + echo "ERROR: Debug flags should not be present in baseline" + exit 1 +fi +if grep -q "✓ RELEASE: -O flags found" output.txt; then + echo "ERROR: Release flags should not be present in baseline" + exit 1 +fi +echo "✓ Baseline (no profile) works" + +# Cleanup +rm -rf build output.txt +popd + echo "All FPM features tests passed!" diff --git a/example_packages/features_per_compiler/.gitignore b/example_packages/features_per_compiler/.gitignore new file mode 100644 index 0000000000..8617481f53 --- /dev/null +++ b/example_packages/features_per_compiler/.gitignore @@ -0,0 +1 @@ +output.txt diff --git a/example_packages/features_per_compiler/app/main.f90 b/example_packages/features_per_compiler/app/main.f90 new file mode 100644 index 0000000000..5871a1ff27 --- /dev/null +++ b/example_packages/features_per_compiler/app/main.f90 @@ -0,0 +1,213 @@ +program main + use iso_fortran_env, only: compiler_options + implicit none + + character(len=:), allocatable :: options_str + character(len=20) :: detected_compiler + logical :: debug_active, release_active, verbose_active, fast_active, strict_active + logical :: all_checks_passed + integer :: failed_checks + + ! Get compiler flags used to build this file + options_str = compiler_options() + + ! Display compiler information + print '(a)', '=================================' + print '(a)', 'Features Per Compiler Demo' + print '(a)', '=================================' + print '(a)', '' + + ! Detect compiler type using the function + detected_compiler = compiled_with() + + print '(2a)', 'Detected compiler: ', detected_compiler + print '(a)', '' + print '(2a)', 'Compiler options: ', trim(options_str) + print '(a)', '' + + ! Check for feature flags + debug_active = index(options_str, '-g') > 0 + release_active = index(options_str, '-O') > 0 + verbose_active = index(options_str, ' -v') > 0 .or. index(options_str, ' -v ') > 0 + fast_active = index(options_str, '-Ofast') > 0 .or. index(options_str, '-fast') > 0 + strict_active = index(options_str, '-std=f2018') > 0 .or. index(options_str, '-stand f18') > 0 + + ! Display active features + print '(a)', 'Active features detected:' + if (debug_active) print '(a)', ' ✓ DEBUG: -g flag found' + if (release_active) print '(a)', ' ✓ RELEASE: -O flags found' + if (verbose_active) print '(a)', ' ✓ VERBOSE: -v flag found' + if (fast_active) print '(a)', ' ✓ FAST: fast optimization flags found' + if (strict_active) print '(a)', ' ✓ STRICT: standard compliance flags found' + + print '(a)', '' + + ! Check compiler-specific flags and validate + failed_checks = check_compiler_flags(detected_compiler, options_str, debug_active, release_active, fast_active, strict_active) + + print '(a)', '' + + ! Determine overall result + all_checks_passed = (failed_checks == 0) + + if (all_checks_passed) then + print '(a)', '✓ All compiler flag checks PASSED' + print '(a)', '' + else + print '(a,i0,a)', '✗ ', failed_checks, ' compiler flag checks FAILED' + print '(a)', '' + end if + + ! Exit with appropriate code + stop merge(0,1,all_checks_passed) + +contains + + function check_compiler_flags(compiler, options, debug_on, release_on, fast_on, strict_on) result(failed_count) + character(len=*), intent(in) :: compiler, options + logical, intent(in) :: debug_on, release_on, fast_on, strict_on + integer :: failed_count + + failed_count = 0 + select case (compiler) + case ('gfortran') + failed_count = check_gfortran_flags(options, debug_on, release_on, fast_on, strict_on) + case ('ifort') + failed_count = check_ifort_flags(options, debug_on, release_on, fast_on, strict_on) + case ('ifx') + failed_count = check_ifx_flags(options, debug_on, release_on, fast_on, strict_on) + case default + print '(a)', 'Compiler-specific checks: Unknown compiler - only base flags checked' + end select + end function + + function check_flag(options, flag_name, feature_name, description) result(found) + character(len=*), intent(in) :: options, flag_name, feature_name, description + logical :: found + + found = index(options, flag_name) > 0 + if (found) then + print '(a,a,a,a,a)', ' ✓ ', feature_name, ': ', description, ' found' + else + print '(a,a,a,a,a)', ' ✗ ', feature_name, ': ', description, ' NOT found' + end if + end function + + function compiled_with() result(msg) + use iso_fortran_env, only: compiler_version + character(len=:), allocatable :: msg + character(len=:), allocatable :: version_str + + version_str = compiler_version() + + if (index(version_str, 'GCC') > 0) then + msg = 'gfortran' + else if (index(version_str, 'Classic') > 0) then + msg = 'ifort' + else if (index(version_str, 'Intel') > 0) then + msg = 'ifx' + else + msg = 'any' + end if + end function + + function check_gfortran_flags(options, debug_on, release_on, fast_on, strict_on) result(failed_count) + character(len=*), intent(in) :: options + logical, intent(in) :: debug_on, release_on, fast_on, strict_on + integer :: failed_count + + failed_count = 0 + print '(a)', 'Compiler-specific flag checks (gfortran):' + + if (debug_on) then + if (.not. check_flag(options, '-Wall', 'Debug', '-Wall')) failed_count = failed_count + 1 + if (.not. check_flag(options, '-Wextra', 'Debug', '-Wextra')) failed_count = failed_count + 1 + if (.not. check_flag(options, '-fcheck=bounds', 'Debug', '-fcheck=bounds')) failed_count = failed_count + 1 + if (.not. check_flag(options, '-fbacktrace', 'Debug', '-fbacktrace')) failed_count = failed_count + 1 + end if + + if (release_on) then + ! Check for either -march=native or -mcpu (Apple Silicon uses -mcpu) + if (.not. (index(options, '-march=native') > 0 .or. index(options, '-mcpu') > 0)) then + print '(a)', ' ✗ Release: neither -march=native nor -mcpu found' + failed_count = failed_count + 1 + else + if (index(options, '-march=native') > 0) then + print '(a)', ' ✓ Release: -march=native found' + else + print '(a)', ' ✓ Release: -mcpu found' + end if + end if + if (.not. check_flag(options, '-funroll-loops', 'Release', '-funroll-loops')) failed_count = failed_count + 1 + end if + + if (fast_on) then + if (.not. check_flag(options, '-Ofast', 'Fast', '-Ofast')) failed_count = failed_count + 1 + if (.not. check_flag(options, '-ffast-math', 'Fast', '-ffast-math')) failed_count = failed_count + 1 + end if + + if (strict_on) then + if (.not. check_flag(options, '-Wpedantic', 'Strict', '-Wpedantic')) failed_count = failed_count + 1 + if (.not. check_flag(options, '-Werror', 'Strict', '-Werror')) failed_count = failed_count + 1 + end if + end function + + function check_ifort_flags(options, debug_on, release_on, fast_on, strict_on) result(failed_count) + character(len=*), intent(in) :: options + logical, intent(in) :: debug_on, release_on, fast_on, strict_on + integer :: failed_count + + failed_count = 0 + print '(a)', 'Compiler-specific flag checks (ifort):' + + if (debug_on) then + if (.not. check_flag(options, '-warn all', 'Debug', '-warn all')) failed_count = failed_count + 1 + if (.not. check_flag(options, '-check bounds', 'Debug', '-check bounds')) failed_count = failed_count + 1 + if (.not. check_flag(options, '-traceback', 'Debug', '-traceback')) failed_count = failed_count + 1 + end if + + if (release_on) then + if (.not. check_flag(options, '-xHost', 'Release', '-xHost')) failed_count = failed_count + 1 + if (.not. check_flag(options, '-unroll', 'Release', '-unroll')) failed_count = failed_count + 1 + end if + + if (fast_on) then + if (.not. check_flag(options, '-fast', 'Fast', '-fast')) failed_count = failed_count + 1 + end if + + if (strict_on) then + if (.not. check_flag(options, '-stand f18', 'Strict', '-stand f18')) failed_count = failed_count + 1 + if (.not. check_flag(options, '-warn errors', 'Strict', '-warn errors')) failed_count = failed_count + 1 + end if + end function + + function check_ifx_flags(options, debug_on, release_on, fast_on, strict_on) result(failed_count) + character(len=*), intent(in) :: options + logical, intent(in) :: debug_on, release_on, fast_on, strict_on + integer :: failed_count + + failed_count = 0 + print '(a)', 'Compiler-specific flag checks (ifx):' + + if (debug_on) then + if (.not. check_flag(options, '-warn all', 'Debug', '-warn all')) failed_count = failed_count + 1 + if (.not. check_flag(options, '-check bounds', 'Debug', '-check bounds')) failed_count = failed_count + 1 + if (.not. check_flag(options, '-traceback', 'Debug', '-traceback')) failed_count = failed_count + 1 + end if + + if (release_on) then + if (.not. check_flag(options, '-xHost', 'Release', '-xHost')) failed_count = failed_count + 1 + if (.not. check_flag(options, '-unroll', 'Release', '-unroll')) failed_count = failed_count + 1 + end if + + if (fast_on) then + if (.not. check_flag(options, '-fast', 'Fast', '-fast')) failed_count = failed_count + 1 + end if + + if (strict_on) then + if (.not. check_flag(options, '-stand f18', 'Strict', '-stand f18')) failed_count = failed_count + 1 + if (.not. check_flag(options, '-warn errors', 'Strict', '-warn errors')) failed_count = failed_count + 1 + end if + end function + +end program main diff --git a/example_packages/features_per_compiler/fpm.toml b/example_packages/features_per_compiler/fpm.toml new file mode 100644 index 0000000000..26221eade6 --- /dev/null +++ b/example_packages/features_per_compiler/fpm.toml @@ -0,0 +1,55 @@ +name = "features_per_compiler" +version = "0.1.0" +license = "MIT" +author = "Federico Perini" +maintainer = "federico.perini@gmail.com" +copyright = "Copyright 2025, Federico Perini" +description = "Demo package showcasing features with per-compiler flags and introspection" + +[build] +auto-executables=false + +[[executable]] +name = "features_per_compiler" +source-dir = "app" +main = "main.f90" + +[profiles] +# Development profile with debugging flags +development = ["debug", "verbose"] + +# Production profile with optimization flags +production = ["release", "fast"] + +# Testing profile with strict checking +testing = ["debug", "strict"] + +[features] +# Debug feature with base flags for all compilers, then per-compiler extensions +debug.flags = "-g" # Base debug flag for ALL compilers (applied first) +debug.gfortran.flags = "-Wall -Wextra -fcheck=bounds,do,mem,pointer -fbacktrace" +debug.ifort.flags = "-warn all -check bounds -traceback" # Unix/Linux/macOS Intel +debug.ifx.flags = "-warn all -check bounds -traceback" # Intel oneAPI +debug.preprocess.cpp.macros = "DEBUG" + +# Release feature with base optimization, then per-compiler extensions +release.flags = "-O3" # Base optimization for ALL compilers (applied first) +release.gfortran.flags = "-march=native -funroll-loops" +release.ifort.flags = "-xHost -unroll" # Unix/Linux/macOS Intel +release.ifx.flags = "-xHost -unroll" # Intel oneAPI + +# Verbose feature for enhanced diagnostics (applies to all compilers) +verbose.flags = "-v" + +# Fast feature with base optimization, then per-compiler extensions +fast.flags = "-O3" # Base fast optimization for ALL compilers (applied first) +fast.gfortran.flags = "-Ofast -ffast-math" +fast.ifort.flags = "-fast" +fast.ifx.flags = "-fast" + +# Strict feature with base standard compliance, then per-compiler extensions +strict.flags = "-std=f2018" # Base standard compliance for ALL compilers (applied first) +strict.gfortran.flags = "-Wpedantic -Werror" +strict.ifort.flags = "-stand f18 -warn errors" +strict.ifx.flags = "-stand f18 -warn errors" + From b1942b5fd31037217e3e6657aeca1a2a39376e03 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 21 Sep 2025 16:08:35 +0200 Subject: [PATCH 42/59] do not check `=native`: it is unrolled by gfortran --- .../features_per_compiler/app/main.f90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/example_packages/features_per_compiler/app/main.f90 b/example_packages/features_per_compiler/app/main.f90 index 5871a1ff27..debb554601 100644 --- a/example_packages/features_per_compiler/app/main.f90 +++ b/example_packages/features_per_compiler/app/main.f90 @@ -27,9 +27,9 @@ program main ! Check for feature flags debug_active = index(options_str, '-g') > 0 - release_active = index(options_str, '-O') > 0 + release_active = index(options_str, '-O3') > 0 verbose_active = index(options_str, ' -v') > 0 .or. index(options_str, ' -v ') > 0 - fast_active = index(options_str, '-Ofast') > 0 .or. index(options_str, '-fast') > 0 + fast_active = index(options_str, 'fast') > 0 strict_active = index(options_str, '-std=f2018') > 0 .or. index(options_str, '-stand f18') > 0 ! Display active features @@ -127,13 +127,13 @@ function check_gfortran_flags(options, debug_on, release_on, fast_on, strict_on) end if if (release_on) then - ! Check for either -march=native or -mcpu (Apple Silicon uses -mcpu) - if (.not. (index(options, '-march=native') > 0 .or. index(options, '-mcpu') > 0)) then + ! Check for either -march or -mcpu (Apple Silicon uses -mcpu; -match=native may be re-resolved by gcc) + if (.not. (index(options, '-march') > 0 .or. index(options, '-mcpu') > 0)) then print '(a)', ' ✗ Release: neither -march=native nor -mcpu found' failed_count = failed_count + 1 else if (index(options, '-march=native') > 0) then - print '(a)', ' ✓ Release: -march=native found' + print '(a)', ' ✓ Release: -march found' else print '(a)', ' ✓ Release: -mcpu found' end if @@ -142,7 +142,7 @@ function check_gfortran_flags(options, debug_on, release_on, fast_on, strict_on) end if if (fast_on) then - if (.not. check_flag(options, '-Ofast', 'Fast', '-Ofast')) failed_count = failed_count + 1 + if (.not. check_flag(options, '-ffast', 'Fast', '-fast')) failed_count = failed_count + 1 if (.not. check_flag(options, '-ffast-math', 'Fast', '-ffast-math')) failed_count = failed_count + 1 end if @@ -172,7 +172,7 @@ function check_ifort_flags(options, debug_on, release_on, fast_on, strict_on) re end if if (fast_on) then - if (.not. check_flag(options, '-fast', 'Fast', '-fast')) failed_count = failed_count + 1 + if (.not. check_flag(options, '-fast', 'Fast', '-ffast')) failed_count = failed_count + 1 end if if (strict_on) then @@ -201,7 +201,7 @@ function check_ifx_flags(options, debug_on, release_on, fast_on, strict_on) resu end if if (fast_on) then - if (.not. check_flag(options, '-fast', 'Fast', '-fast')) failed_count = failed_count + 1 + if (.not. check_flag(options, '-fast', 'Fast', '-ffast')) failed_count = failed_count + 1 end if if (strict_on) then From f8473114700f15a2594d62ac5d61f71c8e899b0c Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sat, 27 Sep 2025 17:33:04 +0200 Subject: [PATCH 43/59] catch error messages correctly --- ci/test_features.sh | 40 ++++++++++++++++++++-------------------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/ci/test_features.sh b/ci/test_features.sh index fb6c3d15e3..45ef05e6a0 100755 --- a/ci/test_features.sh +++ b/ci/test_features.sh @@ -1,5 +1,5 @@ #!/usr/bin/env bash -set -ex +set -exo pipefail # Test script for FPM features functionality # Usage: ./test_features.sh [fpm_executable] @@ -20,21 +20,21 @@ echo "=== Testing features_demo package ===" pushd "features_demo" echo "Test 1: Basic debug feature" rm -rf build -"$fpm" run --features debug | tee output.txt +"$fpm" run --features debug > output.txt grep -q "DEBUG mode enabled" output.txt || { echo "ERROR: DEBUG mode not enabled"; exit 1; } echo "✓ Debug feature works" # Test 2: Profile usage - development profile (includes debug) -echo "Test 2: Development profile (debug feature)" +echo "Test 2: Development profile (debug feature)" rm -rf build -"$fpm" run --profile development --target features_demo | tee output.txt +"$fpm" run --profile development --target features_demo > output.txt grep -q "DEBUG mode enabled" output.txt || { echo "ERROR: DEBUG mode not enabled in development profile"; exit 1; } echo "✓ Development profile works" # Test 3: Multiple features echo "Test 3: Multiple features (debug + openmp)" -rm -rf build -"$fpm" run --features debug,openmp --target features_demo | tee output.txt +rm -rf build +"$fpm" run --features debug,openmp --target features_demo > output.txt grep -q "DEBUG mode enabled" output.txt || { echo "ERROR: DEBUG mode not enabled with multiple features"; exit 1; } grep -q "OpenMP support enabled" output.txt || { echo "ERROR: OpenMP not enabled with multiple features"; exit 1; } echo "✓ Multiple features work" @@ -42,7 +42,7 @@ echo "✓ Multiple features work" # Test 4: Feature-specific executable (debug_demo only available with debug feature) echo "Test 4: Feature-specific executable" rm -rf build -"$fpm" run --features debug --target debug_demo | tee output.txt +"$fpm" run --features debug --target debug_demo > output.txt grep -q "Debug Demo Program" output.txt || { echo "ERROR: Debug Demo Program not found"; exit 1; } grep -q "Debug mode: ON" output.txt || { echo "ERROR: Debug mode not ON in debug_demo"; exit 1; } echo "✓ Feature-specific executable works" @@ -50,7 +50,7 @@ echo "✓ Feature-specific executable works" # Test 5: Profile with multiple features - production profile (release + openmp) echo "Test 5: Production profile (release + openmp)" rm -rf build -"$fpm" run --profile production --target features_demo | tee output.txt +"$fpm" run --profile production --target features_demo > output.txt grep -q "RELEASE mode enabled" output.txt || { echo "ERROR: RELEASE mode not enabled in production profile"; exit 1; } grep -q "OpenMP support enabled" output.txt || { echo "ERROR: OpenMP not enabled in production profile"; exit 1; } # Should NOT have debug @@ -62,8 +62,8 @@ echo "✓ Production profile works" # Test 6: No features - baseline behavior echo "Test 6: No features (baseline)" -rm -rf build -"$fpm" run --target features_demo | tee output.txt +rm -rf build +"$fpm" run --target features_demo > output.txt # Should have neither DEBUG nor RELEASE without explicit features if grep -q "DEBUG mode enabled" output.txt; then echo "ERROR: DEBUG mode should not be enabled in baseline" @@ -127,7 +127,7 @@ rm -rf build # Test 11: Debug dependency feature echo "Test 11: Debug dependency feature" rm -rf build -"$fpm" run --features with_feat_debug | tee output.txt +"$fpm" run --features with_feat_debug > output.txt grep -q "WITH_DEBUG_DEPENDENCY" output.txt || { echo "ERROR: WITH_DEBUG_DEPENDENCY not found"; exit 1; } grep -q "DEBUG mode enabled" output.txt || { echo "ERROR: DEBUG mode not enabled in dependency test"; exit 1; } echo "✓ Debug dependency feature works" @@ -135,7 +135,7 @@ echo "✓ Debug dependency feature works" # Test 12: Release dependency feature echo "Test 12: Release dependency feature" rm -rf build -"$fpm" run --features with_feat_release | tee output.txt +"$fpm" run --features with_feat_release > output.txt grep -q "WITH_RELEASE_DEPENDENCY" output.txt || { echo "ERROR: WITH_RELEASE_DEPENDENCY not found"; exit 1; } grep -q "RELEASE mode enabled" output.txt || { echo "ERROR: RELEASE mode not enabled in dependency test"; exit 1; } echo "✓ Release dependency feature works" @@ -143,7 +143,7 @@ echo "✓ Release dependency feature works" # Test 13: Multi dependency feature echo "Test 13: Multi dependency feature" rm -rf build -"$fpm" run --features with_feat_multi | tee output.txt +"$fpm" run --features with_feat_multi > output.txt grep -q "WITH_MULTI_DEPENDENCY" output.txt || { echo "ERROR: WITH_MULTI_DEPENDENCY not found"; exit 1; } grep -q "DEBUG mode enabled" output.txt || { echo "ERROR: DEBUG mode not enabled in multi dependency test"; exit 1; } grep -q "MPI support enabled" output.txt || { echo "ERROR: MPI support not enabled in multi dependency test"; exit 1; } @@ -152,7 +152,7 @@ echo "✓ Multi dependency feature works" # Test 14: Profile with dependency features echo "Test 14: Debug dependency profile" rm -rf build -"$fpm" run --profile debug_dep | tee output.txt +"$fpm" run --profile debug_dep > output.txt grep -q "WITH_DEBUG_DEPENDENCY" output.txt || { echo "ERROR: WITH_DEBUG_DEPENDENCY not found in profile test"; exit 1; } grep -q "DEBUG mode enabled" output.txt || { echo "ERROR: DEBUG mode not enabled in dependency profile test"; exit 1; } echo "✓ Debug dependency profile works" @@ -169,7 +169,7 @@ pushd "features_per_compiler" # Test 15: Development profile (debug + verbose) echo "Test 15: Features per compiler - development profile" rm -rf build -if "$fpm" run --profile development | tee output.txt; then +if "$fpm" run --profile development > output.txt; then echo "✓ Exit code 0 (success) as expected" else echo "ERROR: Expected exit code 0 but got non-zero exit code" @@ -189,7 +189,7 @@ echo "✓ Development profile works" # Test 16: Production profile (release + fast) echo "Test 16: Features per compiler - production profile" rm -rf build -if "$fpm" run --profile production | tee output.txt; then +if "$fpm" run --profile production > output.txt; then echo "✓ Exit code 0 (success) as expected" else echo "ERROR: Expected exit code 0 but got non-zero exit code" @@ -213,7 +213,7 @@ echo "✓ Production profile works" # Test 17: Testing profile (debug + strict) echo "Test 17: Features per compiler - testing profile" rm -rf build -if "$fpm" run --profile testing | tee output.txt; then +if "$fpm" run --profile testing > output.txt; then echo "✓ Exit code 0 (success) as expected" else echo "ERROR: Expected exit code 0 but got non-zero exit code" @@ -232,7 +232,7 @@ echo "✓ Testing profile works" # Test 18: Individual features - debug only echo "Test 18: Features per compiler - debug feature only" rm -rf build -if "$fpm" run --features debug | tee output.txt; then +if "$fpm" run --features debug > output.txt; then echo "✓ Exit code 0 (success) as expected" else echo "ERROR: Expected exit code 0 but got non-zero exit code" @@ -251,7 +251,7 @@ echo "✓ Debug feature works" # Test 19: Individual features - release only echo "Test 19: Features per compiler - release feature only" rm -rf build -if "$fpm" run --features release | tee output.txt; then +if "$fpm" run --features release > output.txt; then echo "✓ Exit code 0 (success) as expected" else echo "ERROR: Expected exit code 0 but got non-zero exit code" @@ -270,7 +270,7 @@ echo "✓ Release feature works" # Test 20: No profile/features - baseline echo "Test 20: Features per compiler - baseline (no profile)" rm -rf build -if "$fpm" run | tee output.txt; then +if "$fpm" run > output.txt; then echo "✓ Exit code 0 (success) as expected" else echo "ERROR: Expected exit code 0 but got non-zero exit code" From cc75c633fd9725355129e2c4927a6e719a70f2ce Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sat, 27 Sep 2025 20:27:28 +0200 Subject: [PATCH 44/59] adjust feature test --- ci/test_features.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ci/test_features.sh b/ci/test_features.sh index 45ef05e6a0..d6dc0ba3b8 100755 --- a/ci/test_features.sh +++ b/ci/test_features.sh @@ -206,7 +206,7 @@ if grep -q "Detected compiler: gfortran" output.txt; then echo "ERROR: gfortran release architecture flag (-march=native or -mcpu) not found" exit 1 fi - grep -q "✓ Fast: -Ofast found" output.txt || { echo "ERROR: gfortran fast flag -Ofast not found"; exit 1; } + grep -q "✓ Fast: -ffast-math found" output.txt || { echo "ERROR: gfortran fast flag -ffast-math not found"; exit 1; } fi echo "✓ Production profile works" From 86653e618c7f0b8c82a94ff3fca6a79504715e27 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sat, 27 Sep 2025 20:35:10 +0200 Subject: [PATCH 45/59] ensure `-fPIC` with llvm_unknown --- src/fpm_compiler.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fpm_compiler.F90 b/src/fpm_compiler.F90 index e3a61cbef7..9c06fc911e 100644 --- a/src/fpm_compiler.F90 +++ b/src/fpm_compiler.F90 @@ -304,7 +304,7 @@ function get_default_flags(self, release) result(flags) select case (self%id) case (id_gcc, id_f95, id_caf, id_flang_classic, id_f18, id_lfortran, & id_intel_classic_nix, id_intel_classic_mac, id_intel_llvm_nix, & - id_pgi, id_nvhpc, id_nag, id_cray, id_ibmxl) + id_intel_llvm_unknown, id_pgi, id_nvhpc, id_nag, id_cray, id_ibmxl) pic_flag = " -fPIC" case (id_flang) ! LLVM Flang doesn't support -fPIC on Windows MSVC target From c112e6fbf2b5037ea0f391a80883df60d3063e03 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sat, 27 Sep 2025 21:11:01 +0200 Subject: [PATCH 46/59] use allocatable --- example_packages/features_per_compiler/app/main.f90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/example_packages/features_per_compiler/app/main.f90 b/example_packages/features_per_compiler/app/main.f90 index debb554601..c325ed5035 100644 --- a/example_packages/features_per_compiler/app/main.f90 +++ b/example_packages/features_per_compiler/app/main.f90 @@ -2,8 +2,7 @@ program main use iso_fortran_env, only: compiler_options implicit none - character(len=:), allocatable :: options_str - character(len=20) :: detected_compiler + character(len=:), allocatable :: options_str,detected_compiler logical :: debug_active, release_active, verbose_active, fast_active, strict_active logical :: all_checks_passed integer :: failed_checks From 670c67faaeb966d4da34e8a392fe2df530c414d3 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sat, 27 Sep 2025 22:12:27 +0200 Subject: [PATCH 47/59] more gcc-15 array initializer fixes --- src/fpm_compile_commands.F90 | 63 +++++++++++++++++++++++++++-- src/fpm_sources.f90 | 67 ++++++++++++++++++++++++++++--- src/fpm_targets.f90 | 63 +++++++++++++++++++++++++++-- src/metapackage/fpm_meta_base.f90 | 59 ++++++++++++++++++++++++++- 4 files changed, 240 insertions(+), 12 deletions(-) diff --git a/src/fpm_compile_commands.F90 b/src/fpm_compile_commands.F90 index 826250aa30..57975c45d2 100644 --- a/src/fpm_compile_commands.F90 +++ b/src/fpm_compile_commands.F90 @@ -58,6 +58,12 @@ module fpm_compile_commands interface compile_command_t module procedure cct_new end interface compile_command_t + + !> Add compile commands to array (gcc-15 bug workaround) + interface add_compile_command + module procedure add_compile_command_one + module procedure add_compile_command_many + end interface add_compile_command contains @@ -330,7 +336,7 @@ pure subroutine cct_register_object(self, command, error) type(error_t), allocatable, intent(out) :: error if (allocated(self%command)) then - self%command = [self%command, command] + call add_compile_command(self%command, command) else allocate(self%command(1), source=command) end if @@ -442,6 +448,57 @@ logical function cct_is_same(this,that) !> All checks passed! cct_is_same = .true. - end function cct_is_same - + end function cct_is_same + + !> Add one compile command to array with a loop (gcc-15 bug on array initializer) + pure subroutine add_compile_command_one(list,new) + type(compile_command_t), allocatable, intent(inout) :: list(:) + type(compile_command_t), intent(in) :: new + + integer :: i,n + type(compile_command_t), allocatable :: tmp(:) + + if (allocated(list)) then + n = size(list) + else + n = 0 + end if + + allocate(tmp(n+1)) + do i=1,n + tmp(i) = list(i) + end do + tmp(n+1) = new + call move_alloc(from=tmp,to=list) + + end subroutine add_compile_command_one + + !> Add multiple compile commands to array with a loop (gcc-15 bug on array initializer) + pure subroutine add_compile_command_many(list,new) + type(compile_command_t), allocatable, intent(inout) :: list(:) + type(compile_command_t), intent(in) :: new(:) + + integer :: i,n,add + type(compile_command_t), allocatable :: tmp(:) + + if (allocated(list)) then + n = size(list) + else + n = 0 + end if + + add = size(new) + if (add == 0) return + + allocate(tmp(n+add)) + do i=1,n + tmp(i) = list(i) + end do + do i=1,add + tmp(n+i) = new(i) + end do + call move_alloc(from=tmp,to=list) + + end subroutine add_compile_command_many + end module fpm_compile_commands diff --git a/src/fpm_sources.f90 b/src/fpm_sources.f90 index df95beceac..657f992abf 100644 --- a/src/fpm_sources.f90 +++ b/src/fpm_sources.f90 @@ -8,7 +8,7 @@ module fpm_sources use fpm_model, only: srcfile_t, FPM_UNIT_PROGRAM use fpm_filesystem, only: basename, canon_path, dirname, join_path, list_files, is_hidden_file use fpm_environment, only: get_os_type,OS_WINDOWS -use fpm_strings, only: lower, str_ends_with, string_t, operator(.in.) +use fpm_strings, only: lower, str_ends_with, string_t, operator(.in.), add_strings use fpm_source_parsing, only: parse_f_source, parse_c_source use fpm_manifest_executable, only: executable_config_t use fpm_manifest_preprocess, only: preprocess_config_t @@ -16,12 +16,18 @@ module fpm_sources private public :: add_sources_from_dir, add_executable_sources -public :: get_exe_name_with_suffix +public :: get_exe_name_with_suffix, add_srcfile character(4), parameter :: fortran_suffixes(2) = [".f90", & ".f "] character(4), parameter :: c_suffixes(4) = [".c ", ".h ", ".cpp", ".hpp"] +!> Add one or multiple source files to a source file array (gcc-15 bug workaround) +interface add_srcfile + module procedure add_srcfile_one + module procedure add_srcfile_many +end interface add_srcfile + contains !> Wrapper to source parsing routines. @@ -159,7 +165,7 @@ subroutine add_sources_from_dir(sources,directory,scope,with_executables,with_f_ if (.not.allocated(sources)) then sources = pack(dir_sources,.not.exclude_source) else - sources = [sources, pack(dir_sources,.not.exclude_source)] + call add_srcfile(sources, pack(dir_sources,.not.exclude_source)) end if end subroutine add_sources_from_dir @@ -239,7 +245,7 @@ subroutine add_executable_sources(sources,executables,scope,auto_discover,with_f if (.not.allocated(sources)) then sources = [exe_source] else - sources = [sources, exe_source] + call add_srcfile(sources, exe_source) end if end do exe_loop @@ -274,7 +280,7 @@ subroutine get_executable_source_dirs(exe_dirs,executables) if (.not.allocated(exe_dirs)) then exe_dirs = dirs_temp(1:n) else - exe_dirs = [exe_dirs,dirs_temp(1:n)] + call add_strings(exe_dirs,dirs_temp(1:n)) end if end subroutine get_executable_source_dirs @@ -296,4 +302,55 @@ function get_exe_name_with_suffix(source) result(suffixed) end function get_exe_name_with_suffix +!> Add one source file to a source file array with a loop (gcc-15 bug on array initializer) +pure subroutine add_srcfile_one(list,new) + type(srcfile_t), allocatable, intent(inout) :: list(:) + type(srcfile_t), intent(in) :: new + + integer :: i,n + type(srcfile_t), allocatable :: tmp(:) + + if (allocated(list)) then + n = size(list) + else + n = 0 + end if + + allocate(tmp(n+1)) + do i=1,n + tmp(i) = list(i) + end do + tmp(n+1) = new + call move_alloc(from=tmp,to=list) + +end subroutine add_srcfile_one + +!> Add multiple source files to a source file array with a loop (gcc-15 bug on array initializer) +pure subroutine add_srcfile_many(list,new) + type(srcfile_t), allocatable, intent(inout) :: list(:) + type(srcfile_t), intent(in) :: new(:) + + integer :: i,n,add + type(srcfile_t), allocatable :: tmp(:) + + if (allocated(list)) then + n = size(list) + else + n = 0 + end if + + add = size(new) + if (add == 0) return + + allocate(tmp(n+add)) + do i=1,n + tmp(i) = list(i) + end do + do i=1,add + tmp(n+i) = new(i) + end do + call move_alloc(from=tmp,to=list) + +end subroutine add_srcfile_many + end module fpm_sources diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index 1bbf12a999..7de5b92c88 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -47,7 +47,7 @@ module fpm_targets FPM_TARGET_SHARED, FPM_TARGET_NAME public build_target_t, build_target_ptr public targets_from_sources, resolve_module_dependencies -public add_target, new_target, add_dependency, get_library_dirs +public add_target, new_target, add_dependency, get_library_dirs, add_target_ptr public filter_library_targets, filter_executable_targets, filter_modules @@ -156,6 +156,12 @@ module fpm_targets module procedure add_old_targets end interface +!> Add one or multiple build target pointers to array (gcc-15 bug workaround) +interface add_target_ptr + module procedure add_target_ptr_one + module procedure add_target_ptr_many +end interface add_target_ptr + contains !> Target type name @@ -699,7 +705,7 @@ subroutine add_old_targets(targets, add_targets) endassociate end do - targets = [targets, add_targets ] + call add_target_ptr(targets, add_targets) end subroutine add_old_targets @@ -723,7 +729,7 @@ subroutine add_dependency(target, dependency) end do if (dependency%output_name==target%output_name) return - target%dependencies = [target%dependencies, build_target_ptr(dependency)] + call add_target_ptr(target%dependencies, build_target_ptr(dependency)) end subroutine add_dependency @@ -1545,4 +1551,55 @@ subroutine library_targets_to_deps(model, targets, target_ID) end subroutine library_targets_to_deps +!> Add one build target pointer to array with a loop (gcc-15 bug on array initializer) +subroutine add_target_ptr_one(list,new) + type(build_target_ptr), allocatable, intent(inout) :: list(:) + type(build_target_ptr), intent(in) :: new + + integer :: i,n + type(build_target_ptr), allocatable :: tmp(:) + + if (allocated(list)) then + n = size(list) + else + n = 0 + end if + + allocate(tmp(n+1)) + do i=1,n + tmp(i) = list(i) + end do + tmp(n+1) = new + call move_alloc(from=tmp,to=list) + +end subroutine add_target_ptr_one + +!> Add multiple build target pointers to array with a loop (gcc-15 bug on array initializer) +subroutine add_target_ptr_many(list,new) + type(build_target_ptr), allocatable, intent(inout) :: list(:) + type(build_target_ptr), intent(in) :: new(:) + + integer :: i,n,add + type(build_target_ptr), allocatable :: tmp(:) + + if (allocated(list)) then + n = size(list) + else + n = 0 + end if + + add = size(new) + if (add == 0) return + + allocate(tmp(n+add)) + do i=1,n + tmp(i) = list(i) + end do + do i=1,add + tmp(n+i) = new(i) + end do + call move_alloc(from=tmp,to=list) + +end subroutine add_target_ptr_many + end module fpm_targets diff --git a/src/metapackage/fpm_meta_base.f90 b/src/metapackage/fpm_meta_base.f90 index cef921d387..e069389760 100644 --- a/src/metapackage/fpm_meta_base.f90 +++ b/src/metapackage/fpm_meta_base.f90 @@ -69,6 +69,12 @@ module fpm_meta_base end type metapackage_t + !> Add dependencies to array (gcc-15 bug workaround) + interface add_dependency_config + module procedure add_dependency_config_one + module procedure add_dependency_config_many + end interface add_dependency_config + contains elemental subroutine destroy(this) @@ -161,7 +167,7 @@ subroutine resolve_package_config(self,package,error) ! as they may change if built upstream if (self%has_dependencies) then if (allocated(package%dev_dependency)) then - package%dev_dependency = [package%dev_dependency,self%dependency] + call add_dependency_config(package%dev_dependency,self%dependency) else package%dev_dependency = self%dependency end if @@ -234,4 +240,55 @@ end function dn end subroutine resolve_package_config + !> Add one dependency to array with a loop (gcc-15 bug on array initializer) + pure subroutine add_dependency_config_one(list,new) + type(dependency_config_t), allocatable, intent(inout) :: list(:) + type(dependency_config_t), intent(in) :: new + + integer :: i,n + type(dependency_config_t), allocatable :: tmp(:) + + if (allocated(list)) then + n = size(list) + else + n = 0 + end if + + allocate(tmp(n+1)) + do i=1,n + tmp(i) = list(i) + end do + tmp(n+1) = new + call move_alloc(from=tmp,to=list) + + end subroutine add_dependency_config_one + + !> Add multiple dependencies to array with a loop (gcc-15 bug on array initializer) + pure subroutine add_dependency_config_many(list,new) + type(dependency_config_t), allocatable, intent(inout) :: list(:) + type(dependency_config_t), intent(in) :: new(:) + + integer :: i,n,add + type(dependency_config_t), allocatable :: tmp(:) + + if (allocated(list)) then + n = size(list) + else + n = 0 + end if + + add = size(new) + if (add == 0) return + + allocate(tmp(n+add)) + do i=1,n + tmp(i) = list(i) + end do + do i=1,add + tmp(n+i) = new(i) + end do + call move_alloc(from=tmp,to=list) + + end subroutine add_dependency_config_many + end module fpm_meta_base From db45d553d48b9d6e5c67b242e96f13b0ca0ce1b0 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sat, 27 Sep 2025 22:31:38 +0200 Subject: [PATCH 48/59] better identify debug flags --- ci/test_features.sh | 40 ++++++++++++++----- .../features_per_compiler/app/main.f90 | 6 +-- 2 files changed, 32 insertions(+), 14 deletions(-) diff --git a/ci/test_features.sh b/ci/test_features.sh index d6dc0ba3b8..387f26c57e 100755 --- a/ci/test_features.sh +++ b/ci/test_features.sh @@ -169,14 +169,17 @@ pushd "features_per_compiler" # Test 15: Development profile (debug + verbose) echo "Test 15: Features per compiler - development profile" rm -rf build -if "$fpm" run --profile development > output.txt; then +if "$fpm" run --profile development > output.txt 2>&1; then echo "✓ Exit code 0 (success) as expected" else echo "ERROR: Expected exit code 0 but got non-zero exit code" + echo "=== Program output ===" + cat output.txt + echo "======================" exit 1 fi grep -q "Features Per Compiler Demo" output.txt || { echo "ERROR: Features Per Compiler Demo not found"; exit 1; } -grep -q "✓ DEBUG: -g flag found" output.txt || { echo "ERROR: Debug feature not detected"; exit 1; } +grep -q "✓ DEBUG: debug flags found" output.txt || { echo "ERROR: Debug feature not detected"; exit 1; } grep -q "✓ VERBOSE: -v flag found" output.txt || { echo "ERROR: Verbose feature not detected"; exit 1; } grep -q "✓ All compiler flag checks PASSED" output.txt || { echo "ERROR: Expected all checks to pass"; exit 1; } # Check compiler-specific flags (will depend on detected compiler) @@ -189,10 +192,13 @@ echo "✓ Development profile works" # Test 16: Production profile (release + fast) echo "Test 16: Features per compiler - production profile" rm -rf build -if "$fpm" run --profile production > output.txt; then +if "$fpm" run --profile production > output.txt 2>&1; then echo "✓ Exit code 0 (success) as expected" else echo "ERROR: Expected exit code 0 but got non-zero exit code" + echo "=== Program output ===" + cat output.txt + echo "======================" exit 1 fi grep -q "Features Per Compiler Demo" output.txt || { echo "ERROR: Features Per Compiler Demo not found"; exit 1; } @@ -213,14 +219,17 @@ echo "✓ Production profile works" # Test 17: Testing profile (debug + strict) echo "Test 17: Features per compiler - testing profile" rm -rf build -if "$fpm" run --profile testing > output.txt; then +if "$fpm" run --profile testing > output.txt 2>&1; then echo "✓ Exit code 0 (success) as expected" else echo "ERROR: Expected exit code 0 but got non-zero exit code" + echo "=== Program output ===" + cat output.txt + echo "======================" exit 1 fi grep -q "Features Per Compiler Demo" output.txt || { echo "ERROR: Features Per Compiler Demo not found"; exit 1; } -grep -q "✓ DEBUG: -g flag found" output.txt || { echo "ERROR: Debug feature not detected"; exit 1; } +grep -q "✓ DEBUG: debug flags found" output.txt || { echo "ERROR: Debug feature not detected"; exit 1; } grep -q "✓ STRICT: standard compliance flags found" output.txt || { echo "ERROR: Strict feature not detected"; exit 1; } grep -q "✓ All compiler flag checks PASSED" output.txt || { echo "ERROR: Expected all checks to pass"; exit 1; } # Check compiler-specific flags (will depend on detected compiler) @@ -232,14 +241,17 @@ echo "✓ Testing profile works" # Test 18: Individual features - debug only echo "Test 18: Features per compiler - debug feature only" rm -rf build -if "$fpm" run --features debug > output.txt; then +if "$fpm" run --features debug > output.txt 2>&1; then echo "✓ Exit code 0 (success) as expected" else echo "ERROR: Expected exit code 0 but got non-zero exit code" + echo "=== Program output ===" + cat output.txt + echo "======================" exit 1 fi grep -q "Features Per Compiler Demo" output.txt || { echo "ERROR: Features Per Compiler Demo not found"; exit 1; } -grep -q "✓ DEBUG: -g flag found" output.txt || { echo "ERROR: Debug feature not detected"; exit 1; } +grep -q "✓ DEBUG: debug flags found" output.txt || { echo "ERROR: Debug feature not detected"; exit 1; } grep -q "✓ All compiler flag checks PASSED" output.txt || { echo "ERROR: Expected all checks to pass"; exit 1; } # Should NOT have release or fast flags if grep -q "✓ RELEASE: -O flags found" output.txt; then @@ -251,17 +263,20 @@ echo "✓ Debug feature works" # Test 19: Individual features - release only echo "Test 19: Features per compiler - release feature only" rm -rf build -if "$fpm" run --features release > output.txt; then +if "$fpm" run --features release > output.txt 2>&1; then echo "✓ Exit code 0 (success) as expected" else echo "ERROR: Expected exit code 0 but got non-zero exit code" + echo "=== Program output ===" + cat output.txt + echo "======================" exit 1 fi grep -q "Features Per Compiler Demo" output.txt || { echo "ERROR: Features Per Compiler Demo not found"; exit 1; } grep -q "✓ RELEASE: -O flags found" output.txt || { echo "ERROR: Release feature not detected"; exit 1; } grep -q "✓ All compiler flag checks PASSED" output.txt || { echo "ERROR: Expected all checks to pass"; exit 1; } # Should NOT have debug flags -if grep -q "✓ DEBUG: -g flag found" output.txt; then +if grep -q "✓ DEBUG: debug flags found" output.txt; then echo "ERROR: Debug flags should not be present with release only" exit 1 fi @@ -270,16 +285,19 @@ echo "✓ Release feature works" # Test 20: No profile/features - baseline echo "Test 20: Features per compiler - baseline (no profile)" rm -rf build -if "$fpm" run > output.txt; then +if "$fpm" run > output.txt 2>&1; then echo "✓ Exit code 0 (success) as expected" else echo "ERROR: Expected exit code 0 but got non-zero exit code" + echo "=== Program output ===" + cat output.txt + echo "======================" exit 1 fi grep -q "Features Per Compiler Demo" output.txt || { echo "ERROR: Features Per Compiler Demo not found"; exit 1; } grep -q "✓ All compiler flag checks PASSED" output.txt || { echo "ERROR: Expected all checks to pass"; exit 1; } # Should NOT have any feature flags in baseline -if grep -q "✓ DEBUG: -g flag found" output.txt; then +if grep -q "✓ DEBUG: debug flags found" output.txt; then echo "ERROR: Debug flags should not be present in baseline" exit 1 fi diff --git a/example_packages/features_per_compiler/app/main.f90 b/example_packages/features_per_compiler/app/main.f90 index c325ed5035..9ba2e04c00 100644 --- a/example_packages/features_per_compiler/app/main.f90 +++ b/example_packages/features_per_compiler/app/main.f90 @@ -25,15 +25,15 @@ program main print '(a)', '' ! Check for feature flags - debug_active = index(options_str, '-g') > 0 + debug_active = index(options_str, ' -g ') > 0 release_active = index(options_str, '-O3') > 0 verbose_active = index(options_str, ' -v') > 0 .or. index(options_str, ' -v ') > 0 - fast_active = index(options_str, 'fast') > 0 + fast_active = index(options_str, 'fast') > 0 strict_active = index(options_str, '-std=f2018') > 0 .or. index(options_str, '-stand f18') > 0 ! Display active features print '(a)', 'Active features detected:' - if (debug_active) print '(a)', ' ✓ DEBUG: -g flag found' + if (debug_active) print '(a)', ' ✓ DEBUG: debug flags found' if (release_active) print '(a)', ' ✓ RELEASE: -O flags found' if (verbose_active) print '(a)', ' ✓ VERBOSE: -v flag found' if (fast_active) print '(a)', ' ✓ FAST: fast optimization flags found' From ad69e28ae6bf45dd01c0c1b0f8ac93a296b59452 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sat, 27 Sep 2025 23:06:55 +0200 Subject: [PATCH 49/59] gcc-10 fix: explicit character allocation --- example_packages/features_per_compiler/app/main.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/example_packages/features_per_compiler/app/main.f90 b/example_packages/features_per_compiler/app/main.f90 index 9ba2e04c00..ac6b16c55e 100644 --- a/example_packages/features_per_compiler/app/main.f90 +++ b/example_packages/features_per_compiler/app/main.f90 @@ -8,7 +8,7 @@ program main integer :: failed_checks ! Get compiler flags used to build this file - options_str = compiler_options() + allocate(options_str, source=compiler_options()) ! Display compiler information print '(a)', '=================================' @@ -17,7 +17,7 @@ program main print '(a)', '' ! Detect compiler type using the function - detected_compiler = compiled_with() + allocate(detected_compiler, source=compiled_with()) print '(2a)', 'Detected compiler: ', detected_compiler print '(a)', '' @@ -97,7 +97,7 @@ function compiled_with() result(msg) character(len=:), allocatable :: msg character(len=:), allocatable :: version_str - version_str = compiler_version() + allocate(version_str, source=compiler_version()) if (index(version_str, 'GCC') > 0) then msg = 'gfortran' From b587fdf20cce851e95ff8eab00cfe38977fbf267 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 28 Sep 2025 08:24:49 +0200 Subject: [PATCH 50/59] ifx crash: fix `fPIC` logic --- ci/run_tests.sh | 2 +- src/fpm.f90 | 52 +++++++++++++++++++++++++++++++-------------- src/fpm_targets.f90 | 10 ++++++--- 3 files changed, 44 insertions(+), 20 deletions(-) diff --git a/ci/run_tests.sh b/ci/run_tests.sh index 1743a04ab2..239ccc49cf 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -317,7 +317,7 @@ popd # Test shared library dependencies pushd shared_lib -"$fpm" build || EXIT_CODE=$? +"$fpm" build --verbose || EXIT_CODE=$? test $EXIT_CODE -eq 0 popd diff --git a/src/fpm.f90 b/src/fpm.f90 index ecc480f7bf..b7cc9e1e13 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -12,7 +12,9 @@ module fpm use fpm_model, only: fpm_model_t, srcfile_t, show_model, & FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, FPM_SCOPE_DEP, & FPM_SCOPE_APP, FPM_SCOPE_EXAMPLE, FPM_SCOPE_TEST -use fpm_compiler, only: new_compiler, new_archiver, set_cpp_preprocessor_flags +use fpm_compiler, only: new_compiler, new_archiver, set_cpp_preprocessor_flags, & + id_intel_classic_nix,id_intel_classic_mac,id_intel_llvm_nix, & + id_intel_llvm_unknown use fpm_sources, only: add_executable_sources, add_sources_from_dir @@ -335,28 +337,46 @@ subroutine new_compiler_flags(model, settings, package) type(fpm_build_settings), intent(in) :: settings type(package_config_t), intent(in) :: package - logical :: release_profile, debug_profile + logical :: release_request, debug_request, need_defaults + character(len=:), allocatable :: fallback - release_profile = .false. - debug_profile = .false. - if (allocated(settings%profile)) release_profile = settings%profile == "release" - if (allocated(settings%profile)) debug_profile = settings%profile == "debug" - - ! Debug./Release profile requested but not defined: - ! fallback to backward-compatible behavior - if ( (release_profile .and. package%find_profile("release")==0) & - .or. (debug_profile .and. package%find_profile("debug")==0) ) then + ! Default: "debug" if not requested + release_request = .false. + debug_request = .not.allocated(settings%profile) + if (allocated(settings%profile)) release_request = settings%profile == "release" + if (allocated(settings%profile)) debug_request = settings%profile == "debug" + + need_defaults = release_request .or. debug_request + + ! Backward-compatible: if debug/release requested, but a user-defined profile is not defined, + ! apply fpm compiler defaults + if (need_defaults) then + + need_defaults = (release_request .and. package%find_profile("release")<=0) & + .or. (debug_request .and. package%find_profile("debug")<=0) - model%fortran_compile_flags = assemble_flags(settings%flag,package%flags,& - model%compiler%get_default_flags(release_profile)) + end if + + ! Fix: Always include compiler default flags for Intel ifx -fPIC issue + if (need_defaults) then + fallback = model%compiler%get_default_flags(release_request) + + elseif (any(model%compiler%id==[id_intel_classic_mac, & + id_intel_classic_nix, & + id_intel_llvm_nix, & + id_intel_llvm_unknown])) then + + ! Intel compilers need -fPIC for shared libraries (except Windows) + fallback = " -fPIC" else - model%fortran_compile_flags = assemble_flags(settings%flag, package%flags) + if (allocated(fallback)) deallocate(fallback) ! trigger .not.present - end if - + endif + + model%fortran_compile_flags = assemble_flags(settings%flag, package%flags, fallback) model%c_compile_flags = assemble_flags(settings%cflag, package%c_flags) model%cxx_compile_flags = assemble_flags(settings%cxxflag, package%cxx_flags) model%link_flags = assemble_flags(settings%ldflag, package%link_time_flags) diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index 7de5b92c88..7c7435ef93 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -1076,7 +1076,7 @@ end subroutine prune_build_targets subroutine resolve_target_linking(targets, model, library, error) type(build_target_ptr), intent(inout), target :: targets(:) type(fpm_model_t), intent(in) :: model - type(library_config_t), intent(in), optional :: library + type(library_config_t), intent(in), optional :: library type(error_t), allocatable, intent(out) :: error integer :: i,j @@ -1085,8 +1085,10 @@ subroutine resolve_target_linking(targets, model, library, error) character(:), allocatable :: global_link_flags, local_link_flags character(:), allocatable :: global_include_flags, shared_lib_paths + if (size(targets) == 0) return + global_link_flags = "" if (allocated(model%link_libraries)) then if (size(model%link_libraries) > 0) then @@ -1116,13 +1118,14 @@ subroutine resolve_target_linking(targets, model, library, error) associate(target => targets(i)%ptr) + ! If the main program is a C/C++ one, some compilers require additional linking flags, see ! https://stackoverflow.com/questions/36221612/p3dfft-compilation-ifort-compiler-error-multiple-definiton-of-main ! In this case, compile_flags were already allocated if (.not.allocated(target%compile_flags)) allocate(character(len=0) :: target%compile_flags) target%compile_flags = target%compile_flags//' ' - + select case (target%target_type) case (FPM_TARGET_C_OBJECT) target%compile_flags = target%compile_flags//model%c_compile_flags @@ -1141,7 +1144,8 @@ subroutine resolve_target_linking(targets, model, library, error) if (len(global_include_flags) > 0) then target%compile_flags = target%compile_flags//global_include_flags end if - + + call target%set_output_dir(get_output_dir(model%build_prefix, target%compile_flags)) end associate From fc5f5c48d15096a9add70213900ee2d88f065b8a Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 28 Sep 2025 10:01:59 +0200 Subject: [PATCH 51/59] debug print --- src/fpm/manifest/platform.f90 | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/src/fpm/manifest/platform.f90 b/src/fpm/manifest/platform.f90 index 96641e4e83..0c9c8a468d 100644 --- a/src/fpm/manifest/platform.f90 +++ b/src/fpm/manifest/platform.f90 @@ -26,7 +26,7 @@ module fpm_manifest_platform !> Shortcuts for the Intel OS variants integer(compiler_enum), parameter :: & id_intel_classic(*) = [id_intel_classic_mac,id_intel_classic_nix,id_intel_classic_windows], & - id_intel_llvm (*) = [id_intel_llvm_nix,id_intel_llvm_windows] + id_intel_llvm (*) = [id_intel_llvm_nix,id_intel_llvm_windows,id_intel_llvm_unknown] !> Serializable platform configuration (compiler + OS only) type, extends(serializable_t) :: platform_config_t @@ -251,10 +251,13 @@ logical function platform_is_suitable(self, target) result(ok) type(platform_config_t), intent(in) :: target logical :: compiler_ok, os_ok + + ! Check that both platforms are valid if (.not. self%is_valid() .or. .not. target%is_valid()) then ok = .false. + print *, 'compare platform ',self%name(),' with target ',target%name(),': ok=',ok return end if @@ -264,6 +267,8 @@ logical function platform_is_suitable(self, target) result(ok) ! Basic matching ok = compiler_ok .and. os_ok + if (.not.ok) print *, 'compare platform ',self%name(),' with target ',target%name(),': ok=',ok + if (.not. ok) return ! Additional validation: Intel compilers must have compatible OS @@ -273,6 +278,8 @@ logical function platform_is_suitable(self, target) result(ok) compiler_os_compatible(target%compiler, target%os_type) end if + print *, 'compare platform ',self%name(),' with target ',target%name(),': ok=',ok + end function platform_is_suitable !> Check if a platform configuration is valid (no unknowns, compatible compiler+OS) From a9d702dc9ae285437fb2602aa30f8122ba73a148 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 28 Sep 2025 10:03:23 +0200 Subject: [PATCH 52/59] Update platform.f90 --- src/fpm/manifest/platform.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fpm/manifest/platform.f90 b/src/fpm/manifest/platform.f90 index 0c9c8a468d..30f895d9ce 100644 --- a/src/fpm/manifest/platform.f90 +++ b/src/fpm/manifest/platform.f90 @@ -15,7 +15,7 @@ module fpm_manifest_platform OS_WINDOWS, OS_LINUX, OS_MACOS use fpm_compiler, only : compiler_enum, compiler_id_name, match_compiler_type, id_all, & id_unknown, validate_compiler_name, id_intel_classic_nix, id_intel_classic_mac, & - id_intel_classic_windows, id_intel_llvm_nix, id_intel_llvm_windows + id_intel_classic_windows, id_intel_llvm_nix, id_intel_llvm_windows, id_intel_llvm_unknown use fpm_strings, only : lower implicit none private From 0ae4f8e692d7d0fc1242e19f521c5fd70504a02e Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 28 Sep 2025 10:11:38 +0200 Subject: [PATCH 53/59] more output --- src/fpm/manifest/feature_collection.f90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/fpm/manifest/feature_collection.f90 b/src/fpm/manifest/feature_collection.f90 index c66dc5f068..6cf2b5b3a5 100644 --- a/src/fpm/manifest/feature_collection.f90 +++ b/src/fpm/manifest/feature_collection.f90 @@ -1159,8 +1159,11 @@ subroutine merge_into_package(self, package, target, error) feature = self%extract_for_target(target, error) if (allocated(error)) return + print *, 'extract for target: flags=',feature%flags + ! Merge the extracted feature into the package call merge_feature_configs(package, feature, error) + print *, 'merged for target: flags=',package%flags if (allocated(error)) return end subroutine merge_into_package From 4551e49516d0ccaa387fd6ba6aaecb9bdd222612 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 28 Sep 2025 10:19:07 +0200 Subject: [PATCH 54/59] Update feature_collection.f90 --- src/fpm/manifest/feature_collection.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/fpm/manifest/feature_collection.f90 b/src/fpm/manifest/feature_collection.f90 index 6cf2b5b3a5..393e6a0739 100644 --- a/src/fpm/manifest/feature_collection.f90 +++ b/src/fpm/manifest/feature_collection.f90 @@ -1160,10 +1160,12 @@ subroutine merge_into_package(self, package, target, error) if (allocated(error)) return print *, 'extract for target: flags=',feature%flags + print *, 'extract for target: link=',feature%link_time_flags ! Merge the extracted feature into the package call merge_feature_configs(package, feature, error) print *, 'merged for target: flags=',package%flags + print *, 'merged for target: link=',package%link_time_flags if (allocated(error)) return end subroutine merge_into_package From 150bca5ae78be3abf3688e7a89519950ec582660 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 28 Sep 2025 11:35:38 +0200 Subject: [PATCH 55/59] ifx 2025.2 --- .github/workflows/CI.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/CI.yml b/.github/workflows/CI.yml index 3db6dc91aa..fcca8e33dc 100644 --- a/.github/workflows/CI.yml +++ b/.github/workflows/CI.yml @@ -29,12 +29,12 @@ jobs: - {compiler: gcc, version: 13} - {compiler: gcc, version: 14} - {compiler: gcc, version: 15} - - {compiler: intel, version: 2025.1} + - {compiler: intel, version: 2025.2} exclude: - os: macos-13 # No Intel on MacOS anymore since 2024 - toolchain: {compiler: intel, version: '2025.1'} + toolchain: {compiler: intel, version: '2025.2'} - os: windows-latest # Doesn't pass build and tests yet - toolchain: {compiler: intel, version: '2025.1'} + toolchain: {compiler: intel, version: '2025.2'} - os: windows-latest # gcc 14 not available on Windows yet toolchain: {compiler: gcc, version: 14} - os: windows-latest # gcc 15 not available on Windows yet From c3b16bec57537d985734b6188d828090e214758d Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 28 Sep 2025 11:56:18 +0200 Subject: [PATCH 56/59] avoid `xHost` on Intel compilers --- example_packages/features_per_compiler/app/main.f90 | 2 -- example_packages/features_per_compiler/fpm.toml | 4 ++-- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/example_packages/features_per_compiler/app/main.f90 b/example_packages/features_per_compiler/app/main.f90 index ac6b16c55e..db2c88b536 100644 --- a/example_packages/features_per_compiler/app/main.f90 +++ b/example_packages/features_per_compiler/app/main.f90 @@ -166,7 +166,6 @@ function check_ifort_flags(options, debug_on, release_on, fast_on, strict_on) re end if if (release_on) then - if (.not. check_flag(options, '-xHost', 'Release', '-xHost')) failed_count = failed_count + 1 if (.not. check_flag(options, '-unroll', 'Release', '-unroll')) failed_count = failed_count + 1 end if @@ -195,7 +194,6 @@ function check_ifx_flags(options, debug_on, release_on, fast_on, strict_on) resu end if if (release_on) then - if (.not. check_flag(options, '-xHost', 'Release', '-xHost')) failed_count = failed_count + 1 if (.not. check_flag(options, '-unroll', 'Release', '-unroll')) failed_count = failed_count + 1 end if diff --git a/example_packages/features_per_compiler/fpm.toml b/example_packages/features_per_compiler/fpm.toml index 26221eade6..aaf7d8d168 100644 --- a/example_packages/features_per_compiler/fpm.toml +++ b/example_packages/features_per_compiler/fpm.toml @@ -35,8 +35,8 @@ debug.preprocess.cpp.macros = "DEBUG" # Release feature with base optimization, then per-compiler extensions release.flags = "-O3" # Base optimization for ALL compilers (applied first) release.gfortran.flags = "-march=native -funroll-loops" -release.ifort.flags = "-xHost -unroll" # Unix/Linux/macOS Intel -release.ifx.flags = "-xHost -unroll" # Intel oneAPI +release.ifort.flags = "-unroll" # Unix/Linux/macOS Intel +release.ifx.flags = "-unroll" # Intel oneAPI # Verbose feature for enhanced diagnostics (applies to all compilers) verbose.flags = "-v" From bf8757c985f9cfd65e7ae861e4281a83fa2265f8 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 28 Sep 2025 15:59:37 +0200 Subject: [PATCH 57/59] do not use `-fast` on `ifx` --- example_packages/features_per_compiler/fpm.toml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/example_packages/features_per_compiler/fpm.toml b/example_packages/features_per_compiler/fpm.toml index aaf7d8d168..168fa27f7b 100644 --- a/example_packages/features_per_compiler/fpm.toml +++ b/example_packages/features_per_compiler/fpm.toml @@ -44,8 +44,8 @@ verbose.flags = "-v" # Fast feature with base optimization, then per-compiler extensions fast.flags = "-O3" # Base fast optimization for ALL compilers (applied first) fast.gfortran.flags = "-Ofast -ffast-math" -fast.ifort.flags = "-fast" -fast.ifx.flags = "-fast" +fast.ifort.flags = "-fp-model fast" +fast.ifx.flags = "-fp-model fast" # Strict feature with base standard compliance, then per-compiler extensions strict.flags = "-std=f2018" # Base standard compliance for ALL compilers (applied first) From 4f21bf2c78a5faa6e9f2eaf412b7b74de96548a6 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 28 Sep 2025 16:17:27 +0200 Subject: [PATCH 58/59] Update main.f90 --- example_packages/features_per_compiler/app/main.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/example_packages/features_per_compiler/app/main.f90 b/example_packages/features_per_compiler/app/main.f90 index db2c88b536..5eaffcf746 100644 --- a/example_packages/features_per_compiler/app/main.f90 +++ b/example_packages/features_per_compiler/app/main.f90 @@ -170,7 +170,7 @@ function check_ifort_flags(options, debug_on, release_on, fast_on, strict_on) re end if if (fast_on) then - if (.not. check_flag(options, '-fast', 'Fast', '-ffast')) failed_count = failed_count + 1 + if (.not. check_flag(options, '-fp-model', 'Fast', 'fast')) failed_count = failed_count + 1 end if if (strict_on) then @@ -198,7 +198,7 @@ function check_ifx_flags(options, debug_on, release_on, fast_on, strict_on) resu end if if (fast_on) then - if (.not. check_flag(options, '-fast', 'Fast', '-ffast')) failed_count = failed_count + 1 + if (.not. check_flag(options, '-fp-model', 'Fast', 'fast')) failed_count = failed_count + 1 end if if (strict_on) then From 7ef6f2260bbb2032a97282e8a35de1a753e81bda Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 14 Oct 2025 09:48:47 +0200 Subject: [PATCH 59/59] `arm64` compiler fixes --- .github/workflows/CI.yml | 2 ++ ci/test_features.sh | 7 ++----- example_packages/features_demo/fpm.toml | 2 +- example_packages/features_per_compiler/app/main.f90 | 13 ++----------- example_packages/features_per_compiler/fpm.toml | 2 +- example_packages/features_with_dependency/fpm.toml | 2 +- test/fpm_test/test_features.f90 | 13 +++++++++---- test/fpm_test/test_manifest.f90 | 2 +- 8 files changed, 19 insertions(+), 24 deletions(-) diff --git a/.github/workflows/CI.yml b/.github/workflows/CI.yml index bf652c4787..51ce51b542 100644 --- a/.github/workflows/CI.yml +++ b/.github/workflows/CI.yml @@ -33,6 +33,8 @@ jobs: exclude: - os: macos-14 # No Intel on MacOS anymore since 2024 toolchain: {compiler: intel, version: '2025.1'} + - os: macos-14 # Intel compiler does not support ARM (macos-14) + toolchain: {compiler: intel, version: '2025.2'} - os: macos-14 # gcc@10 not available on macos-14 (ARM64) toolchain: {compiler: gcc, version: 10} - os: windows-latest # Doesn't pass build and tests yet diff --git a/ci/test_features.sh b/ci/test_features.sh index 387f26c57e..ac370a1db2 100755 --- a/ci/test_features.sh +++ b/ci/test_features.sh @@ -207,11 +207,8 @@ grep -q "✓ FAST: fast optimization flags found" output.txt || { echo "ERROR: F grep -q "✓ All compiler flag checks PASSED" output.txt || { echo "ERROR: Expected all checks to pass"; exit 1; } # Check compiler-specific flags (will depend on detected compiler) if grep -q "Detected compiler: gfortran" output.txt; then - # Check for either -march=native or -mcpu (Apple Silicon uses -mcpu) - if ! (grep -q "✓ Release: -march=native found" output.txt || grep -q "✓ Release: -mcpu found" output.txt); then - echo "ERROR: gfortran release architecture flag (-march=native or -mcpu) not found" - exit 1 - fi + # Check for -mtune flag (portable tuning flag) + grep -q "✓ Release: -mtune found" output.txt || { echo "ERROR: gfortran release flag -mtune not found"; exit 1; } grep -q "✓ Fast: -ffast-math found" output.txt || { echo "ERROR: gfortran fast flag -ffast-math not found"; exit 1; } fi echo "✓ Production profile works" diff --git a/example_packages/features_demo/fpm.toml b/example_packages/features_demo/fpm.toml index 2f03836dc3..e3e50b6464 100644 --- a/example_packages/features_demo/fpm.toml +++ b/example_packages/features_demo/fpm.toml @@ -19,7 +19,7 @@ release.preprocess.cpp.macros = "RELEASE" # Compiler-specific features debug.gfortran.flags = "-Wall -fcheck=bounds" -release.gfortran.flags = "-march=native" +release.gfortran.flags = "-mtune=generic -funroll-loops" # Platform-specific features linux.preprocess.cpp.macros = "LINUX_BUILD" diff --git a/example_packages/features_per_compiler/app/main.f90 b/example_packages/features_per_compiler/app/main.f90 index 5eaffcf746..a76dcd5dee 100644 --- a/example_packages/features_per_compiler/app/main.f90 +++ b/example_packages/features_per_compiler/app/main.f90 @@ -126,17 +126,8 @@ function check_gfortran_flags(options, debug_on, release_on, fast_on, strict_on) end if if (release_on) then - ! Check for either -march or -mcpu (Apple Silicon uses -mcpu; -match=native may be re-resolved by gcc) - if (.not. (index(options, '-march') > 0 .or. index(options, '-mcpu') > 0)) then - print '(a)', ' ✗ Release: neither -march=native nor -mcpu found' - failed_count = failed_count + 1 - else - if (index(options, '-march=native') > 0) then - print '(a)', ' ✓ Release: -march found' - else - print '(a)', ' ✓ Release: -mcpu found' - end if - end if + ! Check for -mtune flag (portable tuning flag that works on all platforms) + if (.not. check_flag(options, '-mtune', 'Release', '-mtune')) failed_count = failed_count + 1 if (.not. check_flag(options, '-funroll-loops', 'Release', '-funroll-loops')) failed_count = failed_count + 1 end if diff --git a/example_packages/features_per_compiler/fpm.toml b/example_packages/features_per_compiler/fpm.toml index 168fa27f7b..6974b2ac83 100644 --- a/example_packages/features_per_compiler/fpm.toml +++ b/example_packages/features_per_compiler/fpm.toml @@ -34,7 +34,7 @@ debug.preprocess.cpp.macros = "DEBUG" # Release feature with base optimization, then per-compiler extensions release.flags = "-O3" # Base optimization for ALL compilers (applied first) -release.gfortran.flags = "-march=native -funroll-loops" +release.gfortran.flags = "-mtune=generic -funroll-loops" release.ifort.flags = "-unroll" # Unix/Linux/macOS Intel release.ifx.flags = "-unroll" # Intel oneAPI diff --git a/example_packages/features_with_dependency/fpm.toml b/example_packages/features_with_dependency/fpm.toml index 055c6dbffd..49781da3cb 100644 --- a/example_packages/features_with_dependency/fpm.toml +++ b/example_packages/features_with_dependency/fpm.toml @@ -30,7 +30,7 @@ linux_specific.preprocess.cpp.macros = ["WITH_DEMO","LINUX_FEATURES"] # Feature combining compiler and dependency features gfortran_optimized.gfortran.dependencies.features_demo = { path = "../features_demo", features = ["release", "gfortran"] } -gfortran_optimized.gfortran.flags = "-O3 -march=native" +gfortran_optimized.gfortran.flags = "-O3 -mtune=generic -funroll-loops" gfortran_optimized.preprocess.cpp.macros = ["WITH_DEMO"] diff --git a/test/fpm_test/test_features.f90 b/test/fpm_test/test_features.f90 index 07509dbe00..4aa873c772 100644 --- a/test/fpm_test/test_features.f90 +++ b/test/fpm_test/test_features.f90 @@ -365,7 +365,7 @@ subroutine test_feature_collection_complex(error) & 'debug.linux.flags = "-DLINUX"', & & 'debug.windows.ifort.flags = "/DEBUG:FULL"', & & 'release.flags = "-O3"', & - & 'release.gfortran.flags = "-march=native"' + & 'release.gfortran.flags = "-mtune=generic -funroll-loops"' close(unit) call get_package_data(package, temp_file, error) @@ -1501,7 +1501,7 @@ subroutine test_feature_compiler_flags_integration(error) write(unit, '(a)') '[features]' write(unit, '(a)') 'debug.gfortran.flags = "-g -Wall -fcheck=bounds"' write(unit, '(a)') 'debug.flags = "-g"' - write(unit, '(a)') 'release.gfortran.flags = "-O3 -march=native"' + write(unit, '(a)') 'release.gfortran.flags = "-O3 -mtune=generic -funroll-loops"' write(unit, '(a)') 'release.flags = "-O2"' write(unit, '(a)') '' write(unit, '(a)') '[profiles]' @@ -1575,8 +1575,13 @@ subroutine test_feature_compiler_flags_integration(error) return end if - if (index(model%fortran_compile_flags, "-march=native") == 0) then - call test_failed(error, "Expected release gfortran flags to contain '-march=native'") + if (index(model%fortran_compile_flags, "-mtune") == 0) then + call test_failed(error, "Expected release gfortran flags to contain '-mtune'") + return + end if + + if (index(model%fortran_compile_flags, "-funroll-loops") == 0) then + call test_failed(error, "Expected release gfortran flags to contain '-funroll-loops'") return end if diff --git a/test/fpm_test/test_manifest.f90 b/test/fpm_test/test_manifest.f90 index 64483f8c65..9975188bd1 100644 --- a/test/fpm_test/test_manifest.f90 +++ b/test/fpm_test/test_manifest.f90 @@ -1762,7 +1762,7 @@ subroutine test_features_demo_serialization(error) & '', & & '# Compiler-specific features', & & 'debug.gfortran.flags = "-Wall -fcheck=bounds"', & - & 'release.gfortran.flags = "-march=native"', & + & 'release.gfortran.flags = "-mtune=generic -funroll-loops"', & & '', & & '# Platform-specific features', & & 'linux.preprocess.cpp.macros = "LINUX_BUILD"', &