diff --git a/src/fpm.f90 b/src/fpm.f90 index c27d507b2b..1cabc49dbf 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -19,6 +19,7 @@ module fpm use fpm_targets, only: targets_from_sources, build_target_t, build_target_ptr, & FPM_TARGET_EXECUTABLE, get_library_dirs, filter_executable_targets use fpm_manifest, only : get_package_data, package_config_t +use fpm_manifest_platform, only: platform_config_t use fpm_meta, only : resolve_metapackages use fpm_error, only : error_t, fatal_error, fpm_stop use fpm_toml, only: name_is_json @@ -37,26 +38,30 @@ module fpm contains !> Constructs a valid fpm model from command line settings and the toml manifest. -subroutine build_model(model, settings, package, error) +subroutine build_model(model, settings, package_config, error) type(fpm_model_t), intent(out) :: model class(fpm_build_settings), intent(inout) :: settings - type(package_config_t), intent(inout), target :: package + type(package_config_t), intent(inout), target :: package_config type(error_t), allocatable, intent(out) :: error integer :: i, j - type(package_config_t), target :: dependency + type(package_config_t), target :: package, dependency_config, dependency type(package_config_t), pointer :: manifest + type(platform_config_t) :: target_platform character(len=:), allocatable :: file_name, lib_dir logical :: has_cpp - logical :: duplicates_found + logical :: duplicates_found, auto_exe, auto_example, auto_test type(string_t) :: include_dir - model%package_name = package%name + model%package_name = package_config%name + + ! Set target OS to current OS (may be extended for cross-compilation in the future) + model%target_os = get_os_type() allocate(model%include_dirs(0)) allocate(model%link_libraries(0)) allocate(model%external_modules(0)) - + call new_compiler(model%compiler, settings%compiler, settings%c_compiler, & & settings%cxx_compiler, echo=settings%verbose, verbose=settings%verbose) call new_archiver(model%archiver, settings%archiver, & @@ -67,18 +72,27 @@ subroutine build_model(model, settings, package, error) "", "Unknown compiler", model%compiler%fc, "requested!", & "Defaults for this compiler might be incorrect" end if - + + ! 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%enforce_module_names = package%build%module_naming - model%module_prefix = package%build%module_prefix - + model%include_tests = settings%build_tests + + ! Extract the current package configuration request + package = package_config%export_config(target_platform) + ! Resolve meta-dependencies into the package and the model call resolve_metapackages(model,package,settings,error) if (allocated(error)) return + if (allocated(package%build)) then + model%enforce_module_names = package%build%module_naming + model%module_prefix = package%build%module_prefix + endif + ! Create dependencies call new_dependency_tree(model%deps, cache=join_path(settings%build_dir, "cache.toml"), & & path_to_config=settings%path_to_config, build_dir=settings%build_dir) @@ -109,19 +123,20 @@ subroutine build_model(model, settings, package, error) manifest => package else - call get_package_data(dependency, file_name, error, apply_defaults=.true.) - if (allocated(error)) exit + ! Extract this dependency config + call get_package_data(dependency_config, file_name, error, apply_defaults=.true.) + if (allocated(error)) exit + + ! Adapt it to the current profile/platform + dependency = dependency_config%export_config(target_platform) manifest => dependency end if - model%packages(i)%name = manifest%name - associate(features => model%packages(i)%features) - features%implicit_typing = manifest%fortran%implicit_typing - features%implicit_external = manifest%fortran%implicit_external - features%source_form = manifest%fortran%source_form - end associate - model%packages(i)%version = manifest%version + + model%packages(i)%name = manifest%name + model%packages(i)%features = manifest%fortran + model%packages(i)%version = manifest%version !> Add this dependency's manifest macros if (allocated(manifest%preprocess)) then @@ -163,18 +178,22 @@ subroutine build_model(model, settings, package, error) end if end if + + if (allocated(manifest%build)) then - if (allocated(manifest%build%link)) then - model%link_libraries = [model%link_libraries, manifest%build%link] - end if + if (allocated(manifest%build%link)) then + model%link_libraries = [model%link_libraries, manifest%build%link] + end if - if (allocated(manifest%build%external_modules)) then - model%external_modules = [model%external_modules, manifest%build%external_modules] - end if + if (allocated(manifest%build%external_modules)) then + model%external_modules = [model%external_modules, manifest%build%external_modules] + end if - ! Copy naming conventions from this dependency's manifest - model%packages(i)%enforce_module_names = manifest%build%module_naming - model%packages(i)%module_prefix = manifest%build%module_prefix + ! Copy naming conventions from this dependency's manifest + model%packages(i)%enforce_module_names = manifest%build%module_naming + model%packages(i)%module_prefix = manifest%build%module_prefix + + endif end associate end do @@ -184,7 +203,18 @@ subroutine build_model(model, settings, package, error) if (has_cpp) call set_cpp_preprocessor_flags(model%compiler%id, model%fortran_compile_flags) ! Add sources from executable directories - if (is_dir('app') .and. package%build%auto_executables) then + + if (allocated(package%build)) then + auto_exe = package%build%auto_executables + auto_example = package%build%auto_examples + auto_test = package%build%auto_tests + else + auto_exe = .true. + auto_example = .true. + auto_test = .true. + endif + + if (is_dir('app') .and. auto_exe) then call add_sources_from_dir(model%packages(1)%sources,'app', FPM_SCOPE_APP, & with_executables=.true., with_f_ext=model%packages(1)%preprocess%suffixes,& error=error,preprocess=model%packages(1)%preprocess) @@ -194,7 +224,7 @@ subroutine build_model(model, settings, package, error) end if end if - if (is_dir('example') .and. package%build%auto_examples) then + if (is_dir('example') .and. auto_example) then call add_sources_from_dir(model%packages(1)%sources,'example', FPM_SCOPE_EXAMPLE, & with_executables=.true., & with_f_ext=model%packages(1)%preprocess%suffixes,error=error,& @@ -205,7 +235,7 @@ subroutine build_model(model, settings, package, error) end if end if - if (is_dir('test') .and. package%build%auto_tests) then + if (is_dir('test') .and. auto_test) then call add_sources_from_dir(model%packages(1)%sources,'test', FPM_SCOPE_TEST, & with_executables=.true., & with_f_ext=model%packages(1)%preprocess%suffixes,error=error,& @@ -218,7 +248,7 @@ subroutine build_model(model, settings, package, error) end if if (allocated(package%executable)) then call add_executable_sources(model%packages(1)%sources, package%executable, FPM_SCOPE_APP, & - auto_discover=package%build%auto_executables, & + auto_discover=auto_exe, & with_f_ext=model%packages(1)%preprocess%suffixes, & error=error,preprocess=model%packages(1)%preprocess) @@ -229,7 +259,7 @@ subroutine build_model(model, settings, package, error) end if if (allocated(package%example)) then call add_executable_sources(model%packages(1)%sources, package%example, FPM_SCOPE_EXAMPLE, & - auto_discover=package%build%auto_examples, & + auto_discover=auto_example, & with_f_ext=model%packages(1)%preprocess%suffixes, & error=error,preprocess=model%packages(1)%preprocess) @@ -240,7 +270,7 @@ subroutine build_model(model, settings, package, error) end if if (allocated(package%test)) then call add_executable_sources(model%packages(1)%sources, package%test, FPM_SCOPE_TEST, & - auto_discover=package%build%auto_tests, & + auto_discover=auto_test, & with_f_ext=model%packages(1)%preprocess%suffixes, & error=error,preprocess=model%packages(1)%preprocess) diff --git a/src/fpm/cmd/install.f90 b/src/fpm/cmd/install.f90 index 0a33f044fb..df0e00b69f 100644 --- a/src/fpm/cmd/install.f90 +++ b/src/fpm/cmd/install.f90 @@ -29,7 +29,9 @@ subroutine cmd_install(settings) type(build_target_ptr), allocatable :: targets(:), libraries(:) type(installer_t) :: installer type(string_t), allocatable :: list(:) - logical :: installable + logical :: installable, has_install, with_library, with_tests + logical :: has_library, has_executables + character(len=:), allocatable :: module_dir integer :: ntargets,i call get_package_data(package, "fpm.toml", error, apply_defaults=.true.) @@ -38,8 +40,22 @@ subroutine cmd_install(settings) call build_model(model, settings, package, error) call handle_error(error) + ! Set up logical variables to avoid repetitive conditions + has_install = allocated(package%install) + has_library = allocated(package%library) + has_executables = allocated(package%executable) + if (has_install) then + with_library = has_install .and. package%install%library + with_tests = has_install .and. package%install%test + ! Set module directory (or leave unallocated because `optional`) + if (allocated(package%install%module_dir)) module_dir = package%install%module_dir + else + with_library = .false. + with_tests = .false. + endif + ! ifx bug: does not resolve allocatable -> optional - if (allocated(package%library)) then + if (has_library) then call targets_from_sources(targets, model, settings%prune, package%library, error) else call targets_from_sources(targets, model, settings%prune, error=error) @@ -49,8 +65,7 @@ subroutine cmd_install(settings) call install_info(output_unit, settings%list, targets, ntargets) if (settings%list) return - installable = (allocated(package%library) .and. package%install%library) & - .or. allocated(package%executable) .or. ntargets>0 + installable = (has_library .and. with_library) .or. has_executables .or. ntargets>0 if (.not.installable) then call fatal_error(error, "Project does not contain any installable targets") @@ -63,10 +78,10 @@ subroutine cmd_install(settings) call new_installer(installer, prefix=settings%prefix, & bindir=settings%bindir, libdir=settings%libdir, testdir=settings%testdir, & - includedir=settings%includedir, moduledir=package%install%module_dir, & + includedir=settings%includedir, moduledir=module_dir, & verbosity=merge(2, 1, settings%verbose)) - if (allocated(package%library) .and. package%install%library) then + if (has_library .and. with_library) then call filter_library_targets(targets, libraries) if (size(libraries) > 0) then @@ -80,12 +95,12 @@ subroutine cmd_install(settings) end if end if - if (allocated(package%executable) .or. ntargets>0) then + if (has_executables .or. ntargets>0) then call install_executables(installer, targets, error) call handle_error(error) end if - if (allocated(package%test) .and. (package%install%test .or. model%include_tests)) then + if (allocated(package%test) .and. (with_tests .or. model%include_tests)) then call install_tests(installer, targets, error) call handle_error(error) diff --git a/src/fpm/manifest/feature.f90 b/src/fpm/manifest/feature.f90 new file mode 100644 index 0000000000..d9c878eb16 --- /dev/null +++ b/src/fpm/manifest/feature.f90 @@ -0,0 +1,1197 @@ +!> Implementation of the meta data for features. +!> +!> A feature is a configurable set of package properties that can be +!> conditionally enabled. Features allow fine-grained control over +!> dependencies, compiler flags, preprocessor definitions, and other +!> package components based on the target compiler and operating system. +!> +!> Features are similar to Rust Cargo features but adapted for Fortran +!> package management. Each feature can specify: +!> - Compiler-specific flags and settings +!> - Additional dependencies +!> - Preprocessor definitions +!> - Source files and build configurations +!> +!> A feature table can currently have the following fields: +!> +!>```toml +!>[features.mpi] +!>description = "Enable MPI parallel support" +!>compiler = "gfortran" +!>os = "linux" +!>flags = "-fopenmp" +!>preprocessor = ["WITH_MPI"] +!>[features.mpi.dependencies] +!>mpi = { git = "https://github.com/fortran-lang/mpi" } +!>``` +!> +module fpm_manifest_feature + use fpm_manifest_build, only: build_config_t, new_build_config + use fpm_manifest_dependency, only: dependency_config_t, new_dependencies + 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 + use fpm_manifest_library, only: library_config_t, new_library + use fpm_manifest_install, only: install_config_t, new_install_config + use fpm_manifest_test, only: test_config_t, new_test + use fpm_manifest_preprocess, only: preprocess_config_t, new_preprocessors + use fpm_manifest_metapackages, only: metapackage_config_t, new_meta_config + use fpm_manifest_platform, only: platform_config_t + use fpm_error, only: error_t, fatal_error, syntax_error + use fpm_environment, only: OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, OS_CYGWIN, OS_SOLARIS, & + OS_FREEBSD, OS_OPENBSD, OS_ALL, OS_NAME, match_os_type + use fpm_compiler, only: compiler_enum, compiler_id_name, match_compiler_type, id_all + use fpm_strings, only: string_t, lower, operator(==) + use tomlf, only: toml_table, toml_array, toml_key, toml_stat + use fpm_toml, only: get_value, len, serializable_t, set_value, set_string, set_list, add_table, & + get_list + implicit none + private + + public :: feature_config_t, new_feature, new_features, find_feature, init_feature_components, & + unique_programs + + !> Feature configuration data + type, extends(serializable_t) :: feature_config_t + + !> Feature identity + character(len=:), allocatable :: name + character(len=:), allocatable :: description + + !> Compiler/OS targeting (consistent with profile_config_t pattern) + type(platform_config_t) :: platform + + !> Build configuration + type(build_config_t), allocatable :: build + + !> Installation configuration + type(install_config_t), allocatable :: install + + !> Fortran configuration + type(fortran_config_t), allocatable :: fortran + + !> Library configuration + type(library_config_t), allocatable :: library + + !> Executable configurations + type(executable_config_t), allocatable :: executable(:) + + !> Dependencies + type(dependency_config_t), allocatable :: dependency(:) + + !> Development dependencies + type(dependency_config_t), allocatable :: dev_dependency(:) + + !> Examples + type(example_config_t), allocatable :: example(:) + + !> Tests + type(test_config_t), allocatable :: test(:) + + !> Preprocessor configuration + type(preprocess_config_t), allocatable :: preprocess(:) + + !> Metapackage data + type(metapackage_config_t) :: meta + + !> Compiler flags + character(len=:), allocatable :: flags + character(len=:), allocatable :: c_flags + character(len=:), allocatable :: cxx_flags + character(len=:), allocatable :: link_time_flags + + !> Feature dependencies + type(string_t), allocatable :: requires_features(:) + + !> Is this feature enabled by default + logical :: default = .false. + + contains + + !> Print information on this instance + procedure :: info + + !> Check validity of the TOML table + procedure, nopass :: check + + !> Get manifest name + procedure :: manifest_name + + !> Serialization interface + procedure :: serializable_is_same => feature_is_same + procedure :: dump_to_toml + procedure :: load_from_toml + + end type feature_config_t + + character(len=*), parameter, private :: class_name = 'feature_config_t' + + interface unique_programs + module procedure :: unique_programs1 + module procedure :: unique_programs2 + end interface unique_programs + +contains + + !> Construct a new feature configuration from a TOML data structure + subroutine new_feature(self, table, root, error, name) + + !> Instance of the feature configuration + type(feature_config_t), intent(out) :: self + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Root directory of the manifest + character(len=*), intent(in), optional :: root + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + !> Optional name override (if not provided, gets from table key) + character(len=*), intent(in), optional :: name + + type(toml_table), pointer :: child, node + type(toml_array), pointer :: children + character(len=:), allocatable :: compiler_name, os_name + integer :: ii, nn, stat + + ! Only check schema for pure features (not when called from package) + if (.not. present(name)) then + call check(table, error) + if (allocated(error)) return + end if + + ! Get feature name from parameter or table key + if (present(name)) then + self%name = name + else + call table%get_key(self%name) + end if + + ! Initialize common components + call init_feature_components(self, table, root=root, error=error) + if (allocated(error)) return + + ! For features, get platform configuration (optional for packages) + if (.not. present(name)) then + call get_value(table, "platform", child, requested=.false., stat=stat) + if (stat == toml_stat%success .and. associated(child)) then + call self%platform%load_from_toml(child, error) + if (allocated(error)) return + end if + end if + + end subroutine new_feature + + !> 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) + + if (size(list) < 1) then + call syntax_error(error, "Feature table is empty") + return + end if + + do ikey = 1, size(list) + select case(list(ikey)%key) + case default + call syntax_error(error, "Key "//list(ikey)%key//" is not allowed in feature table") + exit + + ! Keys + case("description", "default", "platform", "flags", "c-flags", & + "cxx-flags", "link-time-flags", "preprocessor", "requires", & + "build", "install", "fortran", "library", "dependencies", & + "dev-dependencies", "executable", "example", "test", "preprocess") + + continue + + ! OS names (lowercase) + case("linux", "macos", "windows", "cygwin", "solaris", "freebsd", "openbsd") + + continue + + ! Compiler names + case ("gfortran", "f95", "caf", "ifort", "ifx", "pgfortran", "nvfortran", "nagfor", & + "flang", "flang-new", "f18", "xlf90", "lfortran") + + continue + + ! Standard feature configuration names + case("debug", "release") + + continue + + end select + end do + + end subroutine check + + !> Construct new feature array from a TOML data structure + subroutine new_features(features, table, root, error) + + !> Instance of the feature configuration array + type(feature_config_t), allocatable, intent(out) :: features(:) + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Root directory of the manifest + character(len=*), intent(in), optional :: root + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table), pointer :: node + type(toml_key), allocatable :: list(:) + integer :: ifeature, stat + + call table%get_keys(list) + + if (size(list) < 1) then + allocate(features(0)) + return + end if + + allocate(features(size(list))) + + do ifeature = 1, size(list) + call get_value(table, list(ifeature)%key, node, stat=stat) + if (stat /= toml_stat%success) then + call fatal_error(error, "Feature "//list(ifeature)%key//" must be a table entry") + exit + end if + call new_feature(features(ifeature), node, root, error) + if (allocated(error)) exit + end do + + end subroutine new_features + + !> Find matching feature configuration (similar to find_profile) + subroutine find_feature(features, feature_name, current_platform, found, chosen_feature) + type(feature_config_t), allocatable, intent(in) :: features(:) + character(*), intent(in) :: feature_name + type(platform_config_t), intent(in) :: current_platform + logical, intent(out) :: found + type(feature_config_t), intent(out) :: chosen_feature + + integer :: i + + found = .false. + if (size(features) < 1) return + + ! Try to find exact match (feature + compiler + OS) + do i = 1, size(features) + if (features(i)%name == feature_name .and. & + features(i)%platform%matches(current_platform)) then + chosen_feature = features(i) + found = .true. + return + end if + end do + + ! Try to find compiler match with OS_ALL + do i = 1, size(features) + if (features(i)%name == feature_name .and. & + features(i)%platform%matches(current_platform)) then + chosen_feature = features(i) + found = .true. + return + end if + end do + + ! Try to find COMPILER_ALL match + do i = 1, size(features) + if (features(i)%name == feature_name .and. & + features(i)%platform%matches(current_platform)) then + chosen_feature = features(i) + found = .true. + return + end if + end do + end subroutine find_feature + + !> Write information on instance + subroutine info(self, unit, verbosity) + + !> Instance of the feature configuration + class(feature_config_t), intent(in) :: self + + !> Unit for IO + integer, intent(in) :: unit + + !> Verbosity of the printout + integer, intent(in), optional :: verbosity + + integer :: pr, ii + character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)', & + & fmti = '("#", 1x, a, t30, i0)' + + if (present(verbosity)) then + pr = verbosity + else + pr = 1 + end if + + if (pr < 1) return + + write(unit, fmt) "Feature" + if (allocated(self%name)) then + write(unit, fmt) "- name", self%name + end if + if (allocated(self%description)) then + write(unit, fmt) "- description", self%description + end if + + call self%platform%info(unit, verbosity) + + if (allocated(self%flags)) then + write(unit, fmt) "- flags", self%flags + end if + if (allocated(self%c_flags)) then + write(unit, fmt) "- c-flags", self%c_flags + end if + if (allocated(self%cxx_flags)) then + write(unit, fmt) "- cxx-flags", self%cxx_flags + end if + if (allocated(self%link_time_flags)) then + write(unit, fmt) "- link-time-flags", self%link_time_flags + end if + + if (allocated(self%build)) then + call self%build%info(unit, pr - 1) + end if + if (allocated(self%install)) then + call self%install%info(unit, pr - 1) + end if + + if (allocated(self%library)) then + write(unit, fmt) "- target", "archive" + call self%library%info(unit, pr - 1) + end if + + if (allocated(self%executable)) then + if (size(self%executable) > 1 .or. pr > 2) then + write(unit, fmti) "- executables", size(self%executable) + end if + do ii = 1, size(self%executable) + call self%executable(ii)%info(unit, pr - 1) + end do + end if + + if (allocated(self%dependency)) then + if (size(self%dependency) > 1 .or. pr > 2) then + write(unit, fmti) "- dependencies", size(self%dependency) + end if + do ii = 1, size(self%dependency) + call self%dependency(ii)%info(unit, pr - 1) + end do + end if + + end subroutine info + + !> Check that two feature configs are equal + logical function feature_is_same(this, that) + class(feature_config_t), intent(in) :: this + class(serializable_t), intent(in) :: that + + integer :: ii + + feature_is_same = .false. + + select type (other=>that) + type is (feature_config_t) + + if (allocated(this%name).neqv.allocated(other%name)) return + if (allocated(this%name)) then + if (.not.(this%name==other%name)) return + end if + + if (allocated(this%description).neqv.allocated(other%description)) return + if (allocated(this%description)) then + if (.not.(this%description==other%description)) return + end if + + if (.not.this%platform == other%platform) return + if (this%default .neqv. other%default) return + + if (allocated(this%build).neqv.allocated(other%build)) return + if (allocated(this%build)) then + if (.not.(this%build==other%build)) return + end if + + if (allocated(this%install).neqv.allocated(other%install)) return + if (allocated(this%install)) then + if (.not.(this%install==other%install)) return + end if + + if (allocated(this%fortran).neqv.allocated(other%fortran)) return + if (allocated(this%fortran)) then + if (.not.(this%fortran==other%fortran)) return + end if + + if (allocated(this%library).neqv.allocated(other%library)) return + if (allocated(this%library)) then + if (.not.(this%library==other%library)) return + end if + + if (allocated(this%executable).neqv.allocated(other%executable)) return + if (allocated(this%executable)) then + if (.not.(size(this%executable)==size(other%executable))) return + do ii = 1, size(this%executable) + if (.not.(this%executable(ii)==other%executable(ii))) return + end do + end if + + if (allocated(this%dependency).neqv.allocated(other%dependency)) return + if (allocated(this%dependency)) then + if (.not.(size(this%dependency)==size(other%dependency))) return + do ii = 1, size(this%dependency) + if (.not.(this%dependency(ii)==other%dependency(ii))) return + end do + end if + + if (allocated(this%dev_dependency).neqv.allocated(other%dev_dependency)) return + if (allocated(this%dev_dependency)) then + if (.not.(size(this%dev_dependency)==size(other%dev_dependency))) return + do ii = 1, size(this%dev_dependency) + if (.not.(this%dev_dependency(ii)==other%dev_dependency(ii))) return + end do + end if + + if (allocated(this%example).neqv.allocated(other%example)) return + if (allocated(this%example)) then + if (.not.(size(this%example)==size(other%example))) return + do ii = 1, size(this%example) + if (.not.(this%example(ii)==other%example(ii))) return + end do + end if + + if (allocated(this%test).neqv.allocated(other%test)) return + if (allocated(this%test)) then + if (.not.(size(this%test)==size(other%test))) return + do ii = 1, size(this%test) + if (.not.(this%test(ii)==other%test(ii))) return + end do + end if + + if (allocated(this%preprocess).neqv.allocated(other%preprocess)) return + if (allocated(this%preprocess)) then + if (.not.(size(this%preprocess)==size(other%preprocess))) return + do ii = 1, size(this%preprocess) + if (.not.(this%preprocess(ii)==other%preprocess(ii))) return + end do + end if + + if (allocated(this%flags).neqv.allocated(other%flags)) return + if (allocated(this%flags)) then + if (.not.(this%flags==other%flags)) return + end if + + if (allocated(this%c_flags).neqv.allocated(other%c_flags)) return + if (allocated(this%c_flags)) then + if (.not.(this%c_flags==other%c_flags)) return + end if + + if (allocated(this%cxx_flags).neqv.allocated(other%cxx_flags)) return + if (allocated(this%cxx_flags)) then + if (.not.(this%cxx_flags==other%cxx_flags)) return + end if + + if (allocated(this%link_time_flags).neqv.allocated(other%link_time_flags)) return + if (allocated(this%link_time_flags)) then + if (.not.(this%link_time_flags==other%link_time_flags)) return + end if + + if (allocated(this%requires_features).neqv.allocated(other%requires_features)) return + if (allocated(this%requires_features)) then + if (.not.(size(this%requires_features)==size(other%requires_features))) return + do ii = 1, size(this%requires_features) + if (.not.(this%requires_features(ii)==other%requires_features(ii))) return + end do + end if + + if (.not.this%meta==other%meta) return + + class default + return + end select + + feature_is_same = .true. + + end function feature_is_same + + !> Dump feature to toml table + subroutine dump_to_toml(self, table, error) + + !> Instance of the serializable object + class(feature_config_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: ii + type(toml_table), pointer :: ptr, ptr_pkg + character(30) :: unnamed + + call set_string(table, "name", self%name, error, class_name) + if (allocated(error)) return + call set_string(table, "description", self%description, error, class_name) + if (allocated(error)) return + + call set_value(table, "default", self%default, error, class_name) + if (allocated(error)) return + + call add_table(table, "platform", ptr, error, class_name) + if (allocated(error)) return + call self%platform%dump_to_toml(ptr, error) + if (allocated(error)) return + + call set_string(table, "flags", self%flags, error, class_name) + if (allocated(error)) return + call set_string(table, "c-flags", self%c_flags, error, class_name) + if (allocated(error)) return + call set_string(table, "cxx-flags", self%cxx_flags, error, class_name) + if (allocated(error)) return + call set_string(table, "link-time-flags", self%link_time_flags, error, class_name) + if (allocated(error)) return + + call set_list(table, "requires", self%requires_features, error) + if (allocated(error)) return + + if (allocated(self%build)) then + call add_table(table, "build", ptr, error, class_name) + if (allocated(error)) return + call self%build%dump_to_toml(ptr, error) + if (allocated(error)) return + end if + + if (allocated(self%install)) then + call add_table(table, "install", ptr, error, class_name) + if (allocated(error)) return + call self%install%dump_to_toml(ptr, error) + if (allocated(error)) return + end if + + if (allocated(self%fortran)) then + call add_table(table, "fortran", ptr, error, class_name) + if (allocated(error)) return + call self%fortran%dump_to_toml(ptr, error) + if (allocated(error)) return + end if + + if (allocated(self%library)) then + call add_table(table, "library", ptr, error, class_name) + if (allocated(error)) return + call self%library%dump_to_toml(ptr, error) + if (allocated(error)) return + end if + + if (allocated(self%executable)) then + call add_table(table, "executable", ptr_pkg) + if (.not. associated(ptr_pkg)) then + call fatal_error(error, class_name//" cannot create 'executable' table ") + return + end if + + do ii = 1, size(self%executable) + associate (pkg => self%executable(ii)) + + !> Because dependencies are named, fallback if this has no name + !> So, serialization will work regardless of size(self%dep) == self%ndep + + if (len_trim(pkg%name)==0) then + write(unnamed,1) 'EXECUTABLE',ii + call add_table(ptr_pkg, trim(unnamed), ptr, error, class_name//'(executable)') + else + call add_table(ptr_pkg, pkg%name, ptr, error, class_name//'(executable)') + end if + if (allocated(error)) return + call pkg%dump_to_toml(ptr, error) + if (allocated(error)) return + end associate + end do + end if + + if (allocated(self%dependency)) then + call add_table(table, "dependencies", ptr_pkg) + if (.not. associated(ptr_pkg)) then + call fatal_error(error, class_name//" cannot create 'dependencies' table ") + return + end if + + do ii = 1, size(self%dependency) + associate (pkg => self%dependency(ii)) + if (len_trim(pkg%name)==0) then + write(unnamed,1) 'DEPENDENCY',ii + call add_table(ptr_pkg, trim(unnamed), ptr, error, class_name//'(dependencies)') + else + call add_table(ptr_pkg, pkg%name, ptr, error, class_name//'(dependencies)') + end if + if (allocated(error)) return + call pkg%dump_to_toml(ptr, error) + if (allocated(error)) return + end associate + end do + end if + + if (allocated(self%example)) then + + call add_table(table, "example", ptr_pkg) + if (.not. associated(ptr_pkg)) then + call fatal_error(error, class_name//" cannot create 'example' table ") + return + end if + + do ii = 1, size(self%example) + + associate (pkg => self%example(ii)) + + !> Because dependencies are named, fallback if this has no name + !> So, serialization will work regardless of size(self%dep) == self%ndep + if (len_trim(pkg%name)==0) then + write(unnamed,1) 'EXAMPLE',ii + call add_table(ptr_pkg, trim(unnamed), ptr, error, class_name//'(example)') + else + call add_table(ptr_pkg, pkg%name, ptr, error, class_name//'(example)') + end if + if (allocated(error)) return + call pkg%dump_to_toml(ptr, error) + if (allocated(error)) return + + end associate + + end do + end if + + if (allocated(self%test)) then + + call add_table(table, "test", ptr_pkg) + if (.not. associated(ptr_pkg)) then + call fatal_error(error, class_name//" cannot create 'test' table ") + return + end if + + do ii = 1, size(self%test) + + associate (pkg => self%test(ii)) + + !> Because dependencies are named, fallback if this has no name + !> So, serialization will work regardless of size(self%dep) == self%ndep + if (len_trim(pkg%name)==0) then + write(unnamed,1) 'TEST',ii + call add_table(ptr_pkg, trim(unnamed), ptr, error, class_name//'(test)') + else + call add_table(ptr_pkg, pkg%name, ptr, error, class_name//'(test)') + end if + if (allocated(error)) return + call pkg%dump_to_toml(ptr, error) + if (allocated(error)) return + + end associate + + end do + end if + + if (allocated(self%preprocess)) then + + call add_table(table, "preprocess", ptr_pkg) + if (.not. associated(ptr_pkg)) then + call fatal_error(error, class_name//" cannot create 'preprocess' table ") + return + end if + + do ii = 1, size(self%preprocess) + + associate (pkg => self%preprocess(ii)) + + !> Because dependencies are named, fallback if this has no name + !> So, serialization will work regardless of size(self%dep) == self%ndep + if (len_trim(pkg%name)==0) then + write(unnamed,1) 'PREPROCESS',ii + call add_table(ptr_pkg, trim(unnamed), ptr, error, class_name//'(preprocess)') + else + call add_table(ptr_pkg, pkg%name, ptr, error, class_name//'(preprocess)') + end if + if (allocated(error)) return + call pkg%dump_to_toml(ptr, error) + if (allocated(error)) return + + end associate + + end do + end if + + call add_table(table, "metapackages", ptr, error, class_name) + if (allocated(error)) return + call self%meta%dump_to_toml(ptr, error) + if (allocated(error)) return + + 1 format('UNNAMED_',a,'_',i0) + + end subroutine dump_to_toml + + !> Read feature from toml table (no checks made at this stage) + subroutine load_from_toml(self, table, error) + + !> Instance of the serializable object + class(feature_config_t), intent(inout) :: self + + !> Data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_key), allocatable :: keys(:), pkg_keys(:) + integer :: ii, jj, stat + character(len=:), allocatable :: flag + type(toml_table), pointer :: ptr, ptr_pkg + + call table%get_keys(keys) + + call get_value(table, "name", self%name) + call get_value(table, "description", self%description) + + + call get_value(table, "default", self%default, default=.true., stat=stat) + if (stat/=toml_stat%success) then + call fatal_error(error, class_name//': error retrieving key') + return + end if + + call get_value(table, "flags", self%flags) + call get_value(table, "c-flags", self%c_flags) + call get_value(table, "cxx-flags", self%cxx_flags) + call get_value(table, "link-time-flags", self%link_time_flags) + + call get_list(table, "requires", self%requires_features, error) + if (allocated(error)) return + + if (allocated(self%executable)) deallocate(self%executable) + if (allocated(self%dependency)) deallocate(self%dependency) + if (allocated(self%dev_dependency)) deallocate(self%dev_dependency) + if (allocated(self%example)) deallocate(self%example) + if (allocated(self%test)) deallocate(self%test) + if (allocated(self%preprocess)) deallocate(self%preprocess) + + do ii = 1, size(keys) + select case (keys(ii)%key) + case ("platform") + + call get_value(table, keys(ii), ptr) + if (.not.associated(ptr)) then + call fatal_error(error,class_name//': error retrieving '//keys(ii)%key//' table') + return + end if + call self%platform%load_from_toml(ptr, error) + if (allocated(error)) return + + case ("build") + allocate(self%build) + call get_value(table, keys(ii), ptr) + if (.not.associated(ptr)) then + call fatal_error(error,class_name//': error retrieving '//keys(ii)%key//' table') + return + end if + call self%build%load_from_toml(ptr, error) + if (allocated(error)) return + + case ("install") + allocate(self%install) + call get_value(table, keys(ii), ptr) + if (.not.associated(ptr)) then + call fatal_error(error,class_name//': error retrieving '//keys(ii)%key//' table') + return + end if + call self%install%load_from_toml(ptr, error) + + case ("fortran") + allocate(self%fortran) + call get_value(table, keys(ii), ptr) + if (.not.associated(ptr)) then + call fatal_error(error,class_name//': error retrieving '//keys(ii)%key//' table') + return + end if + call self%fortran%load_from_toml(ptr, error) + + case ("library") + allocate(self%library) + call get_value(table, keys(ii), ptr) + if (.not.associated(ptr)) then + call fatal_error(error,class_name//': error retrieving '//keys(ii)%key//' table') + return + end if + call self%library%load_from_toml(ptr, error) + + case ("executable") + + call get_value(table, keys(ii), ptr) + if (.not.associated(ptr)) then + call fatal_error(error,class_name//': error retrieving executable table') + return + end if + + !> Read all packages + call ptr%get_keys(pkg_keys) + allocate(self%executable(size(pkg_keys))) + + do jj = 1, size(pkg_keys) + call get_value(ptr, pkg_keys(jj), ptr_pkg) + call self%executable(jj)%load_from_toml(ptr_pkg, error) + if (allocated(error)) return + end do + + case ("dependencies") + + call get_value(table, keys(ii), ptr) + if (.not.associated(ptr)) then + call fatal_error(error,class_name//': error retrieving dependency table') + return + end if + + !> Read all packages + call ptr%get_keys(pkg_keys) + allocate(self%dependency(size(pkg_keys))) + + do jj = 1, size(pkg_keys) + call get_value(ptr, pkg_keys(jj), ptr_pkg) + call self%dependency(jj)%load_from_toml(ptr_pkg, error) + if (allocated(error)) return + end do + + case ("dev-dependencies") + + call get_value(table, keys(ii), ptr) + if (.not.associated(ptr)) then + call fatal_error(error,class_name//': error retrieving dev-dependencies table') + return + end if + + !> Read all packages + call ptr%get_keys(pkg_keys) + allocate(self%dev_dependency(size(pkg_keys))) + + do jj = 1, size(pkg_keys) + call get_value(ptr, pkg_keys(jj), ptr_pkg) + call self%dev_dependency(jj)%load_from_toml(ptr_pkg, error) + if (allocated(error)) return + end do + + case ("example") + + call get_value(table, keys(ii), ptr) + if (.not.associated(ptr)) then + call fatal_error(error,class_name//': error retrieving example table') + return + end if + + !> Read all packages + call ptr%get_keys(pkg_keys) + allocate(self%example(size(pkg_keys))) + + do jj = 1, size(pkg_keys) + call get_value(ptr, pkg_keys(jj), ptr_pkg) + call self%example(jj)%load_from_toml(ptr_pkg, error) + if (allocated(error)) return + end do + + case ("test") + + call get_value(table, keys(ii), ptr) + if (.not.associated(ptr)) then + call fatal_error(error,class_name//': error retrieving test table') + return + end if + + !> Read all packages + call ptr%get_keys(pkg_keys) + allocate(self%test(size(pkg_keys))) + + do jj = 1, size(pkg_keys) + call get_value(ptr, pkg_keys(jj), ptr_pkg) + call self%test(jj)%load_from_toml(ptr_pkg, error) + if (allocated(error)) return + end do + + case ("preprocess") + + call get_value(table, keys(ii), ptr) + if (.not.associated(ptr)) then + call fatal_error(error,class_name//': error retrieving preprocess table') + return + end if + + !> Read all packages + call ptr%get_keys(pkg_keys) + allocate(self%preprocess(size(pkg_keys))) + + do jj = 1, size(pkg_keys) + call get_value(ptr, pkg_keys(jj), ptr_pkg) + call self%preprocess(jj)%load_from_toml(ptr_pkg, error) + if (allocated(error)) return + end do + + case ("metapackages") + + call get_value(table, keys(ii), ptr) + if (.not.associated(ptr)) then + call fatal_error(error,class_name//': error retrieving '//keys(ii)%key//' table') + return + end if + call self%meta%load_from_toml(ptr, error) + + case default + cycle + end select + end do + + end subroutine load_from_toml + + + !> Initialize the feature components (shared between new_feature and new_package) + subroutine init_feature_components(self, table, platform, root, error) + type(feature_config_t), intent(inout) :: self + type(toml_table), intent(inout) :: table + type(platform_config_t), optional, intent(in) :: platform + character(len=*), intent(in), optional :: root + type(error_t), allocatable, intent(out) :: error + + type(toml_table), pointer :: child, node + type(toml_array), pointer :: children + integer :: ii, nn, stat + + ! Initialize platform with defaults + if (present(platform)) then + self%platform = platform + else + self%platform = platform_config_t(id_all,OS_ALL) + end if + + ! Get description and default flag + call get_value(table, "description", self%description) + call get_value(table, "default", self%default, .false.) + + ! Get compiler flags + call get_value(table, "flags", self%flags) + call get_value(table, "c-flags", self%c_flags) + call get_value(table, "cxx-flags", self%cxx_flags) + call get_value(table, "link-time-flags", self%link_time_flags) + + ! Get feature dependencies + call get_list(table, "requires", self%requires_features, error) + if (allocated(error)) return + + ! Get build configuration + call get_value(table, "build", child, requested=.false., stat=stat) + if (stat == toml_stat%success .and. associated(child)) then + allocate(self%build) + call new_build_config(self%build, child, self%name, error) + if (allocated(error)) return + end if + + ! Get install configuration + call get_value(table, "install", child, requested=.false., stat=stat) + if (stat == toml_stat%success .and. associated(child)) then + allocate(self%install) + call new_install_config(self%install, child, error) + if (allocated(error)) return + end if + + ! Get Fortran configuration + call get_value(table, "fortran", child, requested=.false., stat=stat) + if (stat == toml_stat%success .and. associated(child)) then + allocate(self%fortran) + call new_fortran_config(self%fortran, child, error) + if (allocated(error)) return + end if + + ! Get library configuration + call get_value(table, "library", child, requested=.false.) + if (associated(child)) then + allocate(self%library) + call new_library(self%library, child, error) + if (allocated(error)) return + end if + + ! Get dependencies and metapackage dependencies + call get_value(table, "dependencies", child, requested=.false.) + if (associated(child)) then + call new_dependencies(self%dependency, child, root, self%meta, error=error) + if (allocated(error)) return + end if + + ! Get development dependencies + call get_value(table, "dev-dependencies", child, requested=.false.) + if (associated(child)) then + call new_dependencies(self%dev_dependency, child, root, error=error) + if (allocated(error)) return + end if + + ! Get executables + call get_value(table, "executable", children, requested=.false.) + if (associated(children)) then + nn = len(children) + allocate(self%executable(nn)) + do ii = 1, nn + call get_value(children, ii, node, stat=stat) + if (stat /= toml_stat%success) then + call fatal_error(error, "Could not retrieve executable from array entry") + exit + end if + call new_executable(self%executable(ii), node, error) + if (allocated(error)) exit + end do + if (allocated(error)) return + end if + + ! Get examples + call get_value(table, "example", children, requested=.false.) + if (associated(children)) then + nn = len(children) + allocate(self%example(nn)) + do ii = 1, nn + call get_value(children, ii, node, stat=stat) + if (stat /= toml_stat%success) then + call fatal_error(error, "Could not retrieve example from array entry") + exit + end if + call new_example(self%example(ii), node, error) + if (allocated(error)) exit + end do + if (allocated(error)) return + end if + + ! Get tests + call get_value(table, "test", children, requested=.false.) + if (associated(children)) then + nn = len(children) + allocate(self%test(nn)) + do ii = 1, nn + call get_value(children, ii, node, stat=stat) + if (stat /= toml_stat%success) then + call fatal_error(error, "Could not retrieve test from array entry") + exit + end if + call new_test(self%test(ii), node, error) + if (allocated(error)) exit + end do + if (allocated(error)) return + end if + + ! Get preprocessors + call get_value(table, "preprocess", child, requested=.false.) + if (associated(child)) then + call new_preprocessors(self%preprocess, child, error) + if (allocated(error)) return + end if + + ! Validate unique program names + if (allocated(self%executable)) then + call unique_programs(self%executable, error) + if (allocated(error)) return + end if + + if (allocated(self%example)) then + call unique_programs(self%example, error) + if (allocated(error)) return + + if (allocated(self%executable)) then + call unique_programs(self%executable, self%example, error) + if (allocated(error)) return + end if + end if + + if (allocated(self%test)) then + call unique_programs(self%test, error) + if (allocated(error)) return + end if + + end subroutine init_feature_components + + !> Check whether or not the names in a set of executables are unique + subroutine unique_programs1(executable, error) + + !> Array of executables + class(executable_config_t), intent(in) :: executable(:) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: i, j + + do i = 1, size(executable) + do j = 1, i - 1 + if (executable(i)%name == executable(j)%name) then + call fatal_error(error, "The program named '"//& + executable(j)%name//"' is duplicated. "//& + "Unique program names are required.") + exit + end if + end do + end do + if (allocated(error)) return + + end subroutine unique_programs1 + + + !> Check whether or not the names in a set of executables are unique + subroutine unique_programs2(executable_i, executable_j, error) + + !> Array of executables + class(executable_config_t), intent(in) :: executable_i(:) + + !> Array of executables + class(executable_config_t), intent(in) :: executable_j(:) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: i, j + + do i = 1, size(executable_i) + do j = 1, size(executable_j) + if (executable_i(i)%name == executable_j(j)%name) then + call fatal_error(error, "The program named '"//& + executable_j(j)%name//"' is duplicated. "//& + "Unique program names are required.") + exit + end if + end do + end do + if (allocated(error)) return + + end subroutine unique_programs2 + + !> Return a name string as it would appear in the TOML manifest + function manifest_name(self) result(name) + class(feature_config_t), intent(in) :: self + character(:), allocatable :: name + + character(:), allocatable :: platform + + platform = self%platform%name() + + if (len(platform)>0) then + name = self%name//'.'//platform + else + name = self%name + end if + + end function manifest_name + +end module fpm_manifest_feature diff --git a/src/fpm/manifest/feature_collection.f90 b/src/fpm/manifest/feature_collection.f90 new file mode 100644 index 0000000000..8069b54e49 --- /dev/null +++ b/src/fpm/manifest/feature_collection.f90 @@ -0,0 +1,1058 @@ + +module fpm_manifest_feature_collection + use fpm_manifest_feature, only: feature_config_t, new_feature, init_feature_components + use fpm_manifest_platform, only: platform_config_t, is_platform_key + use fpm_manifest_dependency, only: dependency_config_t + use fpm_manifest_example, only: example_config_t + use fpm_manifest_executable, only: executable_config_t + use fpm_manifest_metapackages, only: metapackage_config_t, metapackage_request_t + use fpm_manifest_test, only: test_config_t + use fpm_manifest_preprocess, only: preprocess_config_t + use fpm_error, only: error_t, fatal_error, syntax_error + use fpm_environment, only: OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, OS_CYGWIN, OS_SOLARIS, & + OS_FREEBSD, OS_OPENBSD, OS_ALL, match_os_type, OS_NAME + use fpm_compiler, only: compiler_enum, compiler_id_name, match_compiler_type, & + id_unknown, id_gcc, id_f95, id_caf, & + 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_lahey, id_lfortran, id_all + use fpm_strings, only: string_t, lower, operator(==), split, str + use tomlf, only: toml_table, toml_array, toml_key, toml_stat + use fpm_toml, only: get_value, len, serializable_t, set_value, set_string, set_list, add_table, & + get_list + implicit none + private + + public :: new_collections, get_default_features, & + get_default_features_as_features, default_debug_feature, default_release_feature + + !> Feature configuration data + type, public, extends(serializable_t) :: feature_collection_t + + ! Features shared by all platforms, all compilers + type(feature_config_t) :: base + + ! Features shared by specific platform/compiler configurations + type(feature_config_t), allocatable :: variants(:) + + contains + + procedure :: serializable_is_same => feature_collection_same + procedure :: dump_to_toml => feature_collection_dump + procedure :: load_from_toml => feature_collection_load + + procedure :: push_variant + procedure :: extract_for_target + procedure :: check => check_collection + + end type feature_collection_t + + contains + + !> Equality (semantic): base and variants (size + element-wise) + logical function feature_collection_same(this, that) + class(feature_collection_t), intent(in) :: this + class(serializable_t), intent(in) :: that + integer :: i + + feature_collection_same = .false. + select type (other => that) + type is (feature_collection_t) + if (.not.(this%base == other%base)) return + if (allocated(this%variants) .neqv. allocated(other%variants)) return + if (allocated(this%variants)) then + if (size(this%variants) /= size(other%variants)) return + do i = 1, size(this%variants) + if (.not.(this%variants(i) == other%variants(i))) return + end do + end if + class default + return + end select + feature_collection_same = .true. + end function feature_collection_same + + !> Serialize: base as a subtable; variants under a "variants" table + subroutine feature_collection_dump(self, table, error) + class(feature_collection_t), intent(inout) :: self + type(toml_table), intent(inout) :: table + type(error_t), allocatable, intent(out) :: error + + type(toml_table), pointer :: ptr_base, ptr_vars, ptr + integer :: i + character(len=32) :: key + + ! base + call add_table(table, "base", ptr_base) + if (.not. associated(ptr_base)) then + call fatal_error(error, "feature_collection_t: cannot create 'base' table"); return + end if + call self%base%dump_to_toml(ptr_base, error); if (allocated(error)) return + + ! variants (optional) + if (allocated(self%variants)) then + call add_table(table, "variants", ptr_vars) + if (.not. associated(ptr_vars)) then + call fatal_error(error, "feature_collection_t: cannot create 'variants' table"); return + end if + do i = 1, size(self%variants) + write(key, '("variant_", i0)') i + call add_table(ptr_vars, trim(key), ptr) + if (.not. associated(ptr)) then + call fatal_error(error, "feature_collection_t: cannot create entry for "//trim(key)); return + end if + call self%variants(i)%dump_to_toml(ptr, error); if (allocated(error)) return + end do + end if + end subroutine feature_collection_dump + + !> Deserialize: read base; then any number of variants under "variants" + subroutine feature_collection_load(self, table, error) + class(feature_collection_t), intent(inout) :: self + type(toml_table), intent(inout) :: table + type(error_t), allocatable, intent(out) :: error + + type(toml_table), pointer :: ptr_base, ptr_vars, ptr + type(toml_key), allocatable :: keys(:) + integer :: i + + ! base (required) + call get_value(table, "base", ptr_base) + if (.not. associated(ptr_base)) then + call fatal_error(error, "feature_collection_t: missing 'base' table"); return + end if + call self%base%load_from_toml(ptr_base, error); if (allocated(error)) return + + ! variants (optional) + call get_value(table, "variants", ptr_vars) + if (.not. associated(ptr_vars)) then + if (allocated(self%variants)) deallocate(self%variants) + return + end if + + call ptr_vars%get_keys(keys) + if (allocated(self%variants)) deallocate(self%variants) + allocate(self%variants(size(keys))) + + do i = 1, size(keys) + call get_value(ptr_vars, keys(i), ptr) + if (.not. associated(ptr)) then + call fatal_error(error, "feature_collection_t: invalid variant entry '" & + //keys(i)%key//"'"); return + end if + call self%variants(i)%load_from_toml(ptr, error); if (allocated(error)) return + end do + end subroutine feature_collection_load + + ! helper: append a variant to self%variants + elemental subroutine push_variant(self,variant) + class(feature_collection_t), intent(inout) :: self + type(feature_config_t), intent(in) :: variant + + + type(feature_config_t), allocatable :: tmp(:) + + integer :: n + + if (.not. allocated(self%variants)) then + allocate(self%variants(1), source=variant) + else + n = size(self%variants) + allocate(tmp(n+1)) + if (n>0) tmp(1:n) = self%variants + tmp(n+1) = variant + call move_alloc(tmp, self%variants) + end if + end subroutine push_variant + + logical function is_compiler_key(s) + character(*), intent(in) :: s + is_compiler_key = match_compiler_type(s) /= id_unknown + end function is_compiler_key + + logical function is_os_key(s) + character(*), intent(in) :: s + is_os_key = match_os_type(s) /= OS_UNKNOWN + end function is_os_key + + !> Initialize multiple feature collections from manifest features table + subroutine new_collections(collections, table, error) + type(feature_collection_t), allocatable, intent(out) :: collections(:) + type(toml_table), intent(inout) :: table + type(error_t), allocatable, intent(out) :: error + + type(toml_key), allocatable :: keys(:) + type(toml_table), pointer :: feature_table + integer :: i, stat + + ! Get all top-level feature names from the features table + call table%get_keys(keys) + + if (size(keys) == 0) then + ! No features defined, return default collections + call get_default_features(collections, error) + return + end if + + ! Create one collection per top-level feature name + allocate(collections(size(keys))) + + do i = 1, size(keys) + ! Get the subtable for this feature + call get_value(table, keys(i)%key, feature_table, stat=stat) + if (stat /= toml_stat%success) then + call fatal_error(error, "Could not retrieve feature table for '"//keys(i)%key//"'") + return + end if + + ! Create collection from this feature's subtable + call new_collection_from_subtable(collections(i), feature_table, keys(i)%key, error) + if (allocated(error)) return + + end do + + end subroutine new_collections + + !> Create a feature collection from a TOML subtable by traversing the hierarchy + !> Supports flexible configurations like: + !> [features] + !> name.os.compiler.* = ... # specific compiler + OS + !> name.compiler.* = ... # all OS, specific compiler + !> name.os.* = ... # specific OS, all compilers + !> name.* = ... # base feature (all OS, all compilers) + subroutine new_collection_from_subtable(self, table, name, error) + type(feature_collection_t), intent(out) :: self + type(toml_table), intent(inout) :: table + character(*), intent(in) :: name + type(error_t), allocatable, intent(out) :: error + + integer :: i + type(platform_config_t) :: default_platform + type(toml_key), allocatable :: keys(:) + + default_platform = platform_config_t(id_all,OS_ALL) + + ! Initialize base feature + self%base%name = name + self%base%platform = default_platform + + ! Traverse the table hierarchy to find variants + call traverse_feature_table(self, table, name, default_platform, error) + if (allocated(error)) return + + ! Check collection + call self%check(error) + if (allocated(error)) return + + end subroutine new_collection_from_subtable + + !> Recursively traverse a feature table to find variants + recursive subroutine traverse_feature_table(collection, table, feature_name, & + constraint, error) + type(feature_collection_t), intent(inout) :: collection + type(toml_table), intent(inout) :: table + character(*), intent(in) :: feature_name + type(platform_config_t), intent(in) :: constraint + type(error_t), allocatable, intent(out) :: error + + type(toml_key), allocatable :: keys(:) + type(toml_table), pointer :: subtable + character(len=:), allocatable :: value_str + integer :: i, stat, os_type, compiler_type + type(feature_config_t) :: feature_variant + type(platform_config_t) :: platform + logical :: has_platform_keys, has_feature_data + + call table%get_keys(keys) + has_platform_keys = .false. + has_feature_data = .false. + + ! First pass: check what types of keys we have + do i = 1, size(keys) + + ! Check if this key is a valid OS name + os_type = match_os_type(keys(i)%key) + if (os_type /= OS_UNKNOWN) then + has_platform_keys = .true. + cycle + end if + + ! Check if this key is a valid compiler name + compiler_type = match_compiler_type(keys(i)%key) + if (compiler_type /= id_unknown) then + has_platform_keys = .true. + cycle + end if + + ! This is a feature specification (like "flags" or "preprocess") + has_feature_data = .true. + + ! No compiler/OS flags can appear in feature specification branches + if (is_platform_key(keys(i)%key)) then + call fatal_error(error, "Key '"//keys(i)%key//"' is not allowed in feature table") + return + end if + + end do + + ! If we have platform keys, traverse them + if (has_platform_keys) then + do i = 1, size(keys) + ! 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 + call get_value(table, keys(i)%key, subtable, stat=stat) + if (stat == toml_stat%success) then + platform = platform_config_t(constraint%compiler,os_type) + call traverse_feature_table(collection, subtable, feature_name, & + platform, error) + if (allocated(error)) return + end if + cycle + end if + + ! Check if this key is a compiler name + compiler_type = match_compiler_type(keys(i)%key) + if (compiler_type /= id_unknown) then + ! 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 + platform = platform_config_t(compiler_type,constraint%os_type) + call traverse_feature_table(collection, subtable, feature_name, & + platform, error) + if (allocated(error)) return + end if + cycle + end if + end do + end if + + ! If we found feature data at this level (no more platform keys), initialize feature components + if (has_feature_data) then + + ! Initialize a new feature variant + feature_variant%name = feature_name + + ! Check that the table is right + call feature_variant%check(table, error) + if (allocated(error)) return + + call init_feature_components(feature_variant, table, constraint, error=error) + if (allocated(error)) return + + if (constraint%any_platform()) then + ! This is a base feature specification + call merge_feature_configs(collection%base, feature_variant, error) + if (allocated(error)) return + else + ! This is a constrained variant + call collection%push_variant(feature_variant) + end if + end if + + ! If this is the root table and we haven't processed any feature data yet, + ! call init_feature_components on the base feature (may be empty) + if (constraint%any_platform() .and. .not.(has_platform_keys.or.has_feature_data)) then + + ! Check that the table is right + call feature_variant%check(table, error) + if (allocated(error)) return + + ! Initialize base feature components from empty or root table + call init_feature_components(collection%base, table, error=error) + if (allocated(error)) return + end if + + end subroutine traverse_feature_table + + !> Merge two feature configurations using standardized rules: + !> - String properties (flags): concatenate with spaces (additive) + !> - Array properties: append arrays (additive) + !> - Allocatable properties: source overwrites target if target not allocated (conflict if both allocated) + !> - Metapackages: OR logic - turn on any that are requested (additive) + subroutine merge_feature_configs(target, source, error) + type(feature_config_t), intent(inout) :: target + type(feature_config_t), intent(in) :: source + type(error_t), allocatable, intent(out) :: error + + ! Check for allocatable property conflicts (should be caught by validation, but double-check) + if (allocated(target%build) .and. allocated(source%build)) then + call fatal_error(error, "build configuration can only be specified in one feature variant") + return + end if + + if (allocated(target%install) .and. allocated(source%install)) then + call fatal_error(error, "install configuration can only be specified in one feature variant") + return + end if + + if (allocated(target%fortran) .and. allocated(source%fortran)) then + call fatal_error(error, "fortran configuration can only be specified in one feature variant") + return + end if + + if (allocated(target%library) .and. allocated(source%library)) then + call fatal_error(error, "library configuration can only be specified in one feature variant") + return + end if + + ! Merge simple string fields - source takes precedence if target doesn't have one + if (allocated(source%description) .and. .not. allocated(target%description)) then + target%description = source%description + end if + + ! ADDITIVE: String properties (flags) - concatenate with spaces + call merge_string_additive(target%flags, source%flags) + call merge_string_additive(target%c_flags, source%c_flags) + call merge_string_additive(target%cxx_flags, source%cxx_flags) + call merge_string_additive(target%link_time_flags, source%link_time_flags) + + ! ALLOCATABLE: Only set if target doesn't have it (conflicts checked above) + if (allocated(source%build) .and. .not. allocated(target%build)) then + allocate(target%build) + target%build = source%build + end if + + if (allocated(source%install) .and. .not. allocated(target%install)) then + allocate(target%install) + target%install = source%install + end if + + if (allocated(source%fortran) .and. .not. allocated(target%fortran)) then + allocate(target%fortran) + target%fortran = source%fortran + end if + + if (allocated(source%library) .and. .not. allocated(target%library)) then + allocate(target%library) + target%library = source%library + 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_preprocess_arrays(target%preprocess, source%preprocess) + call merge_string_arrays(target%requires_features, source%requires_features) + + ! ADDITIVE: Metapackages - OR logic (if either requests it, turn it on) + call merge_metapackages(target%meta, source%meta) + + end subroutine merge_feature_configs + + !> Merge executable arrays by appending source to target + subroutine merge_executable_arrays(target, source) + type(executable_config_t), allocatable, intent(inout) :: target(:) + type(executable_config_t), allocatable, intent(in) :: source(:) + + type(executable_config_t), allocatable :: temp(:) + integer :: target_size, source_size + + if (.not. allocated(source)) return + + source_size = size(source) + if (source_size == 0) return + + if (.not. allocated(target)) then + allocate(target(source_size), source=source) + else + target_size = size(target) + allocate(temp(target_size + source_size)) + temp(1:target_size) = target + temp(target_size+1:target_size+source_size) = source + call move_alloc(temp, target) + end if + + end subroutine merge_executable_arrays + + !> Merge dependency arrays by appending source to target + subroutine merge_dependency_arrays(target, source) + type(dependency_config_t), allocatable, intent(inout) :: target(:) + type(dependency_config_t), allocatable, intent(in) :: source(:) + + type(dependency_config_t), allocatable :: temp(:) + integer :: target_size, source_size + + if (.not. allocated(source)) return + + source_size = size(source) + if (source_size == 0) return + + if (.not. allocated(target)) then + allocate(target(source_size), source=source) + else + target_size = size(target) + allocate(temp(target_size + source_size)) + temp(1:target_size) = target + temp(target_size+1:target_size+source_size) = source + call move_alloc(temp, target) + end if + + end subroutine merge_dependency_arrays + + !> Merge string properties additively by concatenating with space + subroutine merge_string_additive(target, source) + character(len=:), allocatable, intent(inout) :: target + character(len=:), allocatable, intent(in) :: source + + if (allocated(source)) then + if (allocated(target)) then + target = trim(target) // " " // trim(source) + else + target = source + end if + end if + end subroutine merge_string_additive + + !> Merge example arrays by appending source to target + subroutine merge_example_arrays(target, source) + type(example_config_t), allocatable, intent(inout) :: target(:) + type(example_config_t), allocatable, intent(in) :: source(:) + + type(example_config_t), allocatable :: temp(:) + integer :: target_size, source_size + + if (.not. allocated(source)) return + + source_size = size(source) + if (source_size == 0) return + + if (.not. allocated(target)) then + allocate(target(source_size), source=source) + else + target_size = size(target) + allocate(temp(target_size + source_size)) + temp(1:target_size) = target + temp(target_size+1:target_size+source_size) = source + call move_alloc(temp, target) + end if + end subroutine merge_example_arrays + + !> Merge test arrays by appending source to target + subroutine merge_test_arrays(target, source) + type(test_config_t), allocatable, intent(inout) :: target(:) + type(test_config_t), allocatable, intent(in) :: source(:) + + type(test_config_t), allocatable :: temp(:) + integer :: target_size, source_size + + if (.not. allocated(source)) return + + source_size = size(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)) + temp(1:target_size) = target + temp(target_size+1:target_size+source_size) = source + call move_alloc(temp, target) + end if + end subroutine merge_test_arrays + + !> Merge preprocess arrays by appending source to target + 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 + + if (.not. allocated(source)) return + + source_size = size(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)) + temp(1:target_size) = target + temp(target_size+1:target_size+source_size) = source + call move_alloc(temp, target) + end if + end subroutine merge_preprocess_arrays + + !> Merge string arrays by appending source to target + subroutine merge_string_arrays(target, source) + type(string_t), allocatable, intent(inout) :: target(:) + type(string_t), allocatable, intent(in) :: source(:) + + type(string_t), allocatable :: temp(:) + integer :: target_size, source_size + + if (.not. allocated(source)) return + + source_size = size(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)) + temp(1:target_size) = target + temp(target_size+1:target_size+source_size) = source + call move_alloc(temp, target) + end if + end subroutine merge_string_arrays + + !> Merge metapackages using OR logic - if either requests it, turn it on + subroutine merge_metapackages_additive(target, source) + type(metapackage_request_t), intent(inout) :: target + type(metapackage_request_t), intent(in) :: source + + ! OR logic: if either requests a metapackage, turn it on + if (source%on) then + target%on = .true. + ! Use source version if target doesn't have one + if (allocated(source%version) .and. .not. allocated(target%version)) then + target%version = source%version + end if + end if + + end subroutine merge_metapackages_additive + + !> Merge whole metapackage config + subroutine merge_metapackages(target, source) + type(metapackage_config_t), intent(inout) :: target + type(metapackage_config_t), intent(in) :: source + + call merge_metapackages_additive(target%openmp,source%openmp) + call merge_metapackages_additive(target%stdlib,source%stdlib) + call merge_metapackages_additive(target%minpack,source%minpack) + call merge_metapackages_additive(target%mpi,source%mpi) + call merge_metapackages_additive(target%hdf5,source%hdf5) + call merge_metapackages_additive(target%netcdf,source%netcdf) + call merge_metapackages_additive(target%blas,source%blas) + + end subroutine merge_metapackages + + !> Create default debug feature collection + function default_debug_feature() result(collection) + type(feature_collection_t) :: collection + + ! Initialize base feature with debug settings + collection%base%name = 'debug' + collection%base%platform%compiler = id_all + collection%base%platform%os_type = OS_ALL + collection%base%default = .true. + + ! Add debug variants for different compilers + call collection%push_variant(default_variant('debug', id_caf, OS_ALL, & + ' -Wall -Wextra -Wimplicit-interface -Wno-external-argument-mismatch& + & -fPIC -fmax-errors=1 -g -fcheck=bounds& + & -fcheck=array-temps -fbacktrace')) + + call collection%push_variant(default_variant('debug', id_gcc, OS_ALL, & + ' -Wall -Wextra -Wimplicit-interface -Wno-external-argument-mismatch& + & -fPIC -fmax-errors=1 -g -fcheck=bounds& + & -fcheck=array-temps -fbacktrace -fcoarray=single')) + + call collection%push_variant(default_variant('debug', id_f95, OS_ALL, & + ' -Wall -Wextra -Wimplicit-interface -Wno-external-argument-mismatch& + & -fPIC -fmax-errors=1 -g -fcheck=bounds& + & -fcheck=array-temps -Wno-maybe-uninitialized -Wno-uninitialized -fbacktrace')) + + call collection%push_variant(default_variant('debug', id_nvhpc, OS_ALL, & + ' -Minform=inform -Mbackslash -g -Mbounds -Mchkptr -Mchkstk -traceback')) + + call collection%push_variant(default_variant('debug', id_intel_classic_nix, OS_ALL, & + ' -warn all -check all -error-limit 1 -O0 -g -assume byterecl -traceback')) + + call collection%push_variant(default_variant('debug', id_intel_classic_nix, OS_WINDOWS, & + ' /warn:all /check:all /error-limit:1& + & /Od /Z7 /assume:byterecl /traceback')) + + call collection%push_variant(default_variant('debug', id_intel_llvm_nix, OS_ALL, & + ' -warn all -check all -error-limit 1 -O0 -g -assume byterecl -traceback')) + + call collection%push_variant(default_variant('debug', id_intel_llvm_nix, OS_WINDOWS, & + ' /warn:all /check:all /error-limit:1 /Od /Z7 /assume:byterecl')) + + call collection%push_variant(default_variant('debug', id_lfortran, OS_ALL, '')) + + end function default_debug_feature + + !> Create default release feature collection + function default_release_feature() result(collection) + type(feature_collection_t) :: collection + + ! Initialize base feature with release settings + collection%base%name = 'release' + collection%base%platform%compiler = id_all + collection%base%platform%os_type = OS_ALL + collection%base%default = .true. + + ! Add release variants for different compilers + call collection%push_variant(default_variant('release', id_caf, OS_ALL, & + ' -O3 -Wimplicit-interface -fPIC -fmax-errors=1 -funroll-loops')) + + call collection%push_variant(default_variant('release', id_gcc, OS_ALL, & + ' -O3 -Wimplicit-interface -fPIC -fmax-errors=1 -funroll-loops -fcoarray=single')) + + call collection%push_variant(default_variant('release', id_f95, OS_ALL, & + ' -O3 -Wimplicit-interface -fPIC -fmax-errors=1 -ffast-math -funroll-loops')) + + call collection%push_variant(default_variant('release', id_nvhpc, OS_ALL, & + ' -Mbackslash')) + + call collection%push_variant(default_variant('release', id_intel_classic_nix, OS_LINUX, & + ' -fp-model precise -pc64 -align all -error-limit 1 -reentrancy& + & threaded -nogen-interfaces -assume byterecl')) + + call collection%push_variant(default_variant('release', id_intel_classic_windows, & + OS_WINDOWS, ' /fp:precise /align:all /error-limit:1 /reentrancy:threaded& + & /nogen-interfaces /assume:byterecl')) + + call collection%push_variant(default_variant('release', id_intel_llvm_nix, & + OS_LINUX, ' -fp-model=precise -pc64 -align all -error-limit 1 -reentrancy threaded& + & -nogen-interfaces -assume byterecl')) + + call collection%push_variant(default_variant('release', id_intel_llvm_nix, & + OS_WINDOWS, ' /fp:precise /align:all /error-limit:1 /reentrancy:threaded& + & /nogen-interfaces /assume:byterecl')) + + call collection%push_variant(default_variant('release', id_nag, OS_ALL, & + ' -O4 -coarray=single -PIC')) + + call collection%push_variant(default_variant('release', id_lfortran, OS_ALL, & + ' flag_lfortran_opt')) + + end function default_release_feature + + !> Get default feature collections (debug and release) + subroutine get_default_features(collections, error) + + !> Feature collections array to populate (debug and release) + type(feature_collection_t), allocatable, intent(out) :: collections(:) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + ! Allocate array for debug and release collections + allocate(collections(2)) + + ! Create debug and release collections + collections(1) = default_debug_feature() + collections(2) = default_release_feature() + + 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 + integer(compiler_enum), intent(in) :: compiler_id + integer, intent(in) :: os_type + character(len=*), intent(in) :: flags + type(feature_config_t) :: feature + + feature%name = name + feature%platform%compiler = compiler_id + feature%platform%os_type = os_type + feature%flags = flags + feature%default = .true. ! These are built-in features + end function default_variant + + + !> Check that the collection has valid OS/compiler logic and can be merged safely + !> Implements standardized feature hierarchy validation: + !> 1. OS_all+id_all (base) → id_compiler+OS_all → id_all+OS_current → id_compiler+OS_current + !> 2. Additive properties (flags) can be concatenated + !> 3. Allocatable properties can only exist in one variant per merge path + subroutine check_collection(self, error) + class(feature_collection_t), intent(in) :: self + type(error_t), allocatable, intent(out) :: error + + integer :: i, j + + ! Check base feature has valid platform settings + if (self%base%platform%os_type == OS_UNKNOWN) then + call fatal_error(error, "Base feature '"//self%base%name//"' has invalid OS type") + return + end if + + if (self%base%platform%compiler == id_unknown) then + call fatal_error(error, "Base feature '"//self%base%name//"' has invalid compiler type") + return + end if + + ! Base feature must be OS_ALL + id_all for proper hierarchy + if (self%base%platform%os_type /= OS_ALL .or. self%base%platform%compiler /= id_all) then + call fatal_error(error, "Base feature '"//self%base%name// & + "' must have OS_ALL and id_all platform settings") + return + end if + + ! Check all variants have valid platform settings and hierarchy rules + if (allocated(self%variants)) then + do i = 1, size(self%variants) + ! Validate OS and compiler settings + if (self%variants(i)%platform%os_type == OS_UNKNOWN) then + call fatal_error(error, "Variant "//trim(str(i))//" of feature '" & + //self%base%name//"' has invalid OS type") + return + end if + + if (self%variants(i)%platform%compiler == id_unknown) then + call fatal_error(error, "Variant "//trim(str(i))//" of feature '" & + //self%base%name//"' has invalid compiler type") + return + end if + + ! Check that variant name matches base name + if (allocated(self%variants(i)%name) .and. allocated(self%base%name)) then + if (self%variants(i)%name /= self%base%name) then + call fatal_error(error, "Variant "//trim(str(i))//" name '" & + //self%variants(i)%name// & + "' does not match base name '"//self%base%name//"'") + return + end if + end if + + ! Validate feature hierarchy rules + call validate_variant_hierarchy(self%variants(i), i, error) + if (allocated(error)) return + + ! Check for exact duplicate platforms + do j = i + 1, size(self%variants) + if (self%variants(i)%platform == self%variants(j)%platform) then + call fatal_error(error, "Duplicate platform configurations: "// & + self%variants(i)%manifest_name()// & + " and "//self%variants(j)%manifest_name()) + return + end if + end do + end do + + ! Check for conflicts between variants that could be applied together + call check_merge_conflicts(self, error) + if (allocated(error)) return + end if + + end subroutine check_collection + + !> Validate that a variant follows the feature hierarchy rules + !> Valid combinations: + !> - id_compiler + OS_all (compiler-specific, all OS) + !> - id_all + OS_specific (OS-specific, all compilers) + !> - id_compiler + OS_specific (target-specific) + !> Note: id_all + OS_all variants are allowed during parsing but should be merged into base + subroutine validate_variant_hierarchy(variant, index, error) + type(feature_config_t), intent(in) :: variant + integer, intent(in) :: index + type(error_t), allocatable, intent(out) :: error + + ! For now, allow all combinations - the merge logic handles id_all + OS_ALL -> base + ! The validation was too strict for current parsing logic + ! TODO: Implement stricter validation after parsing is fixed + + ! All combinations are valid in the hierarchy: + ! - id_all + OS_all (should be merged to base, but parsing might create these temporarily) + ! - id_compiler + OS_all (compiler-specific) + ! - id_all + OS_specific (OS-specific) + ! - id_compiler + OS_specific (target-specific) + + end subroutine validate_variant_hierarchy + + !> Check for merge conflicts between variants that could be applied together + !> This validates that no two applicable variants have conflicting allocatable properties + subroutine check_merge_conflicts(collection, error) + class(feature_collection_t), intent(in) :: collection + type(error_t), allocatable, intent(out) :: error + + integer :: i, j + type(feature_config_t) :: merged_feature + integer, parameter :: test_compilers(3) = [id_gcc, id_flang, id_intel_classic_nix] + integer, parameter :: test_oses(3) = [OS_LINUX, OS_WINDOWS, OS_MACOS] + integer :: comp_idx, os_idx + + ! Test merge conflicts for common compiler/OS combinations + do comp_idx = 1, size(test_compilers) + do os_idx = 1, size(test_oses) + + ! Start with base feature + merged_feature = collection%base + + ! Try to merge all applicable variants for this target + if (allocated(collection%variants)) then + do i = 1, size(collection%variants) + if (variant_applies_to_target(collection%variants(i), & + test_compilers(comp_idx), test_oses(os_idx))) then + + ! Check for allocatable property conflicts before merging + call check_single_merge_conflict(merged_feature, collection%variants(i), & + test_compilers(comp_idx), test_oses(os_idx), error) + if (allocated(error)) return + + ! Simulate the merge (without error checking since we just checked) + call simulate_merge(merged_feature, collection%variants(i)) + end if + end do + end if + end do + end do + end subroutine check_merge_conflicts + + !> Check if a variant applies to the given target compiler and OS + logical function variant_applies_to_target(variant, target_compiler, target_os) + type(feature_config_t), intent(in) :: variant + integer, intent(in) :: target_compiler, target_os + + ! A variant applies if: + ! - Compiler matches or is id_all + ! - OS matches or is OS_ALL + variant_applies_to_target = & + (variant%platform%compiler == target_compiler .or. variant%platform%compiler == id_all) .and. & + (variant%platform%os_type == target_os .or. variant%platform%os_type == OS_ALL) + end function variant_applies_to_target + + !> Check for conflicts between two features that would be merged + subroutine check_single_merge_conflict(target, source, compiler_id, os_id, error) + type(feature_config_t), intent(in) :: target, source + integer, intent(in) :: compiler_id, os_id + type(error_t), allocatable, intent(out) :: error + + character(len=:), allocatable :: compiler, os + + compiler = compiler_id_name(compiler_id) + os = OS_NAME(os_id) + + if (allocated(target%build) .and. allocated(source%build)) then + call fatal_error(error, "Feature '"//target%name//"' has conflicting build configurations for "// & + compiler//"+"//os//": both base/variants specify build settings") + return + end if + + if (allocated(target%install) .and. allocated(source%install)) then + call fatal_error(error, "Feature '"//target%name//"' has conflicting install configurations for "// & + compiler//"+"//os//": both base/variants specify install settings") + return + end if + + if (allocated(target%fortran) .and. allocated(source%fortran)) then + call fatal_error(error, "Feature '"//target%name//"' has conflicting fortran configurations for "// & + compiler//"+"//os//": both base/variants specify fortran settings") + return + end if + + if (allocated(target%library) .and. allocated(source%library)) then + call fatal_error(error, "Feature '"//target%name//"' has conflicting library configurations for "// & + compiler//"+"//os//": both base/variants specify library settings") + return + end if + end subroutine check_single_merge_conflict + + !> Simulate merging source into target for conflict checking (without error handling) + subroutine simulate_merge(target, source) + type(feature_config_t), intent(inout) :: target + type(feature_config_t), intent(in) :: source + + ! Only merge allocatable properties if target doesn't have them + ! (conflicts should have been caught by check_single_merge_conflict) + + if (allocated(source%build) .and. .not. allocated(target%build)) then + allocate(target%build) + target%build = source%build + end if + + if (allocated(source%install) .and. .not. allocated(target%install)) then + allocate(target%install) + target%install = source%install + end if + + if (allocated(source%fortran) .and. .not. allocated(target%fortran)) then + allocate(target%fortran) + target%fortran = source%fortran + end if + + if (allocated(source%library) .and. .not. allocated(target%library)) then + allocate(target%library) + target%library = source%library + end if + end subroutine simulate_merge + + !> Extract a merged feature configuration for the given target platform + function extract_for_target(self, target) result(feature) + class(feature_collection_t), intent(in) :: self + type(platform_config_t), intent(in) :: target + type(feature_config_t) :: feature + + integer :: i + type(error_t), allocatable :: error + + ! Start with base feature as foundation + feature = self%base + + ! Apply matching variants on top of base + if (allocated(self%variants)) then + do i = 1, size(self%variants) + 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 + end if + end do + end if + + end function extract_for_target + +end module fpm_manifest_feature_collection diff --git a/src/fpm/manifest/fortran.f90 b/src/fpm/manifest/fortran.f90 index 5236aa0f5a..383487e1cd 100644 --- a/src/fpm/manifest/fortran.f90 +++ b/src/fpm/manifest/fortran.f90 @@ -5,7 +5,7 @@ module fpm_manifest_fortran implicit none private - public :: fortran_config_t, new_fortran_config + public :: fortran_config_t, new_fortran_config, default_fortran_config !> Configuration data for Fortran type, extends(serializable_t) :: fortran_config_t @@ -20,18 +20,28 @@ module fpm_manifest_fortran character(:), allocatable :: source_form contains - + !> Serialization interface procedure :: serializable_is_same => fortran_is_same procedure :: dump_to_toml procedure :: load_from_toml - + end type fortran_config_t character(len=*), parameter, private :: class_name = 'fortran_config_t' contains + !> Initialize fortran config + subroutine default_fortran_config(self) + type(fortran_config_t), intent(inout) :: self + + self%implicit_external = .false. + self%implicit_typing = .false. + self%source_form = 'free' + + end subroutine default_fortran_config + !> Construct a new build configuration from a TOML data structure subroutine new_fortran_config(self, table, error) diff --git a/src/fpm/manifest/meta.f90 b/src/fpm/manifest/meta.f90 index 3ed451090c..50d8d667a3 100644 --- a/src/fpm/manifest/meta.f90 +++ b/src/fpm/manifest/meta.f90 @@ -9,9 +9,9 @@ !>stdlib = bool !>``` module fpm_manifest_metapackages - use fpm_error, only: error_t, fatal_error, syntax_error - use tomlf, only : toml_table, toml_key, toml_stat - use fpm_toml, only : get_value + use fpm_error, only: error_t, fatal_error, syntax_error + use tomlf, only: toml_table, toml_key + use fpm_toml, only: get_value, set_value, set_string, add_table, serializable_t use fpm_environment implicit none private @@ -19,9 +19,8 @@ module fpm_manifest_metapackages public :: metapackage_config_t, new_meta_config, is_meta_package public :: metapackage_request_t, new_meta_request - !> Configuration data for a single metapackage request - type :: metapackage_request_t + type, extends(serializable_t) :: metapackage_request_t !> Request flag logical :: on = .false. @@ -32,11 +31,17 @@ module fpm_manifest_metapackages !> Version Specification string character(len=:), allocatable :: version + contains + + procedure :: serializable_is_same => meta_request_same + procedure :: dump_to_toml => meta_request_dump + procedure :: load_from_toml => meta_request_load + end type metapackage_request_t !> Configuration data for metapackages - type :: metapackage_config_t + type, extends(serializable_t) :: metapackage_config_t !> Request MPI support type(metapackage_request_t) :: mpi @@ -62,7 +67,12 @@ module fpm_manifest_metapackages contains procedure :: get_requests + final :: meta_config_final + procedure :: serializable_is_same => meta_config_same + procedure :: dump_to_toml => meta_config_dump + procedure :: load_from_toml => meta_config_load + end type metapackage_config_t @@ -70,22 +80,18 @@ module fpm_manifest_metapackages !> Destroy a metapackage request elemental subroutine request_destroy(self) - - !> Instance of the request class(metapackage_request_t), intent(inout) :: self - self%on = .false. if (allocated(self%version)) deallocate(self%version) - if (allocated(self%name)) deallocate(self%name) - + if (allocated(self%name)) deallocate(self%name) end subroutine request_destroy !> Parse version string of a metapackage request subroutine request_parse(self, version_request, error) - + ! Instance of this metapackage type(metapackage_request_t), intent(inout) :: self - + ! Parse version request character(len=*), intent(in) :: version_request @@ -94,11 +100,11 @@ subroutine request_parse(self, version_request, error) ! wildcard = use any versions if (version_request=="*") then - + ! Any version is OK self%on = .true. self%version = version_request - + else call fatal_error(error,'Value <'//version_request//'> for metapackage '//self%name//& @@ -111,7 +117,6 @@ end subroutine request_parse !> Construct a new metapackage request from the dependencies table subroutine new_meta_request(self, key, table, meta_allowed, error) - type(metapackage_request_t), intent(out) :: self !> The package name @@ -126,8 +131,7 @@ subroutine new_meta_request(self, key, table, meta_allowed, error) !> Error handling type(error_t), allocatable, intent(out) :: error - - integer :: stat,i + integer :: i character(len=:), allocatable :: value logical, allocatable :: allow_meta(:) type(toml_key), allocatable :: keys(:) @@ -141,12 +145,8 @@ subroutine new_meta_request(self, key, table, meta_allowed, error) return end if - !> The toml table is not checked here because it already passed - !> the "new_dependencies" check - call table%get_keys(keys) - !> Set list of entries that are allowed to be metapackages if (present(meta_allowed)) then if (size(meta_allowed)/=size(keys)) then call fatal_error(error,"Internal error: list of metapackage-enable entries does not match table size") @@ -157,12 +157,8 @@ subroutine new_meta_request(self, key, table, meta_allowed, error) allocate(allow_meta(size(keys)),source=.true.) endif - do i=1,size(keys) - - ! Skip standard dependencies if (.not.allow_meta(i)) cycle - if (keys(i)%key==key) then call get_value(table, key, value) if (.not. allocated(value)) then @@ -174,10 +170,7 @@ subroutine new_meta_request(self, key, table, meta_allowed, error) endif end if end do - - ! Key is not present, metapackage not requested - return - + ! If we reach here, key not present => request remains off end subroutine new_meta_request !> Construct a new build configuration from a TOML data structure @@ -219,83 +212,224 @@ subroutine new_meta_config(self, table, meta_allowed, error) call new_meta_request(self%blas, "blas", table, meta_allowed, error) if (allocated(error)) return - + end subroutine new_meta_config - + !> Check local schema for allowed entries logical function is_meta_package(key) - - !> Instance of the TOML data structure character(*), intent(in) :: key - select case (key) - - !> Supported metapackages case ("openmp","stdlib","mpi","minpack","hdf5","netcdf","blas") is_meta_package = .true. - case default is_meta_package = .false. - end select - end function is_meta_package - + !> Return a list of metapackages requested for the current build function get_requests(meta) result(requests) - - !> Instance of the build configuration class(metapackage_config_t), intent(in) :: meta - - !> The list of requested metapackages (always allocated) type(metapackage_request_t), allocatable :: requests(:) - integer :: nreq - !> Count requests - nreq = 0 - if (meta%mpi%on) nreq = nreq + 1 - if (meta%openmp%on) nreq = nreq + 1 - if (meta%stdlib%on) nreq = nreq + 1 - if (meta%minpack%on) nreq = nreq + 1 - if (meta%hdf5%on) nreq = nreq + 1 - if (meta%netcdf%on) nreq = nreq + 1 - if (meta%blas%on) nreq = nreq + 1 - - !> Prepare requests + nreq = count([ meta%mpi%on, & + meta%openmp%on, & + meta%stdlib%on, & + meta%minpack%on, & + meta%hdf5%on, & + meta%netcdf%on, & + meta%blas%on ]) + allocate(requests(nreq)); if (nreq <= 0) return nreq = 0 - if (meta%mpi%on) then - nreq = nreq + 1 - requests(nreq) = meta%mpi + call add_if_active(meta%mpi ,requests,nreq) + call add_if_active(meta%openmp ,requests,nreq) + call add_if_active(meta%stdlib ,requests,nreq) + call add_if_active(meta%minpack,requests,nreq) + call add_if_active(meta%hdf5 ,requests,nreq) + call add_if_active(meta%netcdf ,requests,nreq) + call add_if_active(meta%blas ,requests,nreq) + + contains + + subroutine add_if_active(req,list,count) + type(metapackage_request_t), intent(in) :: req + type(metapackage_request_t), intent(inout) :: list(:) + integer, intent(inout) :: count + if (.not.req%on) return + count = count+1 + list(count) = req + end subroutine add_if_active + + end function get_requests + + logical function meta_request_same(this, that) + class(metapackage_request_t), intent(in) :: this + class(serializable_t), intent(in) :: that + + meta_request_same = .false. + select type (other => that) + type is (metapackage_request_t) + if (this%on .neqv. other%on) return + if (allocated(this%name) .neqv. allocated(other%name)) return + if (allocated(this%version).neqv. allocated(other%version))return + if (allocated(this%name)) then; if (this%name /= other%name) return; end if + if (allocated(this%version)) then; if (this%version/= other%version)return; end if + class default + return + end select + meta_request_same = .true. + end function meta_request_same + + subroutine meta_request_dump(self, table, error) + class(metapackage_request_t), intent(inout) :: self + type(toml_table), intent(inout) :: table + type(error_t), allocatable, intent(out) :: error + + call set_value (table, "on", self%on, error, 'metapackage_request_t') + if (allocated(error)) return + + call set_string(table, "name", self%name, error) + if (allocated(error)) return + + call set_string(table, "version", self%version,error) + if (allocated(error)) return + end subroutine meta_request_dump + + subroutine meta_request_load(self, table, error) + class(metapackage_request_t), intent(inout) :: self + type(toml_table), intent(inout) :: table + type(error_t), allocatable, intent(out) :: error + + call get_value(table, "on", self%on) + call get_value(table, "name", self%name) + call get_value(table, "version", self%version) + + end subroutine meta_request_load + + logical function meta_config_same(this, that) + class(metapackage_config_t), intent(in) :: this + class(serializable_t), intent(in) :: that + + meta_config_same = .false. + select type (other => that) + type is (metapackage_config_t) + + if (.not. this%mpi == other%mpi) return + if (.not. this%openmp == other%openmp) return + if (.not. this%stdlib == other%stdlib) return + if (.not. this%minpack == other%minpack)return + if (.not. this%hdf5 == other%hdf5) return + if (.not. this%netcdf == other%netcdf) return + if (.not. this%blas == other%blas) return + + meta_config_same = .true. + + class default + return + end select + + end function meta_config_same + + subroutine meta_config_dump(self, table, error) + class(metapackage_config_t), intent(inout) :: self + type(toml_table), intent(inout) :: table + type(error_t), allocatable, intent(out) :: error + + type(toml_table), pointer :: ptr + + ! openmp + call add_table(table, "openmp", ptr); if (.not.associated(ptr)) then + call fatal_error(error, "metapackage_config_t: cannot create 'openmp' table"); return end if - if (meta%openmp%on) then - nreq = nreq + 1 - requests(nreq) = meta%openmp + call self%openmp%dump_to_toml(ptr, error); if (allocated(error)) return + + ! stdlib + call add_table(table, "stdlib", ptr); if (.not.associated(ptr)) then + call fatal_error(error, "metapackage_config_t: cannot create 'stdlib' table"); return end if - if (meta%stdlib%on) then - nreq = nreq + 1 - requests(nreq) = meta%stdlib + call self%stdlib%dump_to_toml(ptr, error); if (allocated(error)) return + + ! minpack + call add_table(table, "minpack", ptr); if (.not.associated(ptr)) then + call fatal_error(error, "metapackage_config_t: cannot create 'minpack' table"); return end if - if (meta%minpack%on) then - nreq = nreq + 1 - requests(nreq) = meta%minpack + call self%minpack%dump_to_toml(ptr, error); if (allocated(error)) return + + ! mpi + call add_table(table, "mpi", ptr); if (.not.associated(ptr)) then + call fatal_error(error, "metapackage_config_t: cannot create 'mpi' table"); return end if - if (meta%hdf5%on) then - nreq = nreq + 1 - requests(nreq) = meta%hdf5 + call self%mpi%dump_to_toml(ptr, error); if (allocated(error)) return + + ! hdf5 + call add_table(table, "hdf5", ptr); if (.not.associated(ptr)) then + call fatal_error(error, "metapackage_config_t: cannot create 'hdf5' table"); return end if - if (meta%netcdf%on) then - nreq = nreq + 1 - requests(nreq) = meta%netcdf + call self%hdf5%dump_to_toml(ptr, error); if (allocated(error)) return + + ! netcdf + call add_table(table, "netcdf", ptr); if (.not.associated(ptr)) then + call fatal_error(error, "metapackage_config_t: cannot create 'netcdf' table"); return end if - if (meta%blas%on) then - nreq = nreq + 1 - requests(nreq) = meta%blas + call self%netcdf%dump_to_toml(ptr, error); if (allocated(error)) return + + ! blas + call add_table(table, "blas", ptr); if (.not.associated(ptr)) then + call fatal_error(error, "metapackage_config_t: cannot create 'blas' table"); return end if + call self%blas%dump_to_toml(ptr, error); if (allocated(error)) return + 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 + + call request_destroy(self%openmp); self%openmp%name = "openmp" + call request_destroy(self%stdlib); self%stdlib%name = "stdlib" + call request_destroy(self%minpack);self%minpack%name= "minpack" + call request_destroy(self%mpi); self%mpi%name = "mpi" + call request_destroy(self%hdf5); self%hdf5%name = "hdf5" + call request_destroy(self%netcdf); self%netcdf%name = "netcdf" + call request_destroy(self%blas); self%blas%name = "blas" + + end subroutine meta_config_final - end function get_requests + subroutine meta_config_load(self, table, error) + class(metapackage_config_t), intent(inout) :: self + type(toml_table), intent(inout) :: table + type(error_t), allocatable, intent(out) :: error + + type(toml_table), pointer :: ptr + + ! openmp + call get_value(table, "openmp", ptr) + if (associated(ptr)) call self%openmp%load_from_toml(ptr, error); if (allocated(error)) return + + ! stdlib + call get_value(table, "stdlib", ptr) + if (associated(ptr)) call self%stdlib%load_from_toml(ptr, error); if (allocated(error)) return + + ! minpack + call get_value(table, "minpack", ptr) + if (associated(ptr)) call self%minpack%load_from_toml(ptr, error); if (allocated(error)) return + + ! mpi + call get_value(table, "mpi", ptr) + if (associated(ptr)) call self%mpi%load_from_toml(ptr, error); if (allocated(error)) return + + ! hdf5 + call get_value(table, "hdf5", ptr) + if (associated(ptr)) call self%hdf5%load_from_toml(ptr, error); if (allocated(error)) return + + ! netcdf + call get_value(table, "netcdf", ptr) + if (associated(ptr)) call self%netcdf%load_from_toml(ptr, error); if (allocated(error)) return + ! blas + call get_value(table, "blas", ptr) + if (associated(ptr)) call self%blas%load_from_toml(ptr, error); if (allocated(error)) return + end subroutine meta_config_load end module fpm_manifest_metapackages diff --git a/src/fpm/manifest/package.f90 b/src/fpm/manifest/package.f90 index 126cc591eb..624e519a23 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 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 @@ -44,81 +44,45 @@ module fpm_manifest_package use fpm_manifest_install, only: install_config_t, new_install_config use fpm_manifest_test, only : test_config_t, new_test use fpm_manifest_preprocess, only : preprocess_config_t, new_preprocessors - use fpm_manifest_metapackages, only: metapackage_config_t, new_meta_config + 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_platform, only: platform_config_t + use fpm_strings, only: string_t use fpm_filesystem, only : exists, getline, join_path use fpm_error, only : error_t, fatal_error, syntax_error, bad_name_error use tomlf, only : toml_table, toml_array, toml_key, toml_stat use fpm_toml, only : get_value, len, serializable_t, set_value, set_string, set_list, add_table use fpm_versioning, only : version_t, new_version + implicit none private public :: package_config_t, new_package - - interface unique_programs - module procedure :: unique_programs1 - module procedure :: unique_programs2 - end interface unique_programs - - !> Package meta data - type, extends(serializable_t) :: package_config_t + !> Package configuration data - extends a `feature_config_t` to represent the "default" + !> package feature. The following are now inherited from feature_config_t: name (but for package + !> it's the package name), description, compiler, os_type (defaults to id_all, OS_ALL for packages) + !> library, executable(:), dependency(:), dev_dependency(:), example(:), test(:), preprocess(:) + !> flags, c_flags, cxx_flags, link_time_flags, requires_features(:) - !> Name of the package - character(len=:), allocatable :: name + type, extends(feature_config_t) :: package_config_t - !> Package version + !> Package version (name is inherited from feature_config_t%name) type(version_t) :: version - !> Build configuration data - type(build_config_t) :: build - - !> Metapackage data - type(metapackage_config_t) :: meta - - !> Installation configuration data - type(install_config_t) :: install - - !> Fortran meta data - type(fortran_config_t) :: fortran - - !> License meta data + !> Package metadata (package-specific) character(len=:), allocatable :: license - - !> Author meta data character(len=:), allocatable :: author - - !> Maintainer meta data character(len=:), allocatable :: maintainer - - !> Copyright meta data character(len=:), allocatable :: copyright - !> Library meta data - type(library_config_t), allocatable :: library - - !> Executable meta data - type(executable_config_t), allocatable :: executable(:) + !> Additional feature collections beyond the default package feature + type(feature_collection_t), allocatable :: features(:) - !> Dependency meta data - type(dependency_config_t), allocatable :: dependency(:) - - !> Development dependency meta data - type(dependency_config_t), allocatable :: dev_dependency(:) - - !> Profiles meta data + !> Profiles (collections of features) type(profile_config_t), allocatable :: profiles(:) - !> Example meta data - type(example_config_t), allocatable :: example(:) - - !> Test meta data - type(test_config_t), allocatable :: test(:) - - !> Preprocess meta data - type(preprocess_config_t), allocatable :: preprocess(:) - contains !> Print information on this instance @@ -129,6 +93,9 @@ module fpm_manifest_package procedure :: dump_to_toml procedure :: load_from_toml + !> Export package configuration with features applied + procedure :: export_config + end type package_config_t character(len=*), parameter, private :: class_name = 'package_config_t' @@ -164,19 +131,13 @@ subroutine new_package(self, table, root, error) call check(table, error) if (allocated(error)) return + ! Get package name and perform validation call get_value(table, "name", self%name) if (.not.allocated(self%name)) then call syntax_error(error, "Could not retrieve package name") return end if - if (bad_name_error(error,'package',self%name))then - return - endif - - call get_value(table, "license", self%license) - call get_value(table, "author", self%author) - call get_value(table, "maintainer", self%maintainer) - call get_value(table, "copyright", self%copyright) + if (bad_name_error(error,'package',self%name)) return if (len(self%name) <= 0) then call syntax_error(error, "Package name must be a non-empty string") @@ -189,28 +150,14 @@ subroutine new_package(self, table, root, error) return end if - call get_value(table, "build", child, requested=.true., stat=stat) - if (stat /= toml_stat%success) then - call fatal_error(error, "Type mismatch for build entry, must be a table") - return - end if - call new_build_config(self%build, child, self%name, error) - if (allocated(error)) return - - call get_value(table, "install", child, requested=.true., stat=stat) - if (stat /= toml_stat%success) then - call fatal_error(error, "Type mismatch for install entry, must be a table") - return - end if - call new_install_config(self%install, child, error) - if (allocated(error)) return + ! Get package-specific metadata + call get_value(table, "license", self%license) + call get_value(table, "author", self%author) + call get_value(table, "maintainer", self%maintainer) + call get_value(table, "copyright", self%copyright) - call get_value(table, "fortran", child, requested=.true., stat=stat) - if (stat /= toml_stat%success) then - call fatal_error(error, "Type mismatch for fortran entry, must be a table") - return - end if - call new_fortran_config(self%fortran, child, error) + ! Initialize shared feature components + call init_feature_components(self%feature_config_t, table, root=root, error=error) if (allocated(error)) return call get_value(table, "version", version, "0") @@ -236,101 +183,26 @@ subroutine new_package(self, table, root, error) end if if (allocated(error)) return - call get_value(table, "dependencies", child, requested=.false.) - if (associated(child)) then - call new_dependencies(self%dependency, child, root, self%meta, error) - if (allocated(error)) return - end if - - call get_value(table, "dev-dependencies", child, requested=.false.) - if (associated(child)) then - call new_dependencies(self%dev_dependency, child, root, error=error) - if (allocated(error)) return - end if - - call get_value(table, "library", child, requested=.false.) - if (associated(child)) then - allocate(self%library) - call new_library(self%library, child, error) - if (allocated(error)) return - end if - call get_value(table, "profiles", child, requested=.false.) if (associated(child)) then call new_profiles(self%profiles, child, error) if (allocated(error)) return else - self%profiles = get_default_profiles(error) - if (allocated(error)) return - end if - - call get_value(table, "executable", children, requested=.false.) - if (associated(children)) then - nn = len(children) - allocate(self%executable(nn)) - do ii = 1, nn - call get_value(children, ii, node, stat=stat) - if (stat /= toml_stat%success) then - call fatal_error(error, "Could not retrieve executable from array entry") - exit - end if - call new_executable(self%executable(ii), node, error) - if (allocated(error)) exit - end do - if (allocated(error)) return - - call unique_programs(self%executable, error) - if (allocated(error)) return - end if - - call get_value(table, "example", children, requested=.false.) - if (associated(children)) then - nn = len(children) - allocate(self%example(nn)) - do ii = 1, nn - call get_value(children, ii, node, stat=stat) - if (stat /= toml_stat%success) then - call fatal_error(error, "Could not retrieve example from array entry") - exit - end if - call new_example(self%example(ii), node, error) - if (allocated(error)) exit - end do - if (allocated(error)) return - - call unique_programs(self%example, error) - if (allocated(error)) return - - if (allocated(self%executable)) then - call unique_programs(self%executable, self%example, error) - if (allocated(error)) return - end if + ! Leave profiles unallocated for now + allocate(self%profiles(0)) end if - call get_value(table, "test", children, requested=.false.) - if (associated(children)) then - nn = len(children) - allocate(self%test(nn)) - do ii = 1, nn - call get_value(children, ii, node, stat=stat) - if (stat /= toml_stat%success) then - call fatal_error(error, "Could not retrieve test from array entry") - exit - end if - call new_test(self%test(ii), node, error) - if (allocated(error)) exit - end do + call get_value(table, "features", child, requested=.false.) + if (associated(child)) then + ! Parse features from manifest using new_collections + call new_collections(self%features, child, error) if (allocated(error)) return - - call unique_programs(self%test, error) + else + ! Initialize with default feature collections (debug and release) + call get_default_features(self%features, error) if (allocated(error)) return end if - call get_value(table, "preprocess", child, requested=.false.) - if (associated(child)) then - call new_preprocessors(self%preprocess, child, error) - if (allocated(error)) return - end if end subroutine new_package @@ -367,7 +239,7 @@ subroutine check(table, error) case("version", "license", "author", "maintainer", "copyright", & & "description", "keywords", "categories", "homepage", "build", & - & "dependencies", "dev-dependencies", "profiles", "test", "executable", & + & "dependencies", "dev-dependencies", "profiles", "features", "test", "executable", & & "example", "library", "install", "extra", "preprocess", "fortran") continue @@ -477,59 +349,6 @@ subroutine info(self, unit, verbosity) end subroutine info - !> Check whether or not the names in a set of executables are unique - subroutine unique_programs1(executable, error) - - !> Array of executables - class(executable_config_t), intent(in) :: executable(:) - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - integer :: i, j - - do i = 1, size(executable) - do j = 1, i - 1 - if (executable(i)%name == executable(j)%name) then - call fatal_error(error, "The program named '"//& - executable(j)%name//"' is duplicated. "//& - "Unique program names are required.") - exit - end if - end do - end do - if (allocated(error)) return - - end subroutine unique_programs1 - - - !> Check whether or not the names in a set of executables are unique - subroutine unique_programs2(executable_i, executable_j, error) - - !> Array of executables - class(executable_config_t), intent(in) :: executable_i(:) - - !> Array of executables - class(executable_config_t), intent(in) :: executable_j(:) - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - integer :: i, j - - do i = 1, size(executable_i) - do j = 1, size(executable_j) - if (executable_i(i)%name == executable_j(j)%name) then - call fatal_error(error, "The program named '"//& - executable_j(j)%name//"' is duplicated. "//& - "Unique program names are required.") - exit - end if - end do - end do - if (allocated(error)) return - - end subroutine unique_programs2 logical function manifest_is_same(this,that) class(package_config_t), intent(in) :: this @@ -541,14 +360,12 @@ logical function manifest_is_same(this,that) select type (other=>that) type is (package_config_t) - if (allocated(this%name).neqv.allocated(other%name)) return - if (allocated(this%name) .and. allocated(other%name)) then - if (.not.this%name==other%name) return - end if + + ! Compare base fields + if (.not.this%feature_config_t==other%feature_config_t) return + + ! Manifest-specific fields if (.not.this%version==other%version) return - if (.not.this%build==other%build) return - if (.not.this%install==other%install) return - if (.not.this%fortran==other%fortran) return if (allocated(this%license).neqv.allocated(other%license)) return if (allocated(this%license)) then if (.not.this%license==other%license) return @@ -565,31 +382,6 @@ logical function manifest_is_same(this,that) if (allocated(this%copyright)) then if (.not.this%copyright==other%copyright) return end if - if (allocated(this%library).neqv.allocated(other%library)) return - if (allocated(this%library)) then - if (.not.this%library==other%library) return - endif - if (allocated(this%executable).neqv.allocated(other%executable)) return - if (allocated(this%executable)) then - if (.not.size(this%executable)==size(other%executable)) return - do ii=1,size(this%executable) - if (.not.this%executable(ii)==other%executable(ii)) return - end do - end if - if (allocated(this%dependency).neqv.allocated(other%dependency)) return - if (allocated(this%dependency)) then - if (.not.size(this%dependency)==size(other%dependency)) return - do ii=1,size(this%dependency) - if (.not.this%dependency(ii)==other%dependency(ii)) return - end do - end if - if (allocated(this%dev_dependency).neqv.allocated(other%dev_dependency)) return - if (allocated(this%dev_dependency)) then - if (.not.size(this%dev_dependency)==size(other%dev_dependency)) return - do ii=1,size(this%dev_dependency) - if (.not.this%dev_dependency(ii)==other%dev_dependency(ii)) return - end do - end if if (allocated(this%profiles).neqv.allocated(other%profiles)) return if (allocated(this%profiles)) then if (.not.size(this%profiles)==size(other%profiles)) return @@ -597,27 +389,6 @@ logical function manifest_is_same(this,that) if (.not.this%profiles(ii)==other%profiles(ii)) return end do end if - if (allocated(this%example).neqv.allocated(other%example)) return - if (allocated(this%example)) then - if (.not.size(this%example)==size(other%example)) return - do ii=1,size(this%example) - if (.not.this%example(ii)==other%example(ii)) return - end do - end if - if (allocated(this%preprocess).neqv.allocated(other%preprocess)) return - if (allocated(this%preprocess)) then - if (.not.size(this%preprocess)==size(other%preprocess)) return - do ii=1,size(this%preprocess) - if (.not.this%preprocess(ii)==other%preprocess(ii)) return - end do - end if - if (allocated(this%test).neqv.allocated(other%test)) return - if (allocated(this%test)) then - if (.not.size(this%test)==size(other%test)) return - do ii=1,size(this%test) - if (.not.this%test(ii)==other%test(ii)) return - end do - end if class default ! Not the same type @@ -645,9 +416,12 @@ subroutine dump_to_toml(self, table, error) type(toml_table), pointer :: ptr,ptr_pkg character(30) :: unnamed character(128) :: profile_name - - call set_string(table, "name", self%name, error, class_name) + + ! Dump feature first + call self%feature_config_t%dump_to_toml(table, error) if (allocated(error)) return + + ! Package-specific fields call set_string(table, "version", self%version%s(), error, class_name) if (allocated(error)) return call set_string(table, "license", self%license, error, class_name) @@ -659,115 +433,6 @@ subroutine dump_to_toml(self, table, error) call set_string(table, "copyright", self%copyright, error, class_name) if (allocated(error)) return - call add_table(table, "build", ptr, error, class_name) - if (allocated(error)) return - call self%build%dump_to_toml(ptr, error) - if (allocated(error)) return - - call add_table(table, "fortran", ptr, error, class_name) - if (allocated(error)) return - call self%fortran%dump_to_toml(ptr, error) - if (allocated(error)) return - - call add_table(table, "install", ptr, error, class_name) - if (allocated(error)) return - call self%install%dump_to_toml(ptr, error) - if (allocated(error)) return - - if (allocated(self%library)) then - call add_table(table, "library", ptr, error, class_name) - if (allocated(error)) return - call self%library%dump_to_toml(ptr, error) - if (allocated(error)) return - end if - - if (allocated(self%executable)) then - - call add_table(table, "executable", ptr_pkg) - if (.not. associated(ptr_pkg)) then - call fatal_error(error, class_name//" cannot create 'executable' table ") - return - end if - - do ii = 1, size(self%executable) - - associate (pkg => self%executable(ii)) - - !> Because dependencies are named, fallback if this has no name - !> So, serialization will work regardless of size(self%dep) == self%ndep - if (len_trim(pkg%name)==0) then - write(unnamed,1) 'EXECUTABLE',ii - call add_table(ptr_pkg, trim(unnamed), ptr, error, class_name//'(executable)') - else - call add_table(ptr_pkg, pkg%name, ptr, error, class_name//'(executable)') - end if - if (allocated(error)) return - call pkg%dump_to_toml(ptr, error) - if (allocated(error)) return - - end associate - - end do - end if - - if (allocated(self%dependency)) then - - call add_table(table, "dependencies", ptr_pkg) - if (.not. associated(ptr_pkg)) then - call fatal_error(error, class_name//" cannot create 'dependencies' table ") - return - end if - - do ii = 1, size(self%dependency) - - associate (pkg => self%dependency(ii)) - - !> Because dependencies are named, fallback if this has no name - !> So, serialization will work regardless of size(self%dep) == self%ndep - if (len_trim(pkg%name)==0) then - write(unnamed,1) 'DEPENDENCY',ii - call add_table(ptr_pkg, trim(unnamed), ptr, error, class_name//'(dependencies)') - else - call add_table(ptr_pkg, pkg%name, ptr, error, class_name//'(dependencies)') - end if - if (allocated(error)) return - call pkg%dump_to_toml(ptr, error) - if (allocated(error)) return - - end associate - - end do - end if - - if (allocated(self%dev_dependency)) then - - call add_table(table, "dev-dependencies", ptr_pkg) - if (.not. associated(ptr_pkg)) then - call fatal_error(error, class_name//" cannot create 'dev-dependencies' table ") - return - end if - - do ii = 1, size(self%dev_dependency) - - associate (pkg => self%dev_dependency(ii)) - - !> Because dependencies are named, fallback if this has no name - !> So, serialization will work regardless of size(self%dep) == self%ndep - if (len_trim(pkg%name)==0) then - write(unnamed,1) 'DEV-DEPENDENCY',ii - call add_table(ptr_pkg, trim(unnamed), ptr, error, class_name//'(dev-dependencies)') - else - call add_table(ptr_pkg, pkg%name, ptr, error, class_name//'(dev-dependencies)') - end if - if (allocated(error)) return - call pkg%dump_to_toml(ptr, error) - if (allocated(error)) return - - end associate - - end do - end if - if (allocated(self%profiles)) then call add_table(table, "profiles", ptr_pkg) @@ -793,93 +458,6 @@ subroutine dump_to_toml(self, table, error) end do end if - if (allocated(self%example)) then - - call add_table(table, "example", ptr_pkg) - if (.not. associated(ptr_pkg)) then - call fatal_error(error, class_name//" cannot create 'example' table ") - return - end if - - do ii = 1, size(self%example) - - associate (pkg => self%example(ii)) - - !> Because dependencies are named, fallback if this has no name - !> So, serialization will work regardless of size(self%dep) == self%ndep - if (len_trim(pkg%name)==0) then - write(unnamed,1) 'EXAMPLE',ii - call add_table(ptr_pkg, trim(unnamed), ptr, error, class_name//'(example)') - else - call add_table(ptr_pkg, pkg%name, ptr, error, class_name//'(example)') - end if - if (allocated(error)) return - call pkg%dump_to_toml(ptr, error) - if (allocated(error)) return - - end associate - - end do - end if - - if (allocated(self%test)) then - - call add_table(table, "test", ptr_pkg) - if (.not. associated(ptr_pkg)) then - call fatal_error(error, class_name//" cannot create 'test' table ") - return - end if - - do ii = 1, size(self%test) - - associate (pkg => self%test(ii)) - - !> Because dependencies are named, fallback if this has no name - !> So, serialization will work regardless of size(self%dep) == self%ndep - if (len_trim(pkg%name)==0) then - write(unnamed,1) 'TEST',ii - call add_table(ptr_pkg, trim(unnamed), ptr, error, class_name//'(test)') - else - call add_table(ptr_pkg, pkg%name, ptr, error, class_name//'(test)') - end if - if (allocated(error)) return - call pkg%dump_to_toml(ptr, error) - if (allocated(error)) return - - end associate - - end do - end if - - if (allocated(self%preprocess)) then - - call add_table(table, "preprocess", ptr_pkg) - if (.not. associated(ptr_pkg)) then - call fatal_error(error, class_name//" cannot create 'preprocess' table ") - return - end if - - do ii = 1, size(self%preprocess) - - associate (pkg => self%preprocess(ii)) - - !> Because dependencies are named, fallback if this has no name - !> So, serialization will work regardless of size(self%dep) == self%ndep - if (len_trim(pkg%name)==0) then - write(unnamed,1) 'PREPROCESS',ii - call add_table(ptr_pkg, trim(unnamed), ptr, error, class_name//'(preprocess)') - else - call add_table(ptr_pkg, pkg%name, ptr, error, class_name//'(preprocess)') - end if - if (allocated(error)) return - call pkg%dump_to_toml(ptr, error) - if (allocated(error)) return - - end associate - - end do - end if - 1 format('UNNAMED_',a,'_',i0) 2 format('PROFILE_',i0) @@ -901,10 +479,23 @@ subroutine load_from_toml(self, table, error) integer :: ii, jj character(len=:), allocatable :: flag type(toml_table), pointer :: ptr,ptr_pkg + + ! Clean state + if (allocated(self%library)) deallocate(self%library) + if (allocated(self%executable)) deallocate(self%executable) + if (allocated(self%dependency)) deallocate(self%dependency) + if (allocated(self%dev_dependency)) deallocate(self%dev_dependency) + if (allocated(self%profiles)) deallocate(self%profiles) + if (allocated(self%example)) deallocate(self%example) + if (allocated(self%test)) deallocate(self%test) + if (allocated(self%preprocess)) deallocate(self%preprocess) + + !> Load base fields + call self%feature_config_t%load_from_toml(table, error) + if (allocated(error)) return call table%get_keys(keys) - call get_value(table, "name", self%name) call get_value(table, "license", self%license) call get_value(table, "author", self%author) call get_value(table, "maintainer", self%maintainer) @@ -916,105 +507,9 @@ subroutine load_from_toml(self, table, error) return endif - if (allocated(self%library)) deallocate(self%library) - if (allocated(self%executable)) deallocate(self%executable) - if (allocated(self%dependency)) deallocate(self%dependency) - if (allocated(self%dev_dependency)) deallocate(self%dev_dependency) - if (allocated(self%profiles)) deallocate(self%profiles) - if (allocated(self%example)) deallocate(self%example) - if (allocated(self%test)) deallocate(self%test) - if (allocated(self%preprocess)) deallocate(self%preprocess) sub_deps: do ii = 1, size(keys) select case (keys(ii)%key) - case ("build") - call get_value(table, keys(ii), ptr) - if (.not.associated(ptr)) then - call fatal_error(error,class_name//': error retrieving '//keys(ii)%key//' table') - return - end if - call self%build%load_from_toml(ptr, error) - if (allocated(error)) return - - case ("install") - call get_value(table, keys(ii), ptr) - if (.not.associated(ptr)) then - call fatal_error(error,class_name//': error retrieving '//keys(ii)%key//' table') - return - end if - call self%install%load_from_toml(ptr, error) - - case ("fortran") - call get_value(table, keys(ii), ptr) - if (.not.associated(ptr)) then - call fatal_error(error,class_name//': error retrieving '//keys(ii)%key//' table') - return - end if - call self%fortran%load_from_toml(ptr, error) - - case ("library") - - allocate(self%library) - call get_value(table, keys(ii), ptr) - if (.not.associated(ptr)) then - call fatal_error(error,class_name//': error retrieving '//keys(ii)%key//' table') - return - end if - call self%library%load_from_toml(ptr, error) - - case ("executable") - - call get_value(table, keys(ii), ptr) - if (.not.associated(ptr)) then - call fatal_error(error,class_name//': error retrieving executable table') - return - end if - - !> Read all packages - call ptr%get_keys(pkg_keys) - allocate(self%executable(size(pkg_keys))) - - do jj = 1, size(pkg_keys) - call get_value(ptr, pkg_keys(jj), ptr_pkg) - call self%executable(jj)%load_from_toml(ptr_pkg, error) - if (allocated(error)) return - end do - - case ("dependencies") - - call get_value(table, keys(ii), ptr) - if (.not.associated(ptr)) then - call fatal_error(error,class_name//': error retrieving dependency table') - return - end if - - !> Read all packages - call ptr%get_keys(pkg_keys) - allocate(self%dependency(size(pkg_keys))) - - do jj = 1, size(pkg_keys) - call get_value(ptr, pkg_keys(jj), ptr_pkg) - call self%dependency(jj)%load_from_toml(ptr_pkg, error) - if (allocated(error)) return - end do - - case ("dev-dependencies") - - call get_value(table, keys(ii), ptr) - if (.not.associated(ptr)) then - call fatal_error(error,class_name//': error retrieving dev-dependencies table') - return - end if - - !> Read all packages - call ptr%get_keys(pkg_keys) - allocate(self%dev_dependency(size(pkg_keys))) - - do jj = 1, size(pkg_keys) - call get_value(ptr, pkg_keys(jj), ptr_pkg) - call self%dev_dependency(jj)%load_from_toml(ptr_pkg, error) - if (allocated(error)) return - end do case ("profiles") @@ -1034,60 +529,6 @@ subroutine load_from_toml(self, table, error) if (allocated(error)) return end do - case ("example") - - call get_value(table, keys(ii), ptr) - if (.not.associated(ptr)) then - call fatal_error(error,class_name//': error retrieving example table') - return - end if - - !> Read all packages - call ptr%get_keys(pkg_keys) - allocate(self%example(size(pkg_keys))) - - do jj = 1, size(pkg_keys) - call get_value(ptr, pkg_keys(jj), ptr_pkg) - call self%example(jj)%load_from_toml(ptr_pkg, error) - if (allocated(error)) return - end do - - case ("test") - - call get_value(table, keys(ii), ptr) - if (.not.associated(ptr)) then - call fatal_error(error,class_name//': error retrieving test table') - return - end if - - !> Read all packages - call ptr%get_keys(pkg_keys) - allocate(self%test(size(pkg_keys))) - - do jj = 1, size(pkg_keys) - call get_value(ptr, pkg_keys(jj), ptr_pkg) - call self%test(jj)%load_from_toml(ptr_pkg, error) - if (allocated(error)) return - end do - - case ("preprocess") - - call get_value(table, keys(ii), ptr) - if (.not.associated(ptr)) then - call fatal_error(error,class_name//': error retrieving preprocess table') - return - end if - - !> Read all packages - call ptr%get_keys(pkg_keys) - allocate(self%preprocess(size(pkg_keys))) - - do jj = 1, size(pkg_keys) - call get_value(ptr, pkg_keys(jj), ptr_pkg) - call self%preprocess(jj)%load_from_toml(ptr_pkg, error) - if (allocated(error)) return - end do - case default cycle sub_deps end select @@ -1096,4 +537,47 @@ 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) + + !> Instance of the package configuration + class(package_config_t), intent(in) :: self + + !> Target platform + type(platform_config_t), intent(in) :: platform + + !> Optional list of features to apply (currently idle) + type(string_t), optional, intent(in) :: features(:) + + ! Copy the entire package configuration + cfg = self + + ! Ensure allocatable fields are always allocated with default values if not already set + if (.not. allocated(cfg%build)) then + allocate(cfg%build) + cfg%build%auto_executables = .true. + cfg%build%auto_examples = .true. + cfg%build%auto_tests = .true. + cfg%build%module_naming = .false. + end if + + if (.not. allocated(cfg%install)) then + allocate(cfg%install) + cfg%install%library = .false. + cfg%install%test = .false. + end if + + if (.not. allocated(cfg%fortran)) then + allocate(cfg%fortran) + 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 function export_config + + end module fpm_manifest_package diff --git a/src/fpm/manifest/platform.f90 b/src/fpm/manifest/platform.f90 new file mode 100644 index 0000000000..96641e4e83 --- /dev/null +++ b/src/fpm/manifest/platform.f90 @@ -0,0 +1,376 @@ +!> Platform configuration type. +!> +!> This type captures only the target compiler and operating-system +!> selector, and implements the standard serialization interface +!> (serializable_t) used across FPM manifest classes. +!> +!> TOML representation: +!> compiler = "" # e.g., "gfortran", "ifx", "all" +!> os = "" # e.g., "linux", "macos", "windows", "all" +module fpm_manifest_platform + use fpm_error, only : error_t, fatal_error + use tomlf, only : toml_table + use fpm_toml, only : serializable_t, set_string, get_value + use fpm_environment,only : OS_ALL, OS_NAME, match_os_type, OS_UNKNOWN, validate_os_name, & + 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 + use fpm_strings, only : lower + implicit none + private + + public :: platform_config_t + public :: is_platform_key + + !> 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] + + !> Serializable platform configuration (compiler + OS only) + type, extends(serializable_t) :: platform_config_t + + integer(compiler_enum) :: compiler = id_all + integer :: os_type = OS_ALL + + contains + + procedure :: serializable_is_same => platform_is_same + procedure :: dump_to_toml + procedure :: load_from_toml + + !> Print information + procedure :: info + + !> Return .true. if THIS platform selector is compatible with CURRENT (wildcards allowed) + procedure :: matches => platform_is_suitable + + !> Get compiler name as string + procedure :: compiler_name => platform_compiler_name + + !> Get OS name as string + procedure :: os_name => platform_os_name + + !> Get configuration name as it appears in the manifest + procedure :: name => platform_config_name + + !> Validation + procedure :: is_valid => platform_is_valid + + !> Properties + procedure, non_overridable :: any_compiler + procedure, non_overridable :: any_os + procedure, non_overridable :: any_platform + + end type platform_config_t + + ! Overloaded initializer + interface platform_config_t + module procedure new_platform + module procedure new_platform_id + end interface + + character(len=*), parameter, private :: class_name = 'platform_config_t' + +contains + + !> Initialize a new platform config from compiler name + !> Automatically selects correct Intel compiler version based on OS + type(platform_config_t) function new_platform(compiler, os_type) + character(*), intent(in) :: compiler + integer, intent(in) :: os_type + + new_platform%compiler = match_compiler_type(compiler) + new_platform%os_type = os_type + + ! Correct Intel compiler ID based on OS (fallback to unix version for OS_ALL) + new_platform%compiler = correct_compiler_for_os(new_platform%compiler, os_type) + + end function new_platform + + !> Initialize a new platform config from compiler enum ID + !> Automatically selects correct Intel compiler version based on OS + type(platform_config_t) function new_platform_id(compiler_id, os_type) + integer(compiler_enum), intent(in) :: compiler_id + integer, intent(in) :: os_type + + new_platform_id%compiler = compiler_id + new_platform_id%os_type = os_type + + ! Correct Intel compiler ID based on OS (fallback to unix version for OS_ALL) + new_platform_id%compiler = correct_compiler_for_os(new_platform_id%compiler, os_type) + + end function new_platform_id + + !> Correct Intel compiler ID to match the target OS + !> Returns the appropriate OS-specific Intel compiler variant + function correct_compiler_for_os(compiler_id, os_type) result(corrected_id) + integer(compiler_enum), intent(in) :: compiler_id + integer, intent(in) :: os_type + integer(compiler_enum) :: corrected_id + + corrected_id = compiler_id ! Default: no change + + ! Intel classic compilers: map to OS-specific version + select case (compiler_id) + case (id_intel_classic_mac,id_intel_classic_nix,id_intel_classic_windows) + select case (os_type) + case (OS_WINDOWS) + corrected_id = id_intel_classic_windows + case (OS_MACOS) + corrected_id = id_intel_classic_mac + case default + corrected_id = id_intel_classic_nix ! Fallback to unix version + end select + + case (id_intel_llvm_nix,id_intel_llvm_windows) + select case (os_type) + case (OS_WINDOWS) + corrected_id = id_intel_llvm_windows + case default + corrected_id = id_intel_llvm_nix ! Fallback to unix version + end select + end select + + end function correct_compiler_for_os + + !> Check if a compiler ID is suitable for a target platform + !> Handles special cases like Intel compiler variants + logical function compiler_is_suitable(compiler_id, target) result(suitable) + integer(compiler_enum), intent(in) :: compiler_id + type(platform_config_t), intent(in) :: target + + ! Default case: exact match or compiler_id is id_all + suitable = (compiler_id == id_all .or. compiler_id == target%compiler) + + if (suitable) return + + ! Intel classic compilers: all variants are equivalent + if (any(compiler_id == id_intel_classic) .and. any(target%compiler == id_intel_classic)) then + suitable = .true. + return + end if + + ! Intel LLVM compilers: all variants are equivalent + if (any(compiler_id == id_intel_llvm) .and. any(target%compiler == id_intel_llvm)) then + suitable = .true. + return + end if + + ! Future extensions can be added here for other compiler families + + end function compiler_is_suitable + + !> Compare two platform_config_t (semantic equality) + logical function platform_is_same(this, that) + class(platform_config_t), intent(in) :: this + class(serializable_t), intent(in) :: that + + platform_is_same = .false. + select type (other => that) + type is (platform_config_t) + if (this%compiler /= other%compiler) return + if (this%os_type /= other%os_type ) return + class default + return + end select + platform_is_same = .true. + end function platform_is_same + + !> Dump to TOML table + subroutine dump_to_toml(self, table, error) + class(platform_config_t), intent(inout) :: self + type(toml_table), intent(inout) :: table + type(error_t), allocatable, intent(out) :: error + + ! Compiler as canonical name (e.g., "gfortran", "ifx", "all") + call set_string(table, "compiler", compiler_id_name(self%compiler), error, class_name) + if (allocated(error)) return + + ! OS as canonical name (e.g., "linux", "macos", "windows", "all") + call set_string(table, "os", OS_NAME(self%os_type), error, class_name) + if (allocated(error)) return + end subroutine dump_to_toml + + + !> Load from TOML table + subroutine load_from_toml(self, table, error) + class(platform_config_t), intent(inout) :: self + type(toml_table), intent(inout) :: table + type(error_t), allocatable, intent(out) :: error + + character(len=:), allocatable :: s + + ! Compiler (default "all") + call get_value(table, "compiler", s, "all") + self%compiler = match_compiler_type(s) + if (self%compiler == id_unknown) then + call fatal_error(error, class_name//": unsupported compiler '"//s//"'") + return + end if + + ! OS (default "all") + call get_value(table, "os", s, "all") + self%os_type = match_os_type(s) + ! match_os_type should map unknowns to a sentinel; rely on it for validation. + ! If you prefer a hard failure on unknown here, uncomment the next block: + ! if (self%os_type == OS_UNKNOWN) then + ! call fatal_error(error, class_name//": unsupported os '"//s//"'") + ! return + ! end if + end subroutine load_from_toml + + !> Write information on instance (similar style to profile_config_t%info) + subroutine info(self, unit, verbosity) + class(platform_config_t), intent(in) :: self + integer, intent(in) :: unit + integer, optional, intent(in) :: verbosity + + integer :: pr + character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)' + + pr = merge(verbosity, 1, present(verbosity)) + + write(unit, fmt) "Platform" + write(unit, fmt) "- compiler", compiler_id_name(self%compiler) + write(unit, fmt) "- os", OS_NAME(self%os_type) + + ! Currently 'verbosity' does not expand output; reserved for future fields. + end subroutine info + + !> Return .true. if SELF is suitable for a given target platform + !> + !> Rules: + !> - compiler matches if SELF%compiler == id_all OR == target%compiler + !> - os matches if SELF%os_type == OS_ALL OR == target%os_type + !> - id_unknown / OS_UNKNOWN in SELF are treated as "no match" (conservative) + !> - Intel compilers must match OS (ifort unix/windows versions use different flags) + logical function platform_is_suitable(self, target) result(ok) + class(platform_config_t), intent(in) :: self + 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. + return + end if + + compiler_ok = compiler_is_suitable(self%compiler, target) + os_ok = any(self%os_type == [OS_ALL,target%os_type]) + + ! Basic matching + ok = compiler_ok .and. os_ok + + if (.not. ok) return + + ! Additional validation: Intel compilers must have compatible OS + ! ifort on Unix/Mac should not match ifort on Windows and vice versa + if (self%compiler /= id_all .and. self%os_type /= OS_ALL) then + ok = compiler_os_compatible(self%compiler, self%os_type) .and. & + compiler_os_compatible(target%compiler, target%os_type) + end if + + end function platform_is_suitable + + !> Check if a platform configuration is valid (no unknowns, compatible compiler+OS) + logical function platform_is_valid(self) result(valid) + class(platform_config_t), intent(in) :: self + + ! Check compiler+OS compatibility + valid = compiler_os_compatible(self%compiler, self%os_type) + + end function platform_is_valid + + !> Check if a compiler ID is compatible with an OS type + elemental logical function compiler_os_compatible(compiler_id, os_type) result(compatible) + integer(compiler_enum), intent(in) :: compiler_id + integer, intent(in) :: os_type + + ! Check for unknowns + if (compiler_id == id_unknown .or. os_type == OS_UNKNOWN) then + compatible = .false. + return + end if + + ! Intel classic compilers: OS-specific variants + select case (compiler_id) + case (id_intel_classic_windows) + compatible = any(os_type == [OS_ALL,OS_WINDOWS]) + case (id_intel_classic_nix) + compatible = any(os_type == [OS_ALL,OS_LINUX]) + case (id_intel_classic_mac) + compatible = any(os_type == [OS_ALL,OS_MACOS]) + case (id_intel_llvm_windows) + compatible = any(os_type == [OS_ALL,OS_WINDOWS]) + case (id_intel_llvm_nix) + compatible = any(os_type == [OS_ALL,OS_LINUX,OS_MACOS]) + case default + ! Other compilers are compatible with any OS + compatible = os_type/=OS_UNKNOWN .and. compiler_id/=id_unknown + end select + + end function compiler_os_compatible + + !> Check if a key (os or compiler) can be used for platform setting + elemental logical function is_platform_key(key) + character(*), intent(in) :: key + + call validate_compiler_name(key, is_platform_key) + if (is_platform_key) return + + call validate_os_name(key, is_platform_key) + if (is_platform_key) return + + end function is_platform_key + + !> Get compiler name as string + function platform_compiler_name(self) result(name) + class(platform_config_t), intent(in) :: self + character(len=:), allocatable :: name + + name = compiler_id_name(self%compiler) + end function platform_compiler_name + + !> Get OS name as string + function platform_os_name(self) result(name) + class(platform_config_t), intent(in) :: self + character(len=:), allocatable :: name + + name = OS_NAME(self%os_type) + end function platform_os_name + + !> Get configuration name + function platform_config_name(self) result(name) + class(platform_config_t), intent(in) :: self + character(len=:), allocatable :: name + + if (self%os_type==OS_ALL .and. self%compiler==id_all) then + name = "" + elseif (self%os_type==OS_ALL) then + name = self%compiler_name() + elseif (self%compiler==id_all) then + name = self%os_name() + else + name = self%os_name()//'.'//self%compiler_name() + end if + + end function platform_config_name + + !> Whether the configuration is generic + elemental logical function any_compiler(self) + class(platform_config_t), intent(in) :: self + any_compiler = self%compiler == id_all + end function any_compiler + elemental logical function any_os(self) + class(platform_config_t), intent(in) :: self + any_os = self%os_type == OS_ALL + end function any_os + elemental logical function any_platform(self) + class(platform_config_t), intent(in) :: self + any_platform = any_os(self) .and. any_compiler(self) + end function any_platform + +end module fpm_manifest_platform diff --git a/src/fpm/manifest/profiles.f90 b/src/fpm/manifest/profiles.f90 index 09046fcdda..28141e4654 100644 --- a/src/fpm/manifest/profiles.f90 +++ b/src/fpm/manifest/profiles.f90 @@ -42,21 +42,24 @@ !>``` !> 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_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, & + validate_compiler_name use fpm_filesystem, only: join_path implicit none - public :: profile_config_t, new_profile, new_profiles, get_default_profiles, & - & info_profile, find_profile, DEFAULT_COMPILER + public :: profile_config_t, new_profile, new_profiles, find_profile, DEFAULT_COMPILER !> Name of the default compiler - character(len=*), parameter :: DEFAULT_COMPILER = 'gfortran' - integer, parameter :: OS_ALL = -1 + character(len=*), parameter :: DEFAULT_COMPILER = 'gfortran' character(len=:), allocatable :: path !> Type storing file name - file scope compiler flags pairs @@ -77,35 +80,15 @@ module fpm_manifest_profile end type file_scope_flag - !> Configuration meta data for a profile + !> Configuration meta data for a profile (now based on features) type, extends(serializable_t) :: profile_config_t - !> Name of the profile - character(len=:), allocatable :: profile_name + + !> Profile feature - contains all profile configuration + type(feature_config_t) :: profile_feature - !> Name of the compiler - character(len=:), allocatable :: compiler - - !> Value repesenting OS - integer :: os_type = OS_ALL - - !> Fortran compiler flags - character(len=:), allocatable :: flags - - !> C compiler flags - character(len=:), allocatable :: c_flags - - !> C++ compiler flags - character(len=:), allocatable :: cxx_flags - - !> Link time compiler flags - character(len=:), allocatable :: link_time_flags - - !> File scope flags + !> File scope flags (maintained for backwards compatibility) type(file_scope_flag), allocatable :: file_scope_flags(:) - !> Is this profile one of the built-in ones? - logical :: is_built_in = .false. - contains !> Print information on this instance @@ -116,11 +99,21 @@ module fpm_manifest_profile 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 + end type profile_config_t contains - !> Construct a new profile configuration from a TOML data structure + !> 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) @@ -153,100 +146,46 @@ function new_profile(profile_name, compiler, os_type, flags, c_flags, cxx_flags, logical, optional, intent(in) :: is_built_in type(profile_config_t) :: profile + integer(compiler_enum) :: compiler_id - profile%profile_name = profile_name - profile%compiler = compiler - profile%os_type = os_type + ! 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%flags = flags + profile%profile_feature%flags = flags else - profile%flags = "" + profile%profile_feature%flags = "" end if if (present(c_flags)) then - profile%c_flags = c_flags + profile%profile_feature%c_flags = c_flags else - profile%c_flags = "" + profile%profile_feature%c_flags = "" end if if (present(cxx_flags)) then - profile%cxx_flags = cxx_flags + profile%profile_feature%cxx_flags = cxx_flags else - profile%cxx_flags = "" + profile%profile_feature%cxx_flags = "" end if if (present(link_time_flags)) then - profile%link_time_flags = link_time_flags + profile%profile_feature%link_time_flags = link_time_flags else - profile%link_time_flags = "" + 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 - if (present(is_built_in)) then - profile%is_built_in = is_built_in - else - profile%is_built_in = .false. - end if end function new_profile - !> Check if compiler name is a valid compiler name - subroutine validate_compiler_name(compiler_name, is_valid) - - !> Name of a compiler - character(len=:), allocatable, intent(in) :: compiler_name - - !> Boolean value of whether compiler_name is valid or not - logical, intent(out) :: is_valid - select case(compiler_name) - case("gfortran", "ifort", "ifx", "pgfortran", "nvfortran", "flang", "caf", & - & "f95", "lfortran", "lfc", "nagfor", "crayftn", "xlf90", "ftn95") - is_valid = .true. - case default - is_valid = .false. - end select - end subroutine validate_compiler_name - - !> Check if os_name is a valid name of a supported OS - subroutine validate_os_name(os_name, is_valid) - - !> Name of an operating system - character(len=:), allocatable, intent(in) :: os_name - - !> Boolean value of whether os_name is valid or not - logical, intent(out) :: is_valid - - select case (os_name) - case ("linux", "macos", "windows", "cygwin", "solaris", "freebsd", & - & "openbsd", "unknown") - is_valid = .true. - case default - is_valid = .false. - end select - - end subroutine validate_os_name - - !> Match os_type enum to a lowercase string with name of OS - subroutine match_os_type(os_name, os_type) - - !> Name of operating system - character(len=:), allocatable, intent(in) :: os_name - - !> Enum representing type of OS - integer, intent(out) :: os_type - - select case (os_name) - case ("linux"); os_type = OS_LINUX - case ("macos"); os_type = OS_MACOS - case ("windows"); os_type = OS_WINDOWS - case ("cygwin"); os_type = OS_CYGWIN - case ("solaris"); os_type = OS_SOLARIS - case ("freebsd"); os_type = OS_FREEBSD - case ("openbsd"); os_type = OS_OPENBSD - case ("all"); os_type = OS_ALL - case default; os_type = OS_UNKNOWN - end select - - end subroutine match_os_type - !> Match lowercase string with name of OS to os_type enum function os_type_name(os_type) @@ -517,7 +456,7 @@ subroutine traverse_oss(profile_name, compiler_name, os_list, table, profiles, p return end if call os_node%get_keys(key_list) - call match_os_type(os_name, os_type) + 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 @@ -624,8 +563,8 @@ subroutine new_profiles(profiles, table, error) path = '' - default_profiles = get_default_profiles(error) - if (allocated(error)) return + ! Default profiles are now features - no longer used + allocate(default_profiles(0)) call table%get_keys(prof_list) if (size(prof_list) < 1) return @@ -698,147 +637,24 @@ subroutine new_profiles(profiles, table, error) ! Apply profiles with profile name 'all' to matching profiles do iprof = 1,size(profiles) - if (profiles(iprof)%profile_name.eq.'all') then + if (profiles(iprof)%profile_feature%name == 'all') then do profindex = 1,size(profiles) - if (.not.(profiles(profindex)%profile_name.eq.'all') & - & .and.(profiles(profindex)%compiler.eq.profiles(iprof)%compiler) & - & .and.(profiles(profindex)%os_type.eq.profiles(iprof)%os_type)) then - profiles(profindex)%flags=profiles(profindex)%flags// & - & " "//profiles(iprof)%flags - profiles(profindex)%c_flags=profiles(profindex)%c_flags// & - & " "//profiles(iprof)%c_flags - profiles(profindex)%cxx_flags=profiles(profindex)%cxx_flags// & - & " "//profiles(iprof)%cxx_flags - profiles(profindex)%link_time_flags=profiles(profindex)%link_time_flags// & - & " "//profiles(iprof)%link_time_flags + 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 end do end subroutine new_profiles - !> Construct an array of built-in profiles - function get_default_profiles(error) result(default_profiles) - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(profile_config_t), allocatable :: default_profiles(:) - - default_profiles = [ & - & new_profile('release', & - & 'caf', & - & OS_ALL, & - & flags=' -O3 -Wimplicit-interface -fPIC -fmax-errors=1 -funroll-loops', & - & is_built_in=.true.), & - & new_profile('release', & - & 'gfortran', & - & OS_ALL, & - & flags=' -O3 -Wimplicit-interface -fPIC -fmax-errors=1 -funroll-loops -fcoarray=single', & - & is_built_in=.true.), & - & new_profile('release', & - & 'f95', & - & OS_ALL, & - & flags=' -O3 -Wimplicit-interface -fPIC -fmax-errors=1 -ffast-math -funroll-loops', & - & is_built_in=.true.), & - & new_profile('release', & - & 'nvfortran', & - & OS_ALL, & - & flags = ' -Mbackslash', & - & is_built_in=.true.), & - & new_profile('release', & - & 'ifort', & - & OS_ALL, & - & flags = ' -fp-model precise -pc64 -align all -error-limit 1 -reentrancy& - & threaded -nogen-interfaces -assume byterecl', & - & is_built_in=.true.), & - & new_profile('release', & - & 'ifort', & - & OS_WINDOWS, & - & flags = ' /fp:precise /align:all /error-limit:1 /reentrancy:threaded& - & /nogen-interfaces /assume:byterecl', & - & is_built_in=.true.), & - & new_profile('release', & - & 'ifx', & - & OS_ALL, & - & flags = ' -fp-model=precise -pc64 -align all -error-limit 1 -reentrancy& - & threaded -nogen-interfaces -assume byterecl', & - & is_built_in=.true.), & - & new_profile('release', & - & 'ifx', & - & OS_WINDOWS, & - & flags = ' /fp:precise /align:all /error-limit:1 /reentrancy:threaded& - & /nogen-interfaces /assume:byterecl', & - & is_built_in=.true.), & - & new_profile('release', & - &'nagfor', & - & OS_ALL, & - & flags = ' -O4 -coarray=single -PIC', & - & is_built_in=.true.), & - & new_profile('release', & - &'lfortran', & - & OS_ALL, & - & flags = ' flag_lfortran_opt', & - & is_built_in=.true.), & - & new_profile('debug', & - & 'caf', & - & OS_ALL, & - & flags = ' -Wall -Wextra -Wimplicit-interface -Wno-external-argument-mismatch& - & -fPIC -fmax-errors=1 -g -fcheck=bounds& - & -fcheck=array-temps -fbacktrace', & - & is_built_in=.true.), & - & new_profile('debug', & - & 'gfortran', & - & OS_ALL, & - & flags = ' -Wall -Wextra -Wimplicit-interface -Wno-external-argument-mismatch& - & -fPIC -fmax-errors=1 -g -fcheck=bounds& - & -fcheck=array-temps -fbacktrace -fcoarray=single', & - & is_built_in=.true.), & - & new_profile('debug', & - & 'f95', & - & OS_ALL, & - & flags = ' -Wall -Wextra -Wimplicit-interface -Wno-external-argument-mismatch& - & -fPIC -fmax-errors=1 -g -fcheck=bounds& - & -fcheck=array-temps -Wno-maybe-uninitialized -Wno-uninitialized -fbacktrace', & - & is_built_in=.true.), & - & new_profile('debug', & - & 'nvfortran', & - & OS_ALL, & - & flags = ' -Minform=inform -Mbackslash -g -Mbounds -Mchkptr -Mchkstk -traceback', & - & is_built_in=.true.), & - & new_profile('debug', & - & 'ifort', & - & OS_ALL, & - & flags = ' -warn all -check all -error-limit 1 -O0 -g -assume byterecl -traceback', & - & is_built_in=.true.), & - & new_profile('debug', & - & 'ifort', & - & OS_WINDOWS, & - & flags = ' /warn:all /check:all /error-limit:1& - & /Od /Z7 /assume:byterecl /traceback', & - & is_built_in=.true.), & - & new_profile('debug', & - & 'ifx', & - & OS_ALL, & - & flags = ' -warn all -check all -error-limit 1 -O0 -g -assume byterecl -traceback', & - & is_built_in=.true.), & - & new_profile('debug', & - & 'ifx', & - & OS_WINDOWS, & - & flags = ' /warn:all /check:all /error-limit:1 /Od /Z7 /assume:byterecl', & - & is_built_in=.true.), & - & new_profile('debug', & - & 'ifx', & - & OS_WINDOWS, & - & flags = ' /warn:all /check:all /error-limit:1 /Od /Z7 /assume:byterecl', & - & is_built_in=.true.), & - & new_profile('debug', & - & 'lfortran', & - & OS_ALL, & - & flags = '', & - & is_built_in=.true.) & - &] - end function get_default_profiles !> Write information on instance subroutine info(self, unit, verbosity) @@ -862,75 +678,20 @@ subroutine info(self, unit, verbosity) end if write(unit, fmt) "Profile" - if (allocated(self%profile_name)) then - write(unit, fmt) "- profile name", self%profile_name - end if - - if (allocated(self%compiler)) then - write(unit, fmt) "- compiler", self%compiler + if (allocated(self%profile_feature%name)) then + write(unit, fmt) "- profile name", self%profile_feature%name end if + + call self%profile_feature%platform%info(unit, verbosity) - write(unit, fmt) "- os", os_type_name(self%os_type) - - if (allocated(self%flags)) then - write(unit, fmt) "- compiler flags", self%flags + if (allocated(self%profile_feature%flags)) then + write(unit, fmt) "- compiler flags", self%profile_feature%flags end if end subroutine info - !> Print a representation of profile_config_t - function info_profile(profile) result(s) - - !> Profile to be represented - type(profile_config_t), intent(in) :: profile - - !> String representation of given profile - character(:), allocatable :: s - - integer :: i - - s = "profile_config_t(" - s = s // 'profile_name="' // profile%profile_name // '"' - s = s // ', compiler="' // profile%compiler // '"' - s = s // ", os_type=" - select case(profile%os_type) - case (OS_UNKNOWN) - s = s // "OS_UNKNOWN" - case (OS_LINUX) - s = s // "OS_LINUX" - case (OS_MACOS) - s = s // "OS_MACOS" - case (OS_WINDOWS) - s = s // "OS_WINDOWS" - case (OS_CYGWIN) - s = s // "OS_CYGWIN" - case (OS_SOLARIS) - s = s // "OS_SOLARIS" - case (OS_FREEBSD) - s = s // "OS_FREEBSD" - case (OS_OPENBSD) - s = s // "OS_OPENBSD" - case (OS_ALL) - s = s // "OS_ALL" - case default - s = s // "INVALID" - end select - if (allocated(profile%flags)) s = s // ', flags="' // profile%flags // '"' - if (allocated(profile%c_flags)) s = s // ', c_flags="' // profile%c_flags // '"' - if (allocated(profile%cxx_flags)) s = s // ', cxx_flags="' // profile%cxx_flags // '"' - if (allocated(profile%link_time_flags)) s = s // ', link_time_flags="' // profile%link_time_flags // '"' - if (allocated(profile%file_scope_flags)) then - do i=1,size(profile%file_scope_flags) - s = s // ', flags for '//profile%file_scope_flags(i)%file_name// & - & ' ="' // profile%file_scope_flags(i)%flags // '"' - end do - end if - s = s // ")" - - end function info_profile - !> Look for profile with given configuration in array profiles - subroutine find_profile(profiles, profile_name, compiler, os_type, found_matching, chosen_profile) + subroutine find_profile(profiles, profile_name, target, found_matching, chosen_profile) !> Array of profiles type(profile_config_t), allocatable, intent(in) :: profiles(:) @@ -938,11 +699,8 @@ subroutine find_profile(profiles, profile_name, compiler, os_type, found_matchin !> Name of profile character(:), allocatable, intent(in) :: profile_name - !> Name of compiler - character(:), allocatable, intent(in) :: compiler - - !> Type of operating system (enum) - integer, intent(in) :: os_type + ! Target platform + type(platform_config_t), intent(in) :: target !> Boolean value containing true if matching profile was found logical, intent(out) :: found_matching @@ -950,43 +708,29 @@ subroutine find_profile(profiles, profile_name, compiler, os_type, found_matchin !> Last matching profile in the profiles array type(profile_config_t), intent(out) :: chosen_profile - character(:), allocatable :: curr_profile_name - character(:), allocatable :: curr_compiler - integer :: curr_os - integer :: i, priority, curr_priority + integer :: i found_matching = .false. if (size(profiles) < 1) return + + ! Try to find profile with matching OS type do i=1,size(profiles) - curr_profile_name = profiles(i)%profile_name - curr_compiler = profiles(i)%compiler - curr_os = profiles(i)%os_type - if (curr_profile_name.eq.profile_name) then - if (curr_compiler.eq.compiler) then - if (curr_os.eq.os_type) then + + 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. - end if + return end if end if + + endassociate + end do - ! Try to find profile with OS type 'all' - if (.not. found_matching) then - do i=1,size(profiles) - curr_profile_name = profiles(i)%profile_name - curr_compiler = profiles(i)%compiler - curr_os = profiles(i)%os_type - if (curr_profile_name.eq.profile_name) then - if (curr_compiler.eq.compiler) then - if (curr_os.eq.OS_ALL) then - chosen_profile = profiles(i) - found_matching = .true. - end if - end if - end if - end do - end if + end subroutine find_profile @@ -1063,43 +807,19 @@ logical function profile_same(this,that) select type (other=>that) type is (profile_config_t) - if (allocated(this%profile_name).neqv.allocated(other%profile_name)) return - if (allocated(this%profile_name)) then - if (.not.(this%profile_name==other%profile_name)) return - endif - if (allocated(this%compiler).neqv.allocated(other%compiler)) return - if (allocated(this%compiler)) then - if (.not.(this%compiler==other%compiler)) return - endif - if (this%os_type/=other%os_type) return - 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%c_flags).neqv.allocated(other%c_flags)) return - if (allocated(this%c_flags)) then - if (.not.(this%c_flags==other%c_flags)) return - endif - if (allocated(this%cxx_flags).neqv.allocated(other%cxx_flags)) return - if (allocated(this%cxx_flags)) then - if (.not.(this%cxx_flags==other%cxx_flags)) return - endif - if (allocated(this%link_time_flags).neqv.allocated(other%link_time_flags)) return - if (allocated(this%link_time_flags)) then - if (.not.(this%link_time_flags==other%link_time_flags)) return - endif + + ! 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) - print *, 'check ii-th file scope: ',ii if (.not.this%file_scope_flags(ii)==other%file_scope_flags(ii)) return end do endif - if (this%is_built_in.neqv.other%is_built_in) return - class default ! Not the same type return @@ -1127,24 +847,13 @@ subroutine profile_dump(self, table, error) type(toml_table), pointer :: ptr_deps, ptr character(len=30) :: unnamed - call set_string(table, "profile-name", self%profile_name, error) - if (allocated(error)) return - call set_string(table, "compiler", self%compiler, error) - if (allocated(error)) return - call set_string(table,"os-type",os_type_name(self%os_type), error, 'profile_config_t') - if (allocated(error)) return - call set_string(table, "flags", self%flags, error) + ! Dump the underlying feature data + call self%profile_feature%dump_to_toml(table, error) if (allocated(error)) return - call set_string(table, "c-flags", self%c_flags, error) - if (allocated(error)) return - call set_string(table, "cxx-flags", self%cxx_flags, error) - if (allocated(error)) return - call set_string(table, "link-time-flags", self%link_time_flags, error) - if (allocated(error)) return - + if (allocated(self%file_scope_flags)) then - ! Create dependency table + ! 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 ") @@ -1172,9 +881,6 @@ subroutine profile_dump(self, table, error) endif - call set_value(table, "is-built-in", self%is_built_in, error, 'profile_config_t') - if (allocated(error)) return - 1 format('UNNAMED_FILE_',i0) end subroutine profile_dump @@ -1192,23 +898,17 @@ subroutine profile_load(self, table, error) type(error_t), allocatable, intent(out) :: error !> Local variables - character(len=:), allocatable :: flag + 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) - call get_value(table, "profile-name", self%profile_name) - call get_value(table, "compiler", self%compiler) - call get_value(table,"os-type",flag) - call match_os_type(flag, self%os_type) - call get_value(table, "flags", self%flags) - call get_value(table, "c-flags", self%c_flags) - call get_value(table, "cxx-flags", self%cxx_flags) - call get_value(table, "link-time-flags", self%link_time_flags) - call get_value(table, "is-built-in", self%is_built_in, error, 'profile_config_t') - if (allocated(error)) return + ! 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) @@ -1222,7 +922,7 @@ subroutine profile_load(self, table, error) return end if - !> Read all packages + !> Read all file scope flags call ptr%get_keys(dep_keys) allocate(self%file_scope_flags(size(dep_keys))) @@ -1239,5 +939,63 @@ subroutine profile_load(self, table, error) 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 + end module fpm_manifest_profile diff --git a/src/fpm_compiler.F90 b/src/fpm_compiler.F90 index 88a7e51051..bdda2bd0ae 100644 --- a/src/fpm_compiler.F90 +++ b/src/fpm_compiler.F90 @@ -41,8 +41,7 @@ module fpm_compiler use fpm_filesystem, only: join_path, basename, get_temp_filename, delete_file, unix_path, & & getline, run use fpm_strings, only: split, string_cat, string_t, str_ends_with, str_begins_with_str, & - & string_array_contains -use fpm_manifest, only : package_config_t + & string_array_contains, lower use fpm_error, only: error_t, fatal_error, fpm_stop use tomlf, only: toml_table use fpm_toml, only: serializable_t, set_string, set_value, toml_stat, get_value @@ -52,10 +51,13 @@ module fpm_compiler implicit none public :: compiler_t, new_compiler, archiver_t, new_archiver, get_macros public :: append_clean_flags, append_clean_flags_array -public :: debug, id_gcc +public :: debug +public :: id_gcc,id_all +public :: match_compiler_type, compiler_id_name, validate_compiler_name enum, bind(C) enumerator :: & + id_all = -1, & id_unknown, & id_gcc, & id_f95, & @@ -955,17 +957,17 @@ function get_compiler_id(compiler) result(id) command = trim(full_command_parts(1)) endif if (allocated(command)) then - id = get_id(command) + id = match_compiler_type(command) if (id /= id_unknown) return end if end if end if - id = get_id(compiler) + id = match_compiler_type(compiler) end function get_compiler_id -function get_id(compiler) result(id) +function match_compiler_type(compiler) result(id) character(len=*), intent(in) :: compiler integer(kind=compiler_enum) :: id @@ -1063,9 +1065,41 @@ function get_id(compiler) result(id) return end if + + if (check_compiler(compiler, "all")) then + id = id_all + return + end if + id = id_unknown -end function get_id +end function match_compiler_type + +!> Check if compiler name is a valid compiler name +pure elemental subroutine validate_compiler_name(compiler_name, is_valid) + + !> Name of a compiler + character(len=*), intent(in) :: compiler_name + + !> Boolean value of whether compiler_name is valid or not + logical, intent(out) :: is_valid + + character(:), allocatable :: lname + + lname = lower(compiler_name) + + select case (lname) + case("gfortran", "ifort", "ifx", "pgfortran", & + "nvfortran", "flang", "caf", & + "f95", "lfortran", "lfc", "nagfor",& + "crayftn", "xlf90", "ftn95", "all") + is_valid = .true. + case default + is_valid = .false. + end select + +end subroutine validate_compiler_name + function check_compiler(compiler, expected) result(match) character(len=*), intent(in) :: compiler @@ -1769,30 +1803,38 @@ pure function compiler_name(self) result(name) class(compiler_t), intent(in) :: self !> Representation as string character(len=:), allocatable :: name + name = compiler_id_name(self%id) +end function compiler_name + +!> Convert compiler enum to name (reverse of match_compiler_type) +pure function compiler_id_name(id) result(name) + integer(compiler_enum), intent(in) :: id + character(len=:), allocatable :: name - select case (self%id) - case(id_gcc); name = "gfortran" - case(id_f95); name = "f95" - case(id_caf); name = "caf" + select case (id) + case(id_gcc); name = "gfortran" + case(id_f95); name = "f95" + case(id_caf); name = "caf" case(id_intel_classic_nix); name = "ifort" case(id_intel_classic_mac); name = "ifort" case(id_intel_classic_windows); name = "ifort" - case(id_intel_llvm_nix); name = "ifx" - case(id_intel_llvm_windows); name = "ifx" - case(id_intel_llvm_unknown); name = "ifx" - case(id_pgi); name = "pgfortran" - case(id_nvhpc); name = "nvfortran" - case(id_nag); name = "nagfor" - case(id_flang_classic); name = "flang-classic" - case(id_flang); name = "flang" - case(id_f18); name = "f18" - case(id_ibmxl); name = "xlf90" - case(id_cray); name = "crayftn" - case(id_lahey); name = "lfc" - case(id_lfortran); name = "lFortran" - case default; name = "invalid/unknown" + case(id_intel_llvm_nix); name = "ifx" + case(id_intel_llvm_windows); name = "ifx" + case(id_intel_llvm_unknown); name = "ifx" + case(id_pgi); name = "pgfortran" + case(id_nvhpc); name = "nvfortran" + case(id_nag); name = "nagfor" + case(id_flang_classic); name = "flang" + case(id_flang); name = "flang-new" + case(id_f18); name = "f18" + case(id_ibmxl); name = "xlf90" + case(id_cray); name = "crayftn" + case(id_lahey); name = "lfc" + case(id_lfortran); name = "lfortran" + case (id_all); name = "all" + case default; name = "invalid/unknown" end select -end function compiler_name +end function compiler_id_name !> Run a single-source Fortran program using the current compiler !> Compile a Fortran object diff --git a/src/fpm_environment.f90 b/src/fpm_environment.f90 index 02bd3e32b0..ec1ad9835b 100644 --- a/src/fpm_environment.f90 +++ b/src/fpm_environment.f90 @@ -8,9 +8,12 @@ module fpm_environment & stderr=>error_unit use,intrinsic :: iso_c_binding, only: c_char,c_int,c_null_char use fpm_error, only : fpm_stop + use fpm_strings, only : lower implicit none private public :: get_os_type + public :: match_os_type + public :: validate_os_name public :: os_is_unix public :: get_env public :: set_env @@ -20,6 +23,7 @@ module fpm_environment public :: library_filename public :: OS_NAME + integer, parameter, public :: OS_ALL = -1 ! "all" flag for profile support integer, parameter, public :: OS_UNKNOWN = 0 integer, parameter, public :: OS_LINUX = 1 integer, parameter, public :: OS_MACOS = 2 @@ -78,10 +82,47 @@ pure function OS_NAME(os) case (OS_FREEBSD); OS_NAME = "FreeBSD" case (OS_OPENBSD); OS_NAME = "OpenBSD" case (OS_UNKNOWN); OS_NAME = "Unknown" + case (OS_ALL) ; OS_NAME = "all" case default ; OS_NAME = "UNKNOWN" end select end function OS_NAME + !> Match os_name to os_type enum (similar to profiles.f90) + integer function match_os_type(os_name) result(os_type) + character(len=*), intent(in) :: os_name + + select case (lower(os_name)) + case ("linux"); os_type = OS_LINUX + case ("macos"); os_type = OS_MACOS + case ("windows"); os_type = OS_WINDOWS + case ("cygwin"); os_type = OS_CYGWIN + case ("solaris"); os_type = OS_SOLARIS + case ("freebsd"); os_type = OS_FREEBSD + case ("openbsd"); os_type = OS_OPENBSD + case ("all"); os_type = OS_ALL + case default; os_type = OS_UNKNOWN + end select + end function match_os_type + + !> Check if os_name is a valid name of a supported OS + pure elemental subroutine validate_os_name(os_name, is_valid) + + !> Name of an operating system + character(len=*), intent(in) :: os_name + + !> Boolean value of whether os_name is valid or not + logical, intent(out) :: is_valid + + select case (lower(os_name)) + case ("linux", "macos", "windows", "cygwin", "solaris", "freebsd", & + & "openbsd", "all") + is_valid = .true. + case default + is_valid = .false. + end select + + end subroutine validate_os_name + !> Determine the OS type integer function get_os_type() result(r) !! diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index e3ef60c40e..494076bfd5 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -44,9 +44,12 @@ module fpm_model use fpm_toml, only: serializable_t, set_value, set_list, get_value, & & get_list, add_table, toml_key, add_array, set_string use fpm_error, only: error_t, fatal_error -use fpm_environment, only: OS_WINDOWS,OS_MACOS +use fpm_environment, only: OS_WINDOWS,OS_MACOS, get_os_type, OS_UNKNOWN, OS_LINUX, OS_CYGWIN, & + OS_SOLARIS, OS_FREEBSD, OS_OPENBSD, OS_ALL, validate_os_name, OS_NAME, & + match_os_type use fpm_manifest_preprocess, only: preprocess_config_t use fpm_manifest_fortran, only: fortran_config_t +use fpm_manifest_platform, only: platform_config_t implicit none private @@ -123,8 +126,8 @@ module fpm_model !> Serialization interface procedure :: serializable_is_same => srcfile_is_same - procedure :: dump_to_toml => srcfile_dump_to_toml - procedure :: load_from_toml => srcfile_load_from_toml + procedure :: dump_to_toml => srcfile_dump_to_toml + procedure :: load_from_toml => srcfile_load_from_toml end type srcfile_t @@ -221,10 +224,16 @@ module fpm_model !> Prefix for all module names type(string_t) :: module_prefix + !> Target operating system + integer :: target_os = OS_ALL + contains !> Get target link flags procedure :: get_package_libraries_link + + !> Get target platform configuration + procedure :: target_platform !> Serialization interface procedure :: serializable_is_same => model_is_same @@ -864,6 +873,7 @@ logical function model_is_same(this,that) if (.not.(this%include_tests.eqv.other%include_tests)) return if (.not.(this%enforce_module_names.eqv.other%enforce_module_names)) return if (.not.(this%module_prefix==other%module_prefix)) return + if (.not.(this%target_os==other%target_os)) return class default ! Not the same type @@ -929,6 +939,10 @@ subroutine model_dump_to_toml(self, table, error) if (allocated(error)) return call set_string(table, "module-prefix", self%module_prefix, error, 'fpm_model_t') if (allocated(error)) return + + ! Serialize target OS as string + call set_string(table, "target-os", OS_NAME(self%target_os), error, 'fpm_model_t') + if (allocated(error)) return call add_table(table, "deps", ptr, error, 'fpm_model_t') if (allocated(error)) return @@ -985,7 +999,9 @@ subroutine model_load_from_toml(self, table, error) type(toml_key), allocatable :: keys(:),pkg_keys(:) integer :: ierr, ii, jj type(toml_table), pointer :: ptr,ptr_pkg - + character(:), allocatable :: os_string + logical :: is_valid + call table%get_keys(keys) call get_value(table, "package-name", self%package_name) @@ -1072,8 +1088,35 @@ subroutine model_load_from_toml(self, table, error) if (allocated(error)) return call get_value(table, "module-prefix", self%module_prefix%s) + ! Load target OS from string and validate + call get_value(table, "target-os", os_string) + if (allocated(os_string)) then + ! Validate and convert OS string to integer + call validate_os_name(os_string, is_valid) + if (.not. is_valid) then + call fatal_error(error, "Invalid target OS: " // os_string) + return + end if + + self%target_os = match_os_type(os_string) + + else + ! Default to ALL OS if not specified + self%target_os = OS_ALL + end if + end subroutine model_load_from_toml +!> Get target platform configuration for the current model +function target_platform(self) result(target) + class(fpm_model_t), intent(in) :: self + type(platform_config_t) :: target + + ! Initialize platform with compiler and target OS + target = platform_config_t(self%compiler%id, self%target_os) + +end function target_platform + function get_package_libraries_link(model, package_name, prefix, exclude_self, dep_IDs, error) result(r) class(fpm_model_t), intent(in) :: model character(*), intent(in) :: package_name diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index ec73c0e425..5df271c23c 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -1107,7 +1107,7 @@ subroutine resolve_target_linking(targets, model, library, error) 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 diff --git a/test/fpm_test/main.f90 b/test/fpm_test/main.f90 index d272761f93..c6f11f1f2c 100644 --- a/test/fpm_test/main.f90 +++ b/test/fpm_test/main.f90 @@ -14,6 +14,7 @@ program fpm_testing use test_versioning, only : collect_versioning use test_settings, only : collect_settings use test_os, only: collect_os + use test_features, only : collect_features implicit none integer :: stat, is @@ -22,10 +23,11 @@ program fpm_testing character(len=*), parameter :: fmt = '("#", *(1x, a))' stat = 0 - + suite = [ & & new_testsuite("fpm_toml", collect_toml), & & new_testsuite("fpm_manifest", collect_manifest), & + & new_testsuite("fpm_features", collect_features), & & new_testsuite("fpm_filesystem", collect_filesystem), & & new_testsuite("fpm_source_parsing", collect_source_parsing), & & new_testsuite("fpm_module_dependencies", collect_module_dependencies), & diff --git a/test/fpm_test/test_compiler.f90 b/test/fpm_test/test_compiler.f90 index 66349f070e..99b7a3e377 100644 --- a/test/fpm_test/test_compiler.f90 +++ b/test/fpm_test/test_compiler.f90 @@ -125,7 +125,7 @@ subroutine test_check_c_source_runs(error) if (.not.compiler%check_c_source_runs( & '#include ' // new_line('a') // & 'int main() { printf("Hello C world!"); return 0; }')) then - call test_failed(error, "Cannot run C hello world") + call test_failed(error, "Cannot run C hello world with compiler "//compiler%cc) return end if diff --git a/test/fpm_test/test_features.f90 b/test/fpm_test/test_features.f90 new file mode 100644 index 0000000000..8743517c4c --- /dev/null +++ b/test/fpm_test/test_features.f90 @@ -0,0 +1,1100 @@ +!> Unit tests for FPM feature and feature collection functionality +module test_features + use testsuite, only : new_unittest, unittest_t, error_t, test_failed + use fpm_manifest, only: package_config_t, get_package_data + use fpm_manifest_feature, only: feature_config_t + use fpm_manifest_feature_collection, only: feature_collection_t + use fpm_manifest_platform, only: platform_config_t + use fpm_environment, only: OS_ALL, OS_LINUX, OS_MACOS, OS_WINDOWS + use fpm_compiler, only: id_all, id_gcc, id_intel_classic_nix, id_intel_classic_windows, id_intel_llvm_nix, & + match_compiler_type + use fpm_strings, only: string_t + use fpm_filesystem, only: get_temp_filename + implicit none + private + + public :: collect_features + +contains + + !> Collect all feature tests + subroutine collect_features(testsuite) + !> Collection of tests + type(unittest_t), allocatable, intent(out) :: testsuite(:) + + testsuite = [ & + & new_unittest("feature-collection-basic", test_feature_collection_basic), & + & new_unittest("feature-collection-flexible", test_feature_collection_flexible), & + & new_unittest("feature-collection-invalid", test_feature_collection_invalid, should_fail=.true.), & + & new_unittest("feature-collection-duplicates", test_feature_collection_duplicates, should_fail=.true.), & + & new_unittest("feature-collection-extract", test_feature_collection_extract), & + & new_unittest("feature-collection-platform-validation", test_feature_collection_platform_validation, & + & should_fail=.true.), & + & new_unittest("feature-collection-complex", test_feature_collection_complex), & + & new_unittest("feature-allocatable-conflict", test_feature_allocatable_conflict, should_fail=.true.), & + & new_unittest("feature-flag-addition", test_feature_flag_addition), & + & new_unittest("feature-metapackage-addition", test_feature_metapackage_addition), & + & new_unittest("feature-extract-gfortran-linux", test_feature_extract_gfortran_linux), & + & new_unittest("feature-extract-ifort-windows", test_feature_extract_ifort_windows), & + & 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) & + & ] + + end subroutine collect_features + + !> Test basic feature collection functionality + !> This should create two variants: gfortran+OS_ALL and ifort+OS_ALL (NOT duplicates) + subroutine test_feature_collection_basic(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 = "feature-test"', & + & 'version = "0.1.0"', & + & '[features]', & + & 'debug.gfortran.flags = "-Wall -g -fcheck=bounds"', & + & 'debug.ifort.flags = "/warn:all /check:all /traceback"', & + & 'release.flags = "-O3"' + close(unit) + + call get_package_data(package, temp_file, error) + + if (allocated(error)) return + + ! Check that feature collections were created + if (.not. allocated(package%features)) then + call test_failed(error, "Feature collections were not created") + return + end if + + ! Verify we have at least one collection + if (size(package%features) /= 2) then + call test_failed(error, "Invalid feature collections found, should be 2") + return + end if + + ! Check that the debug collection has variants + do i=1,2 + + if (package%features(i)%base%name=="debug") then + + if (.not. allocated(package%features(i)%variants)) then + call test_failed(error, "Debug collection variants were not created") + return + end if + + ! Should have exactly 2 variants: gfortran and ifort + if (size(package%features(i)%variants) /= 2) then + call test_failed(error, "Debug collection should have exactly 2 variants") + return + end if + + ! Check that variants have different platform configurations + if (package%features(i)%variants(1)%platform == package%features(i)%variants(2)%platform) then + call test_failed(error, "Variants should have different platform configurations: " & + //"variant1.compiler="//package%features(i)%variants(1)%platform%compiler_name() & + //" variant1.os="//package%features(i)%variants(1)%platform%os_name() & + //" variant2.compiler="//package%features(i)%variants(2)%platform%compiler_name() & + //" variant2.os="//package%features(i)%variants(2)%platform%os_name()) + return + end if + + else + + if (allocated(package%features(i)%variants)) then + if (size(package%features(i)%variants) > 0) then + call test_failed(error, "Release collection variants should not be created") + return + endif + end if + endif + + end do + + end subroutine test_feature_collection_basic + + !> Test flexible feature collection parsing with OS and compiler constraints + subroutine test_feature_collection_flexible(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 = "flexible-test"', & + & 'version = "0.1.0"', & + & '[features]', & + & 'myfeature.linux.gfortran.flags = "-fPIC -Wall"', & + & 'myfeature.windows.ifort.flags = "/fPIC /warn:all"', & + & 'myfeature.macos.flags = "-framework CoreFoundation"', & + & 'myfeature.preprocess.cpp.macros = ["-DMYFEATURE"]' + close(unit) + + call get_package_data(package, temp_file, error) + + if (allocated(error)) return + + ! Check that feature collections were created + if (.not. allocated(package%features)) then + call test_failed(error, "Feature collections were not created for flexible test") + return + end if + + ! Verify we have at least one collection + if (size(package%features) < 1) then + call test_failed(error, "No feature collections found in flexible test") + return + end if + + ! Check that base feature has been set + if (.not. allocated(package%features(1)%base%name)) then + call test_failed(error, "Base feature name not set in flexible test") + return + end if + + + end subroutine test_feature_collection_flexible + + !> Test invalid feature collection configuration (should fail) + subroutine test_feature_collection_invalid(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 = "invalid-test"', & + & 'version = "0.1.0"', & + & '[features]', & + & 'badfeature.unknownos.badcompiler.flags = "-invalid"', & + & 'badfeature.invalid-key-format = "should fail"' + close(unit) + + call get_package_data(package, temp_file, error) + + end subroutine test_feature_collection_invalid + + !> Test feature collection duplicate platform detection + subroutine test_feature_collection_duplicates(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 = "duplicate-test"', & + & 'version = "0.1.0"', & + & '[features]', & + & 'debug.gfortran.flags = "-g"', & + & 'debug.gfortran.c-flags = "-DDEBUG"' ! Duplicate gfortran platform + close(unit) + + call get_package_data(package, temp_file, error) + + ! This should fail due to duplicate gfortran platform + if (.not. allocated(error)) then + call test_failed(error, "Expected error for duplicate platform configurations was not generated") + return + end if + + ! Clear the expected error + deallocate(error) + + end subroutine test_feature_collection_duplicates + + !> Test feature collection extract_for_target functionality + subroutine test_feature_collection_extract(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_config_t) :: package + character(:), allocatable :: temp_file + integer :: unit + type(feature_config_t) :: extracted_feature + type(platform_config_t) :: target_platform + integer :: i + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'name = "extract-test"', & + & 'version = "0.1.0"', & + & '[features]', & + & 'debug.flags = "-g"', & + & 'debug.gfortran.flags = "-Wall"', & + & 'debug.ifort.flags = "/debug"' + close(unit) + + call get_package_data(package, temp_file, error) + if (allocated(error)) return + + ! Should have debug feature collection + if (.not. allocated(package%features) .or. size(package%features) < 1) then + call test_failed(error, "No feature collections found for extract test") + return + end if + + ! Find debug feature collection + do i = 1, size(package%features) + if (package%features(i)%base%name == "debug") then + + ! 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) + + ! Should have both base and gfortran-specific flags + if (.not. allocated(extracted_feature%flags)) then + call test_failed(error, "Extracted feature missing flags") + return + end if + + ! The extracted flags should contain both base and gfortran flags + ! (implementation details may vary but should have both -g and -Wall) + if (index(extracted_feature%flags, "-g") == 0) then + call test_failed(error, "Extracted feature missing base flags (-g)") + return + end if + + ! Test extraction for ifort + target_platform%compiler = id_intel_classic_nix + extracted_feature = package%features(i)%extract_for_target(target_platform) + + if (.not. allocated(extracted_feature%flags)) then + call test_failed(error, "Extracted ifort feature missing flags") + return + end if + + return ! Test passed + end if + end do + + call test_failed(error, "Debug feature collection not found for extract test") + + end subroutine test_feature_collection_extract + + !> Test feature collection platform validation + subroutine test_feature_collection_platform_validation(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 = "validation-test"', & + & 'version = "0.1.0"', & + & '[features]', & + & 'test.invalidcompiler.flags = "-test"' ! Invalid compiler name + close(unit) + + ! Should return error + call get_package_data(package, temp_file, error) + + end subroutine test_feature_collection_platform_validation + + !> Test complex feature collection hierarchy + subroutine test_feature_collection_complex(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_config_t) :: package + character(:), allocatable :: temp_file + integer :: unit + integer :: i, debug_variants, release_variants + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'name = "complex-test"', & + & 'version = "0.1.0"', & + & '[features]', & + & 'debug.flags = "-g"', & + & 'debug.gfortran.flags = "-Wall"', & + & 'debug.ifort.flags = "/debug"', & + & 'debug.linux.flags = "-DLINUX"', & + & 'debug.windows.ifort.flags = "/DEBUG:FULL"', & + & 'release.flags = "-O3"', & + & 'release.gfortran.flags = "-march=native"' + close(unit) + + call get_package_data(package, temp_file, error) + if (allocated(error)) return + + ! Should have 2 feature collections (debug and release) + if (.not. allocated(package%features) .or. size(package%features) /= 2) then + call test_failed(error, "Expected 2 feature collections for complex test") + return + end if + + debug_variants = 0 + release_variants = 0 + + do i = 1, size(package%features) + if (package%features(i)%base%name == "debug") then + if (allocated(package%features(i)%variants)) then + debug_variants = size(package%features(i)%variants) + end if + else if (package%features(i)%base%name == "release") then + if (allocated(package%features(i)%variants)) then + release_variants = size(package%features(i)%variants) + end if + end if + end do + + ! Debug should have multiple variants (gfortran, ifort, linux, windows+ifort) + if (debug_variants < 3) then + call test_failed(error, "Debug feature should have at least 3 variants in complex test") + return + end if + + ! Release should have 1 variant (gfortran) + if (release_variants /= 1) then + call test_failed(error, "Release feature should have exactly 1 variant in complex test") + return + end if + + end subroutine test_feature_collection_complex + + !> Test that allocatable configurations cannot appear in multiple variants (should fail) + subroutine test_feature_allocatable_conflict(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 = "conflict-test"', & + & 'version = "0.1.0"', & + & '[features]', & + & 'myfeature.gfortran.fortran.source-dir = "src/gfortran"', & + & 'myfeature.linux.fortran.source-dir = "src/linux"' + close(unit) + + ! Conflict: both would apply to gfortran+linux + call get_package_data(package, temp_file, error) + + end subroutine test_feature_allocatable_conflict + + !> Test that flags are properly added together (additive) + subroutine test_feature_flag_addition(error) + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_config_t) :: package + character(:), allocatable :: temp_file + integer :: unit + type(feature_config_t) :: extracted_feature + type(platform_config_t) :: target_platform + integer :: i + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'name = "addition-test"', & + & 'version = "0.1.0"', & + & '[features]', & + & 'myfeature.flags = "-DBASE"', & + & 'myfeature.gfortran.flags = "-DGFORTRAN"', & + & 'myfeature.linux.flags = "-DLINUX"' + close(unit) + + call get_package_data(package, temp_file, error) + if (allocated(error)) return + + ! Should have feature collection + if (.not. allocated(package%features) .or. size(package%features) < 1) then + call test_failed(error, "No feature collections found for addition test") + return + end if + + ! Find myfeature collection + do i = 1, size(package%features) + if (package%features(i)%base%name == "myfeature") then + + ! 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) + + ! Should have flags from base, gfortran, and linux variants + if (.not. allocated(extracted_feature%flags)) then + call test_failed(error, "Extracted feature missing flags") + return + end if + + ! Should contain all three flags (additive behavior) + if (index(extracted_feature%flags, "-DBASE") == 0) then + call test_failed(error, "Missing base flags (-DBASE)") + return + end if + + if (index(extracted_feature%flags, "-DGFORTRAN") == 0) then + call test_failed(error, "Missing compiler-specific flags (-DGFORTRAN)") + return + end if + + if (index(extracted_feature%flags, "-DLINUX") == 0) then + call test_failed(error, "Missing OS-specific flags (-DLINUX)") + return + end if + + return ! Test passed + end if + end do + + call test_failed(error, "myfeature collection not found for addition test") + + end subroutine test_feature_flag_addition + + !> Test that metapackages are properly combined with OR logic (additive) + subroutine test_feature_metapackage_addition(error) + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_config_t) :: package + character(:), allocatable :: temp_file + integer :: unit + type(feature_config_t) :: extracted_feature + type(platform_config_t) :: target_platform + integer :: i + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'name = "meta-test"', & + & 'version = "0.1.0"', & + & '[features]', & + & 'myfeature.dependencies.openmp = "*"', & + & 'myfeature.gfortran.dependencies.stdlib = "*"', & + & 'myfeature.linux.dependencies.mpi = "*"' + close(unit) + + call get_package_data(package, temp_file, error) + if (allocated(error)) return + + ! Should have feature collection + if (.not. allocated(package%features) .or. size(package%features) < 1) then + call test_failed(error, "No feature collections found for metapackage test") + return + end if + + ! Find myfeature collection + do i = 1, size(package%features) + if (package%features(i)%base%name == "myfeature") then + + ! 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) + + if (.not. package%features(i)%base%meta%openmp%on) then + call test_failed(error, "Missing base openmp metapackage") + return + end if + + ! Should have all three metapackages enabled (OR logic) + if (.not. extracted_feature%meta%openmp%on) then + call test_failed(error, "Missing openmp metapackage") + return + end if + + if (.not. extracted_feature%meta%stdlib%on) then + call test_failed(error, "Missing stdlib metapackage") + return + end if + + if (.not. extracted_feature%meta%mpi%on) then + call test_failed(error, "Missing mpi metapackage") + return + end if + + return ! Test passed + end if + end do + + call test_failed(error, "myfeature collection not found for metapackage test") + + end subroutine test_feature_metapackage_addition + + !> Test comprehensive feature extraction for gfortran+Linux target (flags + executables + build) + subroutine test_feature_extract_gfortran_linux(error) + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_config_t) :: package + character(:), allocatable :: temp_file + integer :: unit + type(feature_config_t) :: extracted_feature + type(platform_config_t) :: target_platform + integer :: i + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'name = "extract-test"', & + & 'version = "0.1.0"', & + & '[features]', & + & 'debug.flags = "-g"', & + & 'debug.gfortran.flags = "-Wall -fcheck=bounds"', & + & 'debug.linux.flags = "-DLINUX"', & + & 'debug.linux.gfortran.flags = "-fbacktrace"', & + & '[[features.debug.executable]]', & + & 'name = "base_prog"', & + & 'source-dir = "app"', & + & '[[features.debug.gfortran.executable]]', & + & 'name = "gfortran_prog"', & + & 'source-dir = "app/gfortran"', & + & '[[features.debug.linux.executable]]', & + & 'name = "linux_prog"', & + & 'source-dir = "app/linux"', & + & '[features.debug.gfortran.build]', & + & 'auto-executables = false' + close(unit) + + call get_package_data(package, temp_file, error) + if (allocated(error)) return + + ! Find debug collection and extract for gfortran+Linux + 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) + + ! Check flags are combined correctly + if (.not. allocated(extracted_feature%flags)) then + call test_failed(error, "No flags in extracted gfortran+Linux feature") + return + end if + + if (index(extracted_feature%flags, "-g") == 0 .or. & + index(extracted_feature%flags, "-Wall") == 0 .or. & + index(extracted_feature%flags, "-DLINUX") == 0 .or. & + index(extracted_feature%flags, "-fbacktrace") == 0) then + call test_failed(error, "Missing expected flags in gfortran+Linux extraction") + return + end if + + ! Check that all executables are combined (base + gfortran + linux) + if (.not. allocated(extracted_feature%executable) .or. size(extracted_feature%executable) < 3) then + call test_failed(error, "Wrong number of executables in gfortran+Linux (expected 3)") + return + end if + + ! Check that build config is set (only gfortran variant has it) + if (.not. allocated(extracted_feature%build)) then + call test_failed(error, "Missing build config in gfortran+Linux extraction") + return + end if + + if (extracted_feature%build%auto_executables) then + call test_failed(error, "Build config not applied correctly") + return + end if + + return ! Test passed + end if + end do + + call test_failed(error, "debug collection not found") + + end subroutine test_feature_extract_gfortran_linux + + !> Test comprehensive feature extraction for ifort+Windows target (flags + tests + library) + subroutine test_feature_extract_ifort_windows(error) + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_config_t) :: package + character(:), allocatable :: temp_file + integer :: unit + type(feature_config_t) :: extracted_feature + type(platform_config_t) :: target_platform + integer :: i + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'name = "extract-test"', & + & 'version = "0.1.0"', & + & '[features]', & + & 'debug.flags = "/debug"', & + & 'debug.ifort.flags = "/warn:all"', & + & 'debug.windows.flags = "/DWINDOWS"', & + & 'debug.linux.flags = "-DLINUX"', & ! Should not be included for Windows target + & '[[features.debug.test]]', & + & 'name = "base_test"', & + & 'source-dir = "test"', & + & '[[features.debug.ifort.test]]', & + & 'name = "ifort_test"', & + & 'source-dir = "test/ifort"', & + & '[[features.debug.windows.test]]', & + & 'name = "windows_test"', & + & 'source-dir = "test/windows"', & + & '[features.debug.windows.library]', & + & 'source-dir = "src/windows"' + close(unit) + + call get_package_data(package, temp_file, error) + if (allocated(error)) return + + ! Find debug collection and extract for gfortran+Windows + 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) + + ! Check flags: should have base + ifort + windows (but NOT linux) + if (.not. allocated(extracted_feature%flags)) then + call test_failed(error, "No flags in extracted ifort+Windows feature") + return + end if + + if (index(extracted_feature%flags, "/debug") == 0 .or. & + index(extracted_feature%flags, "/warn:all") == 0 .or. & + index(extracted_feature%flags, "/DWINDOWS") == 0) then + call test_failed(error, "Missing expected flags in ifort+Windows extraction. Got: '" & + //extracted_feature%flags//"'") + return + end if + + ! Should NOT have linux-specific flag + if (index(extracted_feature%flags, "-DLINUX") > 0) then + call test_failed(error, "Incorrectly included Linux flag -DLINUX in ifort+Windows") + return + end if + + ! Check that all tests are combined (base + ifort + windows) + if (.not. allocated(extracted_feature%test) .or. size(extracted_feature%test) < 3) then + call test_failed(error, "Wrong number of tests in ifort+Windows (expected 3)") + return + end if + + ! Check that library config is set (only windows variant has it) + if (.not. allocated(extracted_feature%library)) then + call test_failed(error, "Missing library config in ifort+Windows extraction") + return + end if + + if (extracted_feature%library%source_dir /= "src/windows") then + call test_failed(error, "Library config not applied correctly") + return + end if + + return ! Test passed + end if + end do + + call test_failed(error, "debug collection not found") + + end subroutine test_feature_extract_ifort_windows + + !> Test feature extraction with dependencies and examples for gfortran+macOS target + subroutine test_feature_extract_dependencies_examples(error) + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_config_t) :: package + character(:), allocatable :: temp_file + integer :: unit + type(feature_config_t) :: extracted_feature + type(platform_config_t) :: target_platform + integer :: i, j + logical :: has_gfortran_dep, has_macos_dep + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'name = "deps-test"', & + & 'version = "0.1.0"', & + & '[features]', & + & '[features.testing.dependencies]', & + & 'base_dep.git = "https://github.com/example/base"', & + & '[features.testing.gfortran.dependencies]', & + & 'gfortran_dep.git = "https://github.com/example/gfortran"', & + & '[features.testing.macos.dependencies]', & + & 'macos_dep.git = "https://github.com/example/macos"', & + & '[[features.testing.example]]', & + & 'name = "base_example"', & + & 'source-dir = "example"', & + & '[[features.testing.gfortran.example]]', & + & 'name = "gfortran_example"', & + & 'source-dir = "example/gfortran"', & + & '[[features.testing.macos.example]]', & + & 'name = "macos_example"', & + & 'source-dir = "example/macos"', & + & '[features.testing.macos.fortran]', & + & 'implicit-typing = false' + close(unit) + + call get_package_data(package, temp_file, error) + if (allocated(error)) return + + ! Find testing collection and extract for gfortran+macOS + 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) + + ! Check that all dependencies are combined (base + gfortran + macos) + if (.not. allocated(extracted_feature%dependency)) then + call test_failed(error, "Missing dependencies in gfortran+macOS extraction") + return + end if + + ! Verify that specific dependencies are present by checking names + has_gfortran_dep = .false. + has_macos_dep = .false. + + do j = 1, size(extracted_feature%dependency) + if (extracted_feature%dependency(j)%name == "gfortran_dep") then + has_gfortran_dep = .true. + end if + if (extracted_feature%dependency(j)%name == "macos_dep") then + has_macos_dep = .true. + end if + end do + + if (.not. has_gfortran_dep) then + call test_failed(error, "Missing gfortran_dep dependency in gfortran+macOS extraction") + return + end if + if (.not. has_macos_dep) then + call test_failed(error, "Missing macos_dep dependency in gfortran+macOS extraction") + return + end if + + ! Check that all examples are combined (base + gfortran + macos) + if (.not. allocated(extracted_feature%example) .or. size(extracted_feature%example) < 3) then + call test_failed(error, "Wrong number of examples in gfortran+macOS (expected 3)") + return + end if + + ! Check that fortran config is set (only macOS variant has it) + if (.not. allocated(extracted_feature%fortran)) then + call test_failed(error, "Missing fortran config in gfortran+macOS extraction") + return + end if + + if (extracted_feature%fortran%implicit_typing) then + call test_failed(error, "Fortran config not applied correctly - "// & + " implicit typing should be false") + return + end if + + return ! Test passed + end if + end do + + call test_failed(error, "testing collection not found") + + end subroutine test_feature_extract_dependencies_examples + + !> Test feature extraction with build configurations for ifort+Linux target + subroutine test_feature_extract_build_configs(error) + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_config_t) :: package + character(:), allocatable :: temp_file + integer :: unit + type(feature_config_t) :: extracted_feature + type(platform_config_t) :: target_platform + integer :: i + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'name = "build-test"', & + & 'version = "0.1.0"', & + & '[features]', & + & '[features.optimization.ifort.linux.build]', & + & 'auto-executables = false', & + & 'auto-tests = false', & + & 'link = ["mylib"]', & + & 'external-modules = ["external_mod"]' + close(unit) + + call get_package_data(package, temp_file, error) + if (allocated(error)) return + + ! Find optimization collection and extract for ifort+Linux + 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) + + ! Check that build config is present + if (.not. allocated(extracted_feature%build)) then + call test_failed(error, "Missing build config in ifort+Linux extraction") + return + end if + + ! Check that auto-executables is set correctly + if (extracted_feature%build%auto_executables) then + call test_failed(error, "Build config auto-executables should be false") + return + end if + + ! Check that auto-tests is set correctly + if (extracted_feature%build%auto_tests) then + call test_failed(error, "Build config auto-tests should be false") + return + end if + + ! Check that link libraries are present + if (.not. allocated(extracted_feature%build%link) .or. size(extracted_feature%build%link) < 1) then + call test_failed(error, "Missing link libraries in ifort+Linux build config") + return + end if + + ! Check that external modules are present + if (.not. allocated(extracted_feature%build%external_modules) & + .or. size(extracted_feature%build%external_modules) < 1) then + call test_failed(error, "Missing external modules in ifort+Linux build config") + return + end if + + return ! Test passed + end if + end do + + call test_failed(error, "optimization collection not found") + + end subroutine test_feature_extract_build_configs + + !> Test feature extraction with test configurations for gfortran+Windows target + subroutine test_feature_extract_test_configs(error) + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_config_t) :: package + character(:), allocatable :: temp_file + integer :: unit + type(feature_config_t) :: extracted_feature + type(platform_config_t) :: target_platform + integer :: i, j + logical :: has_base, has_gfortran, has_windows, has_specific + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'name = "test-configs"', & + & 'version = "0.1.0"', & + & '[features]', & + & '[[features.testing.test]]', & + & 'name = "base_test"', & + & 'source-dir = "test"', & + & '[[features.testing.gfortran.test]]', & + & 'name = "gfortran_test"', & + & 'source-dir = "test/gfortran"', & + & '[[features.testing.windows.test]]', & + & 'name = "windows_test"', & + & 'source-dir = "test/windows"', & + & '[[features.testing.gfortran.windows.test]]', & + & 'name = "gfortran_windows_test"', & + & 'source-dir = "test/gfortran_windows"' + close(unit) + + call get_package_data(package, temp_file, error) + if (allocated(error)) return + + ! Find testing collection and extract for gfortran+Windows + 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) + + ! 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 + call test_failed(error, "Wrong number of test configs in gfortran+Windows (expected 4)") + return + end if + + ! Verify that specific test configs are present by checking names + has_base = .false. + has_gfortran = .false. + has_windows = .false. + has_specific = .false. + + do j = 1, size(extracted_feature%test) + select case (extracted_feature%test(j)%name) + case ("base_test") + has_base = .true. + case ("gfortran_test") + has_gfortran = .true. + case ("windows_test") + has_windows = .true. + case ("gfortran_windows_test") + has_specific = .true. + end select + end do + + if (.not. has_base) then + call test_failed(error, "Missing base_test in gfortran+Windows extraction") + return + end if + if (.not. has_gfortran) then + call test_failed(error, "Missing gfortran_test in gfortran+Windows extraction") + return + end if + if (.not. has_windows) then + call test_failed(error, "Missing windows_test in gfortran+Windows extraction") + return + end if + if (.not. has_specific) then + call test_failed(error, "Missing gfortran_windows_test in gfortran+Windows extraction") + return + end if + + return ! Test passed + end if + end do + + call test_failed(error, "testing collection not found") + + end subroutine test_feature_extract_test_configs + + !> Test feature extraction with example configurations for ifx+macOS target + subroutine test_feature_extract_example_configs(error) + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_config_t) :: package + character(:), allocatable :: temp_file + integer :: unit + type(feature_config_t) :: extracted_feature + type(platform_config_t) :: target_platform + integer :: i, j + logical :: has_base, has_ifx, has_macos, has_specific + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'name = "example-configs"', & + & 'version = "0.1.0"', & + & '[features]', & + & '[[features.showcase.example]]', & + & 'name = "base_example"', & + & 'source-dir = "examples"', & + & '[[features.showcase.ifx.example]]', & + & 'name = "ifx_example"', & + & 'source-dir = "examples/ifx"', & + & '[[features.showcase.macos.example]]', & + & 'name = "macos_example"', & + & 'source-dir = "examples/macos"', & + & '[[features.showcase.ifx.macos.example]]', & + & 'name = "ifx_macos_example"', & + & 'source-dir = "examples/ifx_macos"' + close(unit) + + call get_package_data(package, temp_file, error) + if (allocated(error)) return + + ! Find showcase collection and extract for ifx+macOS + 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) + + ! 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 + call test_failed(error, "Wrong number of example configs in ifx+macOS (expected 4)") + return + end if + + ! Verify that specific example configs are present by checking names + has_base = .false. + has_ifx = .false. + has_macos = .false. + has_specific = .false. + + do j = 1, size(extracted_feature%example) + select case (extracted_feature%example(j)%name) + case ("base_example") + has_base = .true. + case ("ifx_example") + has_ifx = .true. + case ("macos_example") + has_macos = .true. + case ("ifx_macos_example") + has_specific = .true. + end select + end do + + if (.not. has_base) then + call test_failed(error, "Missing base_example in ifx+macOS extraction") + return + end if + if (.not. has_ifx) then + call test_failed(error, "Missing ifx_example in ifx+macOS extraction") + return + end if + if (.not. has_macos) then + call test_failed(error, "Missing macos_example in ifx+macOS extraction") + return + end if + if (.not. has_specific) then + call test_failed(error, "Missing ifx_macos_example in ifx+macOS extraction") + return + end if + + return ! Test passed + end if + end do + + call test_failed(error, "showcase collection not found") + + end subroutine test_feature_extract_example_configs + +end module test_features diff --git a/test/fpm_test/test_manifest.f90 b/test/fpm_test/test_manifest.f90 index 8e229d3d06..36be44af82 100644 --- a/test/fpm_test/test_manifest.f90 +++ b/test/fpm_test/test_manifest.f90 @@ -3,7 +3,11 @@ module test_manifest use fpm_filesystem, only: get_temp_filename use testsuite, only : new_unittest, unittest_t, error_t, test_failed, check_string use fpm_manifest - use fpm_manifest_profile, only: profile_config_t, find_profile + use fpm_manifest_profile, only: profile_config_t + use fpm_manifest_platform, only: platform_config_t + use fpm_compiler, only: id_gcc, id_intel_classic_nix + use fpm_environment, only: OS_LINUX + use fpm_manifest_feature, only: feature_config_t use fpm_strings, only: operator(.in.), string_t use fpm_error, only: fatal_error, error_t use tomlf, only : new_table, toml_table, toml_array @@ -15,12 +19,12 @@ module test_manifest contains !> Collect all exported unit tests - subroutine collect_manifest(tests) + subroutine collect_manifest(testsuite) !> Collection of tests - type(unittest_t), allocatable, intent(out) :: tests(:) + type(unittest_t), allocatable, intent(out) :: testsuite(:) - tests = [ & + testsuite = [ & & new_unittest("valid-manifest", test_valid_manifest), & & new_unittest("invalid-manifest", test_invalid_manifest, should_fail=.true.), & & new_unittest("default-library", test_default_library), & @@ -37,8 +41,9 @@ subroutine collect_manifest(tests) & new_unittest("dependency-wrongkey", test_dependency_wrongkey, should_fail=.true.), & & new_unittest("dependencies-empty", test_dependencies_empty), & & new_unittest("dependencies-typeerror", test_dependencies_typeerror, should_fail=.true.), & - & new_unittest("profiles", test_profiles), & - & new_unittest("profiles-keyvalue-table", test_profiles_keyvalue_table, should_fail=.true.), & + ! 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("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.), & @@ -75,7 +80,8 @@ subroutine collect_manifest(tests) & new_unittest("preprocess-wrongkey", test_preprocess_wrongkey, should_fail=.true.), & & 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.) & + & new_unittest("macro-parsing-dependency", & + & test_macro_parsing_dependency, should_fail=.false.) & & ] end subroutine collect_manifest @@ -303,13 +309,15 @@ subroutine test_default_executable(error) call check_string(error, package%executable(1)%name, name, & & "Default executable name") if (allocated(error)) return + + call package%feature_config_t%test_serialization('test_default_executable (feature only)',error) + if (allocated(error)) return call package%test_serialization('test_default_executable',error) if (allocated(error)) return end subroutine test_default_executable - - + !> Dependencies cannot be created from empty tables subroutine test_dependency_empty(error) use fpm_manifest_dependency @@ -527,7 +535,10 @@ subroutine test_dependencies_typeerror(error) end subroutine test_dependencies_typeerror - !> Include a table of profiles in toml, check whether they are parsed correctly and stored in package + !> 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. subroutine test_profiles(error) !> Error handling @@ -536,8 +547,9 @@ subroutine test_profiles(error) type(package_config_t) :: package character(len=*), parameter :: manifest = 'fpm-profiles.toml' integer :: unit - character(:), allocatable :: profile_name, compiler + character(:), allocatable :: profile_name logical :: profile_found + type(platform_config_t) :: target type(profile_config_t) :: chosen_profile open(file=manifest, newunit=unit) @@ -562,65 +574,67 @@ 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 (allocated(chosen_profile%flags)) 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 +! 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 end subroutine test_profiles - !> 'flags' is a key-value entry, test should fail as it is defined as a table + !> 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) !> Error handling diff --git a/test/fpm_test/test_package_dependencies.f90 b/test/fpm_test/test_package_dependencies.f90 index 76809b458e..d16a7f9c78 100644 --- a/test/fpm_test/test_package_dependencies.f90 +++ b/test/fpm_test/test_package_dependencies.f90 @@ -37,12 +37,12 @@ module test_package_dependencies contains !> Collect all exported unit tests - subroutine collect_package_dependencies(tests) + subroutine collect_package_dependencies(testsuite) !> Collection of tests - type(unittest_t), allocatable, intent(out) :: tests(:) + type(unittest_t), allocatable, intent(out) :: testsuite(:) - tests = [ & + testsuite = [ & & new_unittest("cache-load-dump", test_cache_load_dump), & & new_unittest("cache-dump-load", test_cache_dump_load), & & new_unittest("status-after-load", test_status), & diff --git a/test/fpm_test/test_toml.f90 b/test/fpm_test/test_toml.f90 index 416cc2f7ed..e688e4a8c0 100644 --- a/test/fpm_test/test_toml.f90 +++ b/test/fpm_test/test_toml.f90 @@ -18,11 +18,15 @@ module test_toml 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 + use fpm_environment, only: OS_ALL, OS_LINUX, OS_MACOS use fpm_versioning, only: new_version use fpm_strings, only: string_t, operator(==), split use fpm_model, only: fortran_config_t, package_t, FPM_SCOPE_LIB, FPM_UNIT_MODULE, fpm_model_t, & & srcfile_t - use fpm_compiler, only: archiver_t, compiler_t, id_gcc + use fpm_compiler, only: archiver_t, compiler_t, id_all, id_gcc use fpm_error, only: fatal_error @@ -72,7 +76,10 @@ subroutine collect_toml(testsuite) & new_unittest("serialize-compiler", compiler_roundtrip), & & new_unittest("serialize-compiler-invalid", compiler_invalid, should_fail=.true.), & & new_unittest("serialize-model", fpm_model_roundtrip), & - & new_unittest("serialize-model-invalid", fpm_model_invalid, should_fail=.true.)] + & 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)] + end subroutine collect_toml @@ -1298,4 +1305,50 @@ subroutine file_scope_flag_roundtrip(error) end subroutine file_scope_flag_roundtrip + !> Test a metapackage configuration + subroutine metapackage_config_roundtrip(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(metapackage_config_t) :: meta + + meta%mpi%on = .true. + meta%mpi%version = "MPICH" + meta%minpack%on = .true. + meta%blas%on = .false. + + call meta%test_serialization('metapackage_config_t', error) + + end subroutine metapackage_config_roundtrip + + subroutine feature_collection_roundtrip(error) + type(error_t), allocatable, intent(out) :: error + type(feature_collection_t) :: fc + + ! Base feature (applies everywhere) + fc%base%name = "my_blas" + fc%base%flags = "-O2" + fc%base%link_time_flags = "-lblas -llapack" + + ! Two platform/compiler-specific variants + if (allocated(fc%variants)) deallocate(fc%variants) + allocate(fc%variants(2)) + + ! Variant 1: GCC on Linux → OpenBLAS + fc%variants(1)%name = "my_blas" + fc%variants(1)%platform = platform_config_t("gfortran",OS_LINUX) + fc%variants(1)%link_time_flags = "-lopenblas" + + ! Variant 2: any compiler on macOS → Accelerate framework + fc%variants(2)%name = "my_blas" + fc%variants(2)%platform = platform_config_t("all",OS_MACOS) + fc%variants(2)%link_time_flags = "-framework Accelerate" + + ! Round-trip via the generic serialization tester + call fc%test_serialization('feature_collection: base + 2 variants', error) + + end subroutine feature_collection_roundtrip + + end module test_toml