From ef6532b434e577109c639e442d06dc65f668dd1a Mon Sep 17 00:00:00 2001 From: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> Date: Fri, 7 Apr 2023 09:53:13 +0200 Subject: [PATCH] Add support for toggling Fortran features (#864) - implicit-typing: toggle default implicit typing rules - option to disable in GFortran - option to enable in LFortran - implicit-external: toggle implicit external interfaces - option to disable in GFortran - option to enable in LFortran - source-form: select source form ("free", "fixed", or "default") - option to set free/fixed form in GFortran - option to set fixed form in LFortran --- ci/run_tests.sh | 8 + example_packages/fixed-form/app/main.f90 | 4 + example_packages/fixed-form/fpm.toml | 2 + example_packages/fixed-form/src/lib.f90 | 7 + example_packages/free-form/app/main.f | 4 + example_packages/free-form/fpm.toml | 3 + example_packages/free-form/src/lib.f | 6 + .../implicit-external/app/main.f90 | 5 + example_packages/implicit-external/fpm.toml | 2 + .../implicit-external/src/impl.f90 | 4 + example_packages/implicit-typing/app/main.f90 | 4 + example_packages/implicit-typing/fpm.toml | 2 + example_packages/implicit-typing/src/impl.f90 | 3 + src/fpm.f90 | 7 +- src/fpm/manifest/fortran.f90 | 105 +++++++++++++ src/fpm/manifest/package.f90 | 15 +- src/fpm_compiler.F90 | 140 +++++++++++++++++- src/fpm_model.f90 | 21 ++- src/fpm_targets.f90 | 38 ++++- 19 files changed, 368 insertions(+), 12 deletions(-) create mode 100644 example_packages/fixed-form/app/main.f90 create mode 100644 example_packages/fixed-form/fpm.toml create mode 100644 example_packages/fixed-form/src/lib.f90 create mode 100644 example_packages/free-form/app/main.f create mode 100644 example_packages/free-form/fpm.toml create mode 100644 example_packages/free-form/src/lib.f create mode 100644 example_packages/implicit-external/app/main.f90 create mode 100644 example_packages/implicit-external/fpm.toml create mode 100644 example_packages/implicit-external/src/impl.f90 create mode 100644 example_packages/implicit-typing/app/main.f90 create mode 100644 example_packages/implicit-typing/fpm.toml create mode 100644 example_packages/implicit-typing/src/impl.f90 create mode 100644 src/fpm/manifest/fortran.f90 diff --git a/ci/run_tests.sh b/ci/run_tests.sh index ddbd3af9b2..45f45b6226 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -158,6 +158,14 @@ pushd cpp_files "$fpm" test popd +# Test Fortran features +for feature in free-form fixed-form implicit-typing implicit-external +do + pushd $feature + "$fpm" run + popd +done + # Test app exit codes pushd fpm_test_exit_code "$fpm" build diff --git a/example_packages/fixed-form/app/main.f90 b/example_packages/fixed-form/app/main.f90 new file mode 100644 index 0000000000..4524bbd8d0 --- /dev/null +++ b/example_packages/fixed-form/app/main.f90 @@ -0,0 +1,4 @@ + program test + use lib + call hello + end diff --git a/example_packages/fixed-form/fpm.toml b/example_packages/fixed-form/fpm.toml new file mode 100644 index 0000000000..26b8e4bb68 --- /dev/null +++ b/example_packages/fixed-form/fpm.toml @@ -0,0 +1,2 @@ +name = "fixed-form" +fortran.source-form = "fixed" diff --git a/example_packages/fixed-form/src/lib.f90 b/example_packages/fixed-form/src/lib.f90 new file mode 100644 index 0000000000..a2ed363db1 --- /dev/null +++ b/example_packages/fixed-form/src/lib.f90 @@ -0,0 +1,7 @@ + module lib + contains + subroutine h e l l o + print '(a)', + +"Hello, fixed world!" + end subroutine + end module diff --git a/example_packages/free-form/app/main.f b/example_packages/free-form/app/main.f new file mode 100644 index 0000000000..e2d305a049 --- /dev/null +++ b/example_packages/free-form/app/main.f @@ -0,0 +1,4 @@ +program test +use lib +call hello +end diff --git a/example_packages/free-form/fpm.toml b/example_packages/free-form/fpm.toml new file mode 100644 index 0000000000..c10afba2a6 --- /dev/null +++ b/example_packages/free-form/fpm.toml @@ -0,0 +1,3 @@ +name = "free-form" +fortran.source-form = "free" +executable = [{main="main.f", name="free-form"}] diff --git a/example_packages/free-form/src/lib.f b/example_packages/free-form/src/lib.f new file mode 100644 index 0000000000..520d6265c9 --- /dev/null +++ b/example_packages/free-form/src/lib.f @@ -0,0 +1,6 @@ +module lib +contains +subroutine hello +print '(a)', "Hello, free world!" +end subroutine +end module diff --git a/example_packages/implicit-external/app/main.f90 b/example_packages/implicit-external/app/main.f90 new file mode 100644 index 0000000000..5b6e8f6fc5 --- /dev/null +++ b/example_packages/implicit-external/app/main.f90 @@ -0,0 +1,5 @@ +program test + integer :: ijk + call impl(ijk) + if (ijk /= 1) error stop +end program test diff --git a/example_packages/implicit-external/fpm.toml b/example_packages/implicit-external/fpm.toml new file mode 100644 index 0000000000..c32145c56f --- /dev/null +++ b/example_packages/implicit-external/fpm.toml @@ -0,0 +1,2 @@ +name = "implicit-external" +fortran.implicit-external = true diff --git a/example_packages/implicit-external/src/impl.f90 b/example_packages/implicit-external/src/impl.f90 new file mode 100644 index 0000000000..1b609f561f --- /dev/null +++ b/example_packages/implicit-external/src/impl.f90 @@ -0,0 +1,4 @@ +subroutine impl(ijk) + integer :: ijk + ijk = 1 +end subroutine impl diff --git a/example_packages/implicit-typing/app/main.f90 b/example_packages/implicit-typing/app/main.f90 new file mode 100644 index 0000000000..944d95ede3 --- /dev/null +++ b/example_packages/implicit-typing/app/main.f90 @@ -0,0 +1,4 @@ +program test + use impl + if (ijk /= 1) error stop +end program diff --git a/example_packages/implicit-typing/fpm.toml b/example_packages/implicit-typing/fpm.toml new file mode 100644 index 0000000000..fe5c635069 --- /dev/null +++ b/example_packages/implicit-typing/fpm.toml @@ -0,0 +1,2 @@ +name = "implicit-typing" +fortran.implicit-typing = true diff --git a/example_packages/implicit-typing/src/impl.f90 b/example_packages/implicit-typing/src/impl.f90 new file mode 100644 index 0000000000..1803cb3cc9 --- /dev/null +++ b/example_packages/implicit-typing/src/impl.f90 @@ -0,0 +1,3 @@ +module impl + parameter(ijk = 1) +end module diff --git a/src/fpm.f90 b/src/fpm.f90 index 51a1bb16f5..26d85c49f6 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -10,7 +10,7 @@ module fpm use fpm_environment, only: get_env use fpm_filesystem, only: is_dir, join_path, list_files, exists, & basename, filewrite, mkdir, run, os_delete_dir -use fpm_model, only: fpm_model_t, srcfile_t, show_model, & +use fpm_model, only: fpm_model_t, srcfile_t, show_model, fortran_features_t, & FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, FPM_SCOPE_DEP, & FPM_SCOPE_APP, FPM_SCOPE_EXAMPLE, FPM_SCOPE_TEST use fpm_compiler, only: new_compiler, new_archiver, set_cpp_preprocessor_flags @@ -112,6 +112,11 @@ subroutine build_model(model, settings, package, error) if (allocated(error)) exit model%packages(i)%name = dependency%name + associate(features => model%packages(i)%features) + features%implicit_typing = dependency%fortran%implicit_typing + features%implicit_external = dependency%fortran%implicit_external + features%source_form = dependency%fortran%source_form + end associate call package%version%to_string(version) model%packages(i)%version = version diff --git a/src/fpm/manifest/fortran.f90 b/src/fpm/manifest/fortran.f90 new file mode 100644 index 0000000000..bf76fa2e38 --- /dev/null +++ b/src/fpm/manifest/fortran.f90 @@ -0,0 +1,105 @@ +module fpm_manifest_fortran + use fpm_error, only : error_t, syntax_error, fatal_error + use fpm_toml, only : toml_table, toml_key, toml_stat, get_value + implicit none + private + + public :: fortran_config_t, new_fortran_config + + !> Configuration data for Fortran + type :: fortran_config_t + + !> Enable default implicit typing + logical :: implicit_typing + + !> Enable implicit external interfaces + logical :: implicit_external + + !> Form to use for all Fortran sources + character(:), allocatable :: source_form + + end type fortran_config_t + +contains + + !> Construct a new build configuration from a TOML data structure + subroutine new_fortran_config(self, table, error) + + !> Instance of the fortran configuration + type(fortran_config_t), intent(out) :: self + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: stat + character(:), allocatable :: source_form + + call check(table, error) + if (allocated(error)) return + + call get_value(table, "implicit-typing", self%implicit_typing, .false., stat=stat) + + if (stat /= toml_stat%success) then + call fatal_error(error,"Error while reading value for 'implicit-typing' in fpm.toml, expecting logical") + return + end if + + call get_value(table, "implicit-external", self%implicit_external, .false., stat=stat) + + if (stat /= toml_stat%success) then + call fatal_error(error,"Error while reading value for 'implicit-external' in fpm.toml, expecting logical") + return + end if + + call get_value(table, "source-form", source_form, "free", stat=stat) + + if (stat /= toml_stat%success) then + call fatal_error(error,"Error while reading value for 'source-form' in fpm.toml, expecting logical") + return + end if + select case(source_form) + case default + call fatal_error(error,"Value of source-form cannot be '"//source_form//"'") + return + case("free", "fixed", "default") + self%source_form = source_form + end select + + end subroutine new_fortran_config + + !> 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) + + ! table can be empty + if (size(list) < 1) return + + do ikey = 1, size(list) + select case(list(ikey)%key) + + case("implicit-typing", "implicit-external", "source-form") + continue + + case default + call syntax_error(error, "Key "//list(ikey)%key//" is not allowed in fortran") + exit + + end select + end do + + end subroutine check + +end module fpm_manifest_fortran diff --git a/src/fpm/manifest/package.f90 b/src/fpm/manifest/package.f90 index de124a0b3e..e966bfa461 100644 --- a/src/fpm/manifest/package.f90 +++ b/src/fpm/manifest/package.f90 @@ -27,6 +27,7 @@ !>[profiles] !>[build] !>[install] +!>[fortran] !>[[ executable ]] !>[[ example ]] !>[[ test ]] @@ -38,6 +39,7 @@ module fpm_manifest_package use fpm_manifest_profile, only : profile_config_t, new_profiles, get_default_profiles use fpm_manifest_example, only : example_config_t, new_example use fpm_manifest_executable, only : executable_config_t, new_executable + use fpm_manifest_fortran, only : fortran_config_t, new_fortran_config 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 @@ -75,6 +77,9 @@ module fpm_manifest_package !> Installation configuration data type(install_config_t) :: install + !> Fortran meta data + type(fortran_config_t) :: fortran + !> Library meta data type(library_config_t), allocatable :: library @@ -173,6 +178,14 @@ subroutine new_package(self, table, root, error) call new_install_config(self%install, child, error) if (allocated(error)) return + 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) + if (allocated(error)) return + call get_value(table, "version", version, "0") call new_version(self%version, version, error) if (allocated(error) .and. present(root)) then @@ -328,7 +341,7 @@ subroutine check(table, error) case("version", "license", "author", "maintainer", "copyright", & & "description", "keywords", "categories", "homepage", "build", & & "dependencies", "dev-dependencies", "profiles", "test", "executable", & - & "example", "library", "install", "extra", "preprocess") + & "example", "library", "install", "extra", "preprocess", "fortran") continue end select diff --git a/src/fpm_compiler.F90 b/src/fpm_compiler.F90 index dee49f9f90..68b9c4af96 100644 --- a/src/fpm_compiler.F90 +++ b/src/fpm_compiler.F90 @@ -94,6 +94,8 @@ module fpm_compiler procedure :: get_module_flag !> Get flag for include directories procedure :: get_include_flag + !> Get feature flag + procedure :: get_feature_flag !> Compile a Fortran object procedure :: compile_fortran !> Compile a C object @@ -137,17 +139,23 @@ module fpm_compiler flag_gnu_opt = " -O3 -funroll-loops", & flag_gnu_debug = " -g", & flag_gnu_pic = " -fPIC", & - flag_gnu_warn = " -Wall -Wextra -Wimplicit-interface", & + flag_gnu_warn = " -Wall -Wextra", & flag_gnu_check = " -fcheck=bounds -fcheck=array-temps", & flag_gnu_limit = " -fmax-errors=1", & - flag_gnu_external = " -Wimplicit-interface" + flag_gnu_external = " -Wimplicit-interface", & + flag_gnu_no_implicit_typing = " -fimplicit-none", & + flag_gnu_no_implicit_external = " -Werror=implicit-interface", & + flag_gnu_free_form = " -ffree-form", & + flag_gnu_fixed_form = " -ffixed-form" character(*), parameter :: & flag_pgi_backslash = " -Mbackslash", & flag_pgi_traceback = " -traceback", & flag_pgi_debug = " -g", & flag_pgi_check = " -Mbounds -Mchkptr -Mchkstk", & - flag_pgi_warn = " -Minform=inform" + flag_pgi_warn = " -Minform=inform", & + flag_pgi_free_form = " -Mfree", & + flag_pgi_fixed_form = " -Mfixed" character(*), parameter :: & flag_ibmxl_backslash = " -qnoescape" @@ -162,7 +170,9 @@ module fpm_compiler flag_intel_limit = " -error-limit 1", & flag_intel_pthread = " -reentrancy threaded", & flag_intel_nogen = " -nogen-interfaces", & - flag_intel_byterecl = " -assume byterecl" + flag_intel_byterecl = " -assume byterecl", & + flag_intel_free_form = " -free", & + flag_intel_fixed_form = " -fixed" character(*), parameter :: & flag_intel_backtrace_win = " /traceback", & @@ -174,7 +184,9 @@ module fpm_compiler flag_intel_limit_win = " /error-limit:1", & flag_intel_pthread_win = " /reentrancy:threaded", & flag_intel_nogen_win = " /nogen-interfaces", & - flag_intel_byterecl_win = " /assume:byterecl" + flag_intel_byterecl_win = " /assume:byterecl", & + flag_intel_free_form_win = " /free", & + flag_intel_fixed_form_win = " /fixed" character(*), parameter :: & flag_nag_coarray = " -coarray=single", & @@ -182,11 +194,23 @@ module fpm_compiler flag_nag_check = " -C", & flag_nag_debug = " -g -O0", & flag_nag_opt = " -O4", & - flag_nag_backtrace = " -gline" + flag_nag_backtrace = " -gline", & + flag_nag_free_form = " -free", & + flag_nag_fixed_form = " -fixed", & + flag_nag_no_implicit_typing = " -u" character(*), parameter :: & - flag_lfortran_opt = " --fast" + flag_lfortran_opt = " --fast", & + flag_lfortran_implicit_typing = " --implicit-typing", & + flag_lfortran_implicit_external = " --allow-implicit-interface", & + flag_lfortran_fixed_form = " --fixed-form" + +character(*), parameter :: & + flag_cray_no_implicit_typing = " -dl", & + flag_cray_implicit_typing = " -el", & + flag_cray_fixed_form = " -ffixed", & + flag_cray_free_form = " -ffree" contains @@ -539,6 +563,108 @@ function get_module_flag(self, path) result(flags) end function get_module_flag +function get_feature_flag(self, feature) result(flags) + class(compiler_t), intent(in) :: self + character(len=*), intent(in) :: feature + character(len=:), allocatable :: flags + + flags = "" + select case(feature) + case("no-implicit-typing") + select case(self%id) + case(id_caf, id_gcc, id_f95) + flags = flag_gnu_no_implicit_typing + + case(id_nag) + flags = flag_nag_no_implicit_typing + + case(id_cray) + flags = flag_cray_no_implicit_typing + + end select + + case("implicit-typing") + select case(self%id) + case(id_cray) + flags = flag_cray_implicit_typing + + case(id_lfortran) + flags = flag_lfortran_implicit_typing + + end select + + case("no-implicit-external") + select case(self%id) + case(id_caf, id_gcc, id_f95) + flags = flag_gnu_no_implicit_external + + end select + + case("implicit-external") + select case(self%id) + case(id_lfortran) + flags = flag_lfortran_implicit_external + + end select + + case("free-form") + select case(self%id) + case(id_caf, id_gcc, id_f95) + flags = flag_gnu_free_form + + case(id_pgi, id_nvhpc, id_flang) + flags = flag_pgi_free_form + + case(id_nag) + flags = flag_nag_free_form + + case(id_intel_classic_nix, id_intel_classic_mac, id_intel_llvm_nix, & + & id_intel_llvm_unknown) + flags = flag_intel_free_form + + case(id_intel_classic_windows, id_intel_llvm_windows) + flags = flag_intel_free_form_win + + case(id_cray) + flags = flag_cray_free_form + + end select + + case("fixed-form") + select case(self%id) + case(id_caf, id_gcc, id_f95) + flags = flag_gnu_fixed_form + + case(id_pgi, id_nvhpc, id_flang) + flags = flag_pgi_fixed_form + + case(id_nag) + flags = flag_nag_fixed_form + + case(id_intel_classic_nix, id_intel_classic_mac, id_intel_llvm_nix, & + & id_intel_llvm_unknown) + flags = flag_intel_fixed_form + + case(id_intel_classic_windows, id_intel_llvm_windows) + flags = flag_intel_fixed_form_win + + case(id_cray) + flags = flag_cray_fixed_form + + case(id_lfortran) + flags = flag_lfortran_fixed_form + + end select + + case("default-form") + continue + + case default + error stop "Unknown feature '"//feature//"'" + end select +end function get_feature_flag + + subroutine get_default_c_compiler(f_compiler, c_compiler) character(len=*), intent(in) :: f_compiler character(len=:), allocatable, intent(out) :: c_compiler diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index c5fe38cc77..dba15a8161 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -42,7 +42,7 @@ module fpm_model implicit none private -public :: fpm_model_t, srcfile_t, show_model +public :: fpm_model_t, srcfile_t, show_model, fortran_features_t public :: FPM_UNIT_UNKNOWN, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, & @@ -79,6 +79,18 @@ module fpm_model integer, parameter :: FPM_SCOPE_TEST = 4 integer, parameter :: FPM_SCOPE_EXAMPLE = 5 +!> Enabled Fortran language features +type :: fortran_features_t + + !> Use default implicit typing + logical :: implicit_typing = .false. + + !> Use implicit external interface + logical :: implicit_external = .false. + + !> Form to use for all Fortran sources + character(:), allocatable :: source_form +end type fortran_features_t !> Type for describing a source file type srcfile_t @@ -132,8 +144,13 @@ module fpm_model !> Module naming conventions logical :: enforce_module_names + + !> Prefix for all module names type(string_t) :: module_prefix + !> Language features + type(fortran_features_t) :: features + end type package_t @@ -185,6 +202,8 @@ module fpm_model !> Whether module names should be prefixed with the package name logical :: enforce_module_names = .false. + + !> Prefix for all module names type(string_t) :: module_prefix end type fpm_model_t diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index c01cd4ee15..e7ec525c09 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -27,6 +27,7 @@ module fpm_targets use iso_fortran_env, only: int64 use fpm_error, only: error_t, fatal_error, fpm_stop use fpm_model +use fpm_compiler, only : compiler_t use fpm_environment, only: get_os_type, OS_WINDOWS, OS_MACOS use fpm_filesystem, only: dirname, join_path, canon_path use fpm_strings, only: string_t, operator(.in.), string_cat, fnv_1a, resize, lower, str_ends_with @@ -114,6 +115,9 @@ module fpm_targets !> Flag set if build target will be skipped (not built) logical :: skip = .false. + !> Language features + type(fortran_features_t) :: features + !> Targets in the same schedule group are guaranteed to be independent integer :: schedule = -1 @@ -233,6 +237,7 @@ subroutine build_target_list(targets,model) type = merge(FPM_TARGET_C_OBJECT,FPM_TARGET_OBJECT,& sources(i)%unit_type==FPM_UNIT_CSOURCE), & output_name = get_object_name(sources(i)), & + features = model%packages(j)%features, & macros = model%packages(j)%macros, & version = model%packages(j)%version) @@ -279,6 +284,7 @@ subroutine build_target_list(targets,model) call add_target(targets,package=model%packages(j)%name,type = exe_type,& output_name = get_object_name(sources(i)), & source = sources(i), & + features = model%packages(j)%features, & macros = model%packages(j)%macros & ) @@ -397,13 +403,15 @@ end subroutine collect_exe_link_dependencies !> Allocate a new target and append to target list -subroutine add_target(targets,package,type,output_name,source,link_libraries, macros, version) +subroutine add_target(targets, package, type, output_name, source, link_libraries, & + & features, macros, version) type(build_target_ptr), allocatable, intent(inout) :: targets(:) character(*), intent(in) :: package integer, intent(in) :: type character(*), intent(in) :: output_name type(srcfile_t), intent(in), optional :: source type(string_t), intent(in), optional :: link_libraries(:) + type(fortran_features_t), intent(in), optional :: features type(string_t), intent(in), optional :: macros(:) character(*), intent(in), optional :: version @@ -432,6 +440,7 @@ subroutine add_target(targets,package,type,output_name,source,link_libraries, ma new_target%package_name = package if (present(source)) new_target%source = source if (present(link_libraries)) new_target%link_libraries = link_libraries + if (present(features)) new_target%features = features if (present(macros)) new_target%macros = macros if (present(version)) new_target%version = version allocate(new_target%dependencies(0)) @@ -801,7 +810,8 @@ subroutine resolve_target_linking(targets, model) associate(target => targets(i)%ptr) if (target%target_type /= FPM_TARGET_C_OBJECT .and. target%target_type /= FPM_TARGET_CPP_OBJECT) then - target%compile_flags = model%fortran_compile_flags + target%compile_flags = model%fortran_compile_flags & + & // get_feature_flags(model%compiler, target%features) else if (target%target_type == FPM_TARGET_C_OBJECT) then target%compile_flags = model%c_compile_flags else if(target%target_type == FPM_TARGET_CPP_OBJECT) then @@ -1029,4 +1039,28 @@ subroutine filter_modules(targets, list) end subroutine filter_modules +function get_feature_flags(compiler, features) result(flags) + type(compiler_t), intent(in) :: compiler + type(fortran_features_t), intent(in) :: features + character(:), allocatable :: flags + + flags = "" + if (features%implicit_typing) then + flags = flags // compiler%get_feature_flag("implicit-typing") + else + flags = flags // compiler%get_feature_flag("no-implicit-typing") + end if + + if (features%implicit_external) then + flags = flags // compiler%get_feature_flag("implicit-external") + else + flags = flags // compiler%get_feature_flag("no-implicit-external") + end if + + if (allocated(features%source_form)) then + flags = flags // compiler%get_feature_flag(features%source_form//"-form") + end if +end function get_feature_flags + + end module fpm_targets