From 194f051c5e0f862374ba5cfc06ea95badea59bb1 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 12 Jan 2023 11:02:51 +0100 Subject: [PATCH 01/31] Add `--no-module-names` switch to fpm build settings --- .gitignore | 3 +++ src/fpm_command_line.f90 | 22 +++++++++++++++++----- 2 files changed, 20 insertions(+), 5 deletions(-) diff --git a/.gitignore b/.gitignore index 9169294354..794667bf94 100644 --- a/.gitignore +++ b/.gitignore @@ -2,3 +2,6 @@ build/* # Visual Studio Code .vscode/ + +# CodeBlocks +project/ diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 659acd1950..3a6587263a 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -72,6 +72,8 @@ module fpm_command_line logical :: show_model=.false. logical :: build_tests=.false. logical :: prune=.true. + !> Request all module names in package and dependencies to begin with their package name + logical :: enforce_module_names=.true. character(len=:),allocatable :: compiler character(len=:),allocatable :: c_compiler character(len=:),allocatable :: cxx_compiler @@ -140,7 +142,11 @@ module fpm_command_line ' high optimization and "debug" for full debug options. ',& ' If --flag is not specified the "debug" flags are the ',& ' default. ',& - ' --no-prune Disable tree-shaking/pruning of unused module dependencies '& + ' --no-prune Disable tree-shaking/pruning of unused module dependencies ',& + ' --no-module-names Disable enforcing module naming conventions. If specified ',& + ' modules in the package and its dependencies will only be ',& + ' checked for duplicates; otherwise, all modules are enforced ',& + ' to begin with their package name. '& ] ! '12345678901234567890123456789012345678901234567890123456789012345678901234567890',& character(len=80), parameter :: help_text_compiler(*) = [character(len=80) :: & @@ -257,6 +263,7 @@ subroutine get_command_line_settings(cmd_settings) compiler_args = & ' --profile " "' // & ' --no-prune F' // & + ' --no-module-names F' // & ' --compiler "'//get_fpm_env(fc_env, fc_default)//'"' // & ' --c-compiler "'//get_fpm_env(cc_env, cc_default)//'"' // & ' --cxx-compiler "'//get_fpm_env(cxx_env, cxx_default)//'"' // & @@ -311,6 +318,7 @@ subroutine get_command_line_settings(cmd_settings) & args=remaining,& & profile=val_profile,& & prune=.not.lget('no-prune'), & + & enforce_module_names=.not.lget('no-module-names'), & & compiler=val_compiler, & & c_compiler=c_compiler, & & cxx_compiler=cxx_compiler, & @@ -342,6 +350,7 @@ subroutine get_command_line_settings(cmd_settings) cmd_settings=fpm_build_settings( & & profile=val_profile,& & prune=.not.lget('no-prune'), & + & enforce_module_names=.not.lget('no-module-names'), & & compiler=val_compiler, & & c_compiler=c_compiler, & & cxx_compiler=cxx_compiler, & @@ -497,6 +506,7 @@ subroutine get_command_line_settings(cmd_settings) list=lget('list'), & profile=val_profile,& prune=.not.lget('no-prune'), & + enforce_module_names=.not.lget('no-module-names'), & compiler=val_compiler, & c_compiler=c_compiler, & cxx_compiler=cxx_compiler, & @@ -557,6 +567,7 @@ subroutine get_command_line_settings(cmd_settings) & args=remaining, & & profile=val_profile, & & prune=.not.lget('no-prune'), & + & enforce_module_names=.not.lget('no-module-names'), & & compiler=val_compiler, & & c_compiler=c_compiler, & & cxx_compiler=cxx_compiler, & @@ -690,7 +701,7 @@ subroutine set_help() help_list_dash = [character(len=80) :: & ' ', & ' build [--compiler COMPILER_NAME] [--profile PROF] [--flag FFLAGS] [--list] ', & - ' [--tests] [--no-prune] ', & + ' [--tests] [--no-prune] [--no-module-names] ', & ' help [NAME(s)] ', & ' new NAME [[--lib|--src] [--app] [--test] [--example]]| ', & ' [--full|--bare][--backfill] ', & @@ -811,15 +822,16 @@ subroutine set_help() ' Their syntax is ', & ' ', & ' build [--profile PROF] [--flag FFLAGS] [--list] [--compiler COMPILER_NAME] ', & - ' [--tests] [--no-prune] ', & + ' [--tests] [--no-prune] [--no-module-names] ', & ' new NAME [[--lib|--src] [--app] [--test] [--example]]| ', & ' [--full|--bare][--backfill] ', & ' update [NAME(s)] [--fetch-only] [--clean] ', & ' run [[--target] NAME(s)] [--profile PROF] [--flag FFLAGS] [--list] [--all] ', & ' [--example] [--runner "CMD"] [--compiler COMPILER_NAME] ', & - ' [--no-prune] [-- ARGS] ', & + ' [--no-prune] [--no-module-names] [-- ARGS] ', & ' test [[--target] NAME(s)] [--profile PROF] [--flag FFLAGS] [--list] ', & - ' [--runner "CMD"] [--compiler COMPILER_NAME] [--no-prune] [-- ARGS] ', & + ' [--runner "CMD"] [--compiler COMPILER_NAME] [--no-prune] ', & + ' [--no-module-names] [-- ARGS] ', & ' help [NAME(s)] ', & ' list [--list] ', & ' install [--profile PROF] [--flag FFLAGS] [--no-rebuild] [--prefix PATH] ', & From 239e28abfbbccd7b0f058f38ee94a6f815c67603 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 12 Jan 2023 11:03:50 +0100 Subject: [PATCH 02/31] Improve help description --- src/fpm_command_line.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 3a6587263a..dca68e84ec 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -143,10 +143,10 @@ module fpm_command_line ' If --flag is not specified the "debug" flags are the ',& ' default. ',& ' --no-prune Disable tree-shaking/pruning of unused module dependencies ',& - ' --no-module-names Disable enforcing module naming conventions. If specified ',& + ' --no-module-names Disable enforcing module naming conventions. If specified, ',& ' modules in the package and its dependencies will only be ',& - ' checked for duplicates; otherwise, all modules are enforced ',& - ' to begin with their package name. '& + ' checked for duplicates; otherwise, all module names are ',& + ' enforced to begin with their package name. '& ] ! '12345678901234567890123456789012345678901234567890123456789012345678901234567890',& character(len=80), parameter :: help_text_compiler(*) = [character(len=80) :: & From d3509e9526fdb34eafa7609b2c619bdbbbc65ff5 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 12 Jan 2023 11:29:52 +0100 Subject: [PATCH 03/31] Pass module naming flag to `fpm_model_t` --- src/fpm.f90 | 3 ++- src/fpm_model.f90 | 7 +++++++ 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index b9c0d2a874..e78d022890 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -92,6 +92,7 @@ subroutine build_model(model, settings, package, error) model%build_prefix = join_path("build", basename(model%compiler%fc)) model%include_tests = settings%build_tests + model%enforce_module_names = settings%enforce_module_names allocate(model%packages(model%deps%ndep)) @@ -107,7 +108,7 @@ subroutine build_model(model, settings, package, error) model%packages(i)%name = dependency%name call package%version%to_string(version) model%packages(i)%version = version - + if (allocated(dependency%preprocess)) then do j = 1, size(dependency%preprocess) if (dependency%preprocess(j)%name == "cpp") then diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index 68d8e8ecf3..3452bc5783 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -179,6 +179,9 @@ module fpm_model !> Whether tests should be added to the build list logical :: include_tests = .true. + !> Whether module names should be prefixed with the package name + logical :: enforce_module_names = .true. + end type fpm_model_t contains @@ -343,6 +346,10 @@ function info_model(model) result(s) ! TODO: print `dependency_tree_t` properly, which should become part of the ! model, not imported from another file s = s // ", deps=dependency_tree_t(...)" + + ! Print module naming convention + s = s // ', enforce_module_names="' // merge('T','F',model%enforce_module_names) // '"' + !end type fpm_model_t s = s // ")" end function info_model From d6d0515e124d3a652425e93b355f2d0c5cc3d9d1 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 12 Jan 2023 11:53:43 +0100 Subject: [PATCH 04/31] Implement name enforcing rule function and basic unit test --- src/fpm.f90 | 21 ++++++++++ test/fpm_test/test_module_dependencies.f90 | 49 +++++++++++++++++++--- 2 files changed, 65 insertions(+), 5 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index e78d022890..1c26424705 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -29,6 +29,7 @@ module fpm private public :: cmd_build, cmd_run, cmd_clean public :: build_model, check_modules_for_duplicates +public :: is_valid_module_name contains @@ -533,6 +534,26 @@ end subroutine compact_list end subroutine cmd_run +!> Check that a module name fits the current naming rules +logical function is_valid_module_name(module_name,package_name,enforce_module_names) result(valid) + use fpm_strings, only: is_fortran_name,str_begins_with_str + type(string_t), intent(in) :: module_name + type(string_t), intent(in) :: package_name + logical , intent(in) :: enforce_module_names + + if (enforce_module_names) then + !> Enforcing: check that the module name begins with the package name + valid = is_fortran_name(package_name%s) .and. & + is_fortran_name(module_name%s) .and. & + str_begins_with_str(module_name%s,package_name%s) + + else + !> No enforcing: just check that there are no invalid characters + valid = is_fortran_name(module_name%s) + end if + +end function is_valid_module_name + subroutine delete_skip(unix) !> delete directories in the build folder, skipping dependencies logical, intent(in) :: unix diff --git a/test/fpm_test/test_module_dependencies.f90 b/test/fpm_test/test_module_dependencies.f90 index 805cc25590..c3bbf1f387 100644 --- a/test/fpm_test/test_module_dependencies.f90 +++ b/test/fpm_test/test_module_dependencies.f90 @@ -10,7 +10,7 @@ module test_module_dependencies FPM_UNIT_CHEADER, FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, & FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST use fpm_strings, only: string_t, operator(.in.) - use fpm, only: check_modules_for_duplicates + use fpm, only: check_modules_for_duplicates, is_valid_module_name implicit none private @@ -52,12 +52,14 @@ subroutine collect_module_dependencies(testsuite) test_subdirectory_module_use), & & new_unittest("invalid-subdirectory-module-use", & test_invalid_subdirectory_module_use, should_fail=.true.), & - & new_unittest("tree-shake-module", & + & new_unittest("tree-shake-module", & test_tree_shake_module, should_fail=.false.), & - & new_unittest("tree-shake-subprogram-with-module", & - test_tree_shake_subprogram_with_module, should_fail=.false.) & + & new_unittest("tree-shake-subprogram-with-module", & + test_tree_shake_subprogram_with_module, should_fail=.false.), & + & new_unittest("valid-enforced-module-names", & + check_valid_enforced_module_names, should_fail=.false.) & ] - + end subroutine collect_module_dependencies @@ -784,6 +786,43 @@ subroutine check_target(target,type,n_depends,deps,links,source,error) end subroutine check_target + !> Check several module names whose name is valid and begins with the package name + subroutine check_valid_enforced_module_names(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: i,j + type(string_t) :: package,modules + logical, parameter :: enforcing(2) = [.false.,.true.] + character(*), parameter :: package_name = 'my_pkg' + character(len=80), parameter :: module_names(*) = [ character(len=80) :: & + 'my_pkg_mod_1', & + 'my_pkgmod_1', & + 'my_pkg____mod_1', & + 'my_pkg', & + 'my_pkg_mod_1', & + 'my_pkg_my_pkg' ] + + + package = string_t(package_name) + + do i=1,size(module_names) + + modules = string_t(module_names(i)) + + !> All these names are valid both with and without enforcing + do j=1,2 + if (.not.is_valid_module_name(modules,package,enforcing(j))) then + call test_failed(error,'Valid dummy module name ['//modules%s//'] of package ['// & + package%s//'] unexpectedly fails naming check (enforcing='// & + merge('T','F',enforcing(j))//').') + return + endif + end do + end do + + end subroutine check_valid_enforced_module_names !> Helper to check if a build target is in a list of build_target_ptr logical function target_in(needle,haystack) From 56a82f5956e7af7331bd7ac8023e366bb79cd703 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 12 Jan 2023 12:26:58 +0100 Subject: [PATCH 05/31] Add unit tests of invalid module names --- test/fpm_test/test_module_dependencies.f90 | 79 +++++++++++++++++++++- 1 file changed, 78 insertions(+), 1 deletion(-) diff --git a/test/fpm_test/test_module_dependencies.f90 b/test/fpm_test/test_module_dependencies.f90 index c3bbf1f387..c21d2a6c76 100644 --- a/test/fpm_test/test_module_dependencies.f90 +++ b/test/fpm_test/test_module_dependencies.f90 @@ -57,7 +57,11 @@ subroutine collect_module_dependencies(testsuite) & new_unittest("tree-shake-subprogram-with-module", & test_tree_shake_subprogram_with_module, should_fail=.false.), & & new_unittest("valid-enforced-module-names", & - check_valid_enforced_module_names, should_fail=.false.) & + check_valid_enforced_module_names, should_fail=.false.), & + & new_unittest("invalid-enforced-module-names", & + check_invalid_enforced_module_names, should_fail=.false.), & + & new_unittest("invalid-module-names", & + check_invalid_module_names, should_fail=.false.) & ] end subroutine collect_module_dependencies @@ -824,6 +828,79 @@ subroutine check_valid_enforced_module_names(error) end subroutine check_valid_enforced_module_names + !> Check several module names whose name is invalid + subroutine check_invalid_enforced_module_names(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: i + type(string_t) :: package,modules + character(*), parameter :: package_name = 'my_pkg' + character(len=80), parameter :: module_names(*) = [ character(len=80) :: & + 'mod_1', & + 'my_pkmod_1', & + 'my_mod_1', & + 'pkg_mod_1', & + 'y_pkg_mod_1', & + '_my_pkg_mod_1' ] + + + package = string_t(package_name) + + !> All these cases should report an invalid name + do i=1,size(module_names) + + modules = string_t(module_names(i)) + + if (is_valid_module_name(modules,package,.true.)) then + call test_failed(error,'Invalid dummy module name ['//modules%s//'] of package ['// & + package%s//'] unexpectedly passes naming check (enforcing=F).') + return + end if + + end do + + end subroutine check_invalid_enforced_module_names + + !> Check module names whose name does not name the convention: + !> - Begin with a literal + !> - len(name)<=63 + !> - Contains literals, numbers, or underscores only + subroutine check_invalid_module_names(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: i + type(string_t) :: modules,package + + !> Examples taken from Metcalf/Reid/Cohen + character(len=80), parameter :: module_names(*) = [ character(len=80) :: & + '1a', & + 'a thing', & + '$sign', & + '_begin_with_underscore', & + 'contains-dashes', & + 'and/other?symbols@2' ] + + package = string_t("") + + !> All these cases should report an invalid name + do i=1,size(module_names) + + modules = string_t(module_names(i)) + + if (is_valid_module_name(modules,package,.false.)) then + call test_failed(error,'Invalid Fortran module name ['//modules%s//'] ' & + //' unexpectedly passes naming check.') + return + end if + + end do + + end subroutine check_invalid_module_names + !> Helper to check if a build target is in a list of build_target_ptr logical function target_in(needle,haystack) type(build_target_t), intent(in), target :: needle From cdb9f5413a5699a18a282f2c6e2e74219124a66d Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 12 Jan 2023 12:28:36 +0100 Subject: [PATCH 06/31] Refactor: move `use`d to top of module --- src/fpm.f90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 1c26424705..fd52003048 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -1,6 +1,6 @@ module fpm use fpm_strings, only: string_t, operator(.in.), glob, join, string_cat, & - lower, str_ends_with + lower, str_ends_with, is_fortran_name, str_begins_with_str use fpm_backend, only: build_package use fpm_command_line, only: fpm_build_settings, fpm_new_settings, & fpm_run_settings, fpm_install_settings, fpm_test_settings, & @@ -536,7 +536,6 @@ end subroutine cmd_run !> Check that a module name fits the current naming rules logical function is_valid_module_name(module_name,package_name,enforce_module_names) result(valid) - use fpm_strings, only: is_fortran_name,str_begins_with_str type(string_t), intent(in) :: module_name type(string_t), intent(in) :: package_name logical , intent(in) :: enforce_module_names From 107888ebe56c3b0d6b9df94c9e3a3a060a80686e Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 12 Jan 2023 12:35:49 +0100 Subject: [PATCH 07/31] Enable package names with dashes `-` (also test it) --- src/fpm.f90 | 5 +-- test/fpm_test/test_module_dependencies.f90 | 40 ++++++++++++++++++++++ 2 files changed, 43 insertions(+), 2 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index fd52003048..338bbeaaf4 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -536,15 +536,16 @@ end subroutine cmd_run !> Check that a module name fits the current naming rules logical function is_valid_module_name(module_name,package_name,enforce_module_names) result(valid) + use fpm_strings, only: to_fortran_name type(string_t), intent(in) :: module_name type(string_t), intent(in) :: package_name logical , intent(in) :: enforce_module_names if (enforce_module_names) then !> Enforcing: check that the module name begins with the package name - valid = is_fortran_name(package_name%s) .and. & + valid = is_fortran_name(to_fortran_name(package_name%s)) .and. & is_fortran_name(module_name%s) .and. & - str_begins_with_str(module_name%s,package_name%s) + str_begins_with_str(module_name%s,to_fortran_name(package_name%s)) else !> No enforcing: just check that there are no invalid characters diff --git a/test/fpm_test/test_module_dependencies.f90 b/test/fpm_test/test_module_dependencies.f90 index c21d2a6c76..8d47bd74e4 100644 --- a/test/fpm_test/test_module_dependencies.f90 +++ b/test/fpm_test/test_module_dependencies.f90 @@ -58,6 +58,8 @@ subroutine collect_module_dependencies(testsuite) test_tree_shake_subprogram_with_module, should_fail=.false.), & & new_unittest("valid-enforced-module-names", & check_valid_enforced_module_names, should_fail=.false.), & + & new_unittest("valid-enforced-module-names-dashed", & + check_valid_enforced_module_names_dashed, should_fail=.false.), & & new_unittest("invalid-enforced-module-names", & check_invalid_enforced_module_names, should_fail=.false.), & & new_unittest("invalid-module-names", & @@ -828,6 +830,44 @@ subroutine check_valid_enforced_module_names(error) end subroutine check_valid_enforced_module_names + !> Check several module names whose name is valid and begins with the package name + subroutine check_valid_enforced_module_names_dashed(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: i,j + type(string_t) :: package,modules + logical, parameter :: enforcing(2) = [.false.,.true.] + character(*), parameter :: package_name = 'my-pkg' + character(len=80), parameter :: module_names(*) = [ character(len=80) :: & + 'my_pkg_mod_1', & + 'my_pkgmod_1', & + 'my_pkg____mod_1', & + 'my_pkg', & + 'my_pkg_mod_1', & + 'my_pkg_my_pkg' ] + + + package = string_t(package_name) + + do i=1,size(module_names) + + modules = string_t(module_names(i)) + + !> All these names are valid both with and without enforcing + do j=1,2 + if (.not.is_valid_module_name(modules,package,enforcing(j))) then + call test_failed(error,'Valid dummy module name ['//modules%s//'] of package ['// & + package%s//'] unexpectedly fails naming check (enforcing='// & + merge('T','F',enforcing(j))//').') + return + endif + end do + end do + + end subroutine check_valid_enforced_module_names_dashed + !> Check several module names whose name is invalid subroutine check_invalid_enforced_module_names(error) From 4c398600e6815ba72053fabee980941c5d37f2aa Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 12 Jan 2023 13:01:15 +0100 Subject: [PATCH 08/31] Implement module name checking --- src/fpm.f90 | 70 ++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 69 insertions(+), 1 deletion(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 338bbeaaf4..d7c52154ae 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -235,7 +235,11 @@ subroutine build_model(model, settings, package, error) write(*,*)' CXX COMPILER OPTIONS: ', model%cxx_compile_flags write(*,*)' LINKER OPTIONS: ', model%link_flags write(*,*)' INCLUDE DIRECTORIES: [', string_cat(model%include_dirs,','),']' - end if + end if + + ! Check for invalid module names + call check_module_names(model, error) + if (allocated(error)) return ! Check for duplicate modules call check_modules_for_duplicates(model, duplicates_found) @@ -288,6 +292,70 @@ subroutine check_modules_for_duplicates(model, duplicates_found) end do end subroutine check_modules_for_duplicates +! Check names of all modules in this package and its dependencies +subroutine check_module_names(model, error) + type(fpm_model_t), intent(in) :: model + type(error_t), allocatable, intent(out) :: error + integer :: i,j,k,l,m + logical :: valid,errors_found + type(string_t) :: package_name,module_name + + errors_found = .false. + + ! Loop through modules provided by each source file of every package + ! Add it to the array if it is not already there + ! Otherwise print out warning about duplicates + do k=1,size(model%packages) + + package_name = string_t(model%packages(k)%name) + + do l=1,size(model%packages(k)%sources) + if (allocated(model%packages(k)%sources(l)%modules_provided)) then + do m=1,size(model%packages(k)%sources(l)%modules_provided) + + module_name = model%packages(k)%sources(l)%modules_provided(m) + + valid = is_valid_module_name(module_name, & + package_name, & + model%enforce_module_names) + + if (.not.valid) then + + write(stderr, *) "Warning: Module ",module_name%s, & + " in ",model%packages(k)%sources(l)%file_name,& + " does not match its package name." + + if (model%enforce_module_names) then + + write(stderr, *) "Warning: Module ",module_name%s, & + " in ",model%packages(k)%sources(l)%file_name, & + " does not match its package name." + write(stderr, *) " Hint: Try disabling name enforcing with --no-module-names . " + + else + + write(stderr, *) "Warning: Module ",module_name%s, & + " in ",model%packages(k)%sources(l)%file_name, & + " has an invalid Fortran name. " + + end if + + errors_found = .true. + + end if + end do + end if + end do + end do + + if (errors_found) then + call fatal_error(error,"The package contains invalid module names. "// & + "Naming conventions "//merge('are','not',model%enforce_module_names)// & + " being requested.") + end if + +end subroutine check_module_names + subroutine cmd_build(settings) type(fpm_build_settings), intent(in) :: settings type(package_config_t) :: package From cab41dabd76b5e1a25acb7697ee7dda4fcad185a Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 12 Jan 2023 13:05:20 +0100 Subject: [PATCH 09/31] Improve error output --- src/fpm.f90 | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index d7c52154ae..4a36a04ee7 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -321,20 +321,15 @@ subroutine check_module_names(model, error) if (.not.valid) then - write(stderr, *) "Warning: Module ",module_name%s, & - " in ",model%packages(k)%sources(l)%file_name,& - " does not match its package name." - if (model%enforce_module_names) then - write(stderr, *) "Warning: Module ",module_name%s, & + write(stderr, *) "ERROR: Module ",module_name%s, & " in ",model%packages(k)%sources(l)%file_name, & - " does not match its package name." - write(stderr, *) " Hint: Try disabling name enforcing with --no-module-names . " + " does not match its package name ("//package_name%s//")." else - write(stderr, *) "Warning: Module ",module_name%s, & + write(stderr, *) "ERROR: Module ",module_name%s, & " in ",model%packages(k)%sources(l)%file_name, & " has an invalid Fortran name. " @@ -349,6 +344,10 @@ subroutine check_module_names(model, error) end do if (errors_found) then + + if (model%enforce_module_names) & + write(stderr, *) " Hint: Try disabling name enforcing with --no-module-names . " + call fatal_error(error,"The package contains invalid module names. "// & "Naming conventions "//merge('are','not',model%enforce_module_names)// & " being requested.") From 21630581f2fb0108df7f53854607f431df5b918c Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 19 Jan 2023 12:25:00 +0100 Subject: [PATCH 10/31] Implement new naming policy; update tests The new naming policy requires package modules names to: 1) Begin with the fortrannized package name 2) Either be exactly equal to it; 3) Or if longer, have a `__` separator between the package name ant the rest of the name 4) Dangling separator (`package__`) is not allowed --- src/fpm.f90 | 53 +++++++++++++++++----- test/fpm_test/test_module_dependencies.f90 | 27 ++++++----- 2 files changed, 57 insertions(+), 23 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 4a36a04ee7..b1cee00de2 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -1,6 +1,7 @@ module fpm use fpm_strings, only: string_t, operator(.in.), glob, join, string_cat, & - lower, str_ends_with, is_fortran_name, str_begins_with_str + lower, str_ends_with, is_fortran_name, str_begins_with_str, & + to_fortran_name use fpm_backend, only: build_package use fpm_command_line, only: fpm_build_settings, fpm_new_settings, & fpm_run_settings, fpm_install_settings, fpm_test_settings, & @@ -601,22 +602,52 @@ end subroutine compact_list end subroutine cmd_run -!> Check that a module name fits the current naming rules +!> Check that a module name fits the current naming rules: +!> 1) It must be a valid FORTRAN name (<=63 chars, begin with letter, "_" is only allowed non-alphanumeric) +!> 2) It must begin with the package name +!> 3) If longer, package name must be followed by default separator plus at least one char logical function is_valid_module_name(module_name,package_name,enforce_module_names) result(valid) - use fpm_strings, only: to_fortran_name + type(string_t), intent(in) :: module_name type(string_t), intent(in) :: package_name logical , intent(in) :: enforce_module_names - if (enforce_module_names) then - !> Enforcing: check that the module name begins with the package name - valid = is_fortran_name(to_fortran_name(package_name%s)) .and. & - is_fortran_name(module_name%s) .and. & - str_begins_with_str(module_name%s,to_fortran_name(package_name%s)) + !> Default package__module separator: two underscores + character(*), parameter :: SEP = "__" + + character(len=:), allocatable :: fortranized_pkg + logical :: is_same,has_separator,same_beginning + integer :: lpkg,lmod,lsep + + !> Basic check: check the name is Fortran-compliant + valid = is_fortran_name(module_name%s) + + !> FPM package enforcing: check that the module name begins with the package name + if (valid .and. enforce_module_names) then + + fortranized_pkg = to_fortran_name(package_name%s) + + !> Query string lengths + lpkg = len_trim(fortranized_pkg) + lmod = len_trim(module_name%s) + lsep = len_trim(SEP) + + same_beginning = str_begins_with_str(module_name%s,fortranized_pkg) + + is_same = lpkg==lmod .and. same_beginning + + if (lmod>=lpkg+lsep) then + has_separator = str_begins_with_str(module_name%s(lpkg+1:lpkg+lsep),SEP) + else + has_separator = .false. + endif + + !> 2) It must begin with the package name. + !> 3) It can be equal to the package name, or, if longer, must be followed by the + ! default separator plus at least one character + valid = is_fortran_name(fortranized_pkg) .and. & + (is_same .or. (lmod>lpkg+lsep .and. has_separator)) - else - !> No enforcing: just check that there are no invalid characters - valid = is_fortran_name(module_name%s) end if end function is_valid_module_name diff --git a/test/fpm_test/test_module_dependencies.f90 b/test/fpm_test/test_module_dependencies.f90 index 8d47bd74e4..4f9b9340fd 100644 --- a/test/fpm_test/test_module_dependencies.f90 +++ b/test/fpm_test/test_module_dependencies.f90 @@ -803,12 +803,12 @@ subroutine check_valid_enforced_module_names(error) logical, parameter :: enforcing(2) = [.false.,.true.] character(*), parameter :: package_name = 'my_pkg' character(len=80), parameter :: module_names(*) = [ character(len=80) :: & - 'my_pkg_mod_1', & - 'my_pkgmod_1', & + 'my_pkg__mod_1', & + 'my_pkg___mod_1', & 'my_pkg____mod_1', & 'my_pkg', & - 'my_pkg_mod_1', & - 'my_pkg_my_pkg' ] + 'my_pkg__1', & + 'my_pkg__my_pkg' ] package = string_t(package_name) @@ -841,19 +841,19 @@ subroutine check_valid_enforced_module_names_dashed(error) logical, parameter :: enforcing(2) = [.false.,.true.] character(*), parameter :: package_name = 'my-pkg' character(len=80), parameter :: module_names(*) = [ character(len=80) :: & - 'my_pkg_mod_1', & - 'my_pkgmod_1', & + 'my_pkg__mod_1', & + 'my_pkg___mod_1', & 'my_pkg____mod_1', & 'my_pkg', & - 'my_pkg_mod_1', & - 'my_pkg_my_pkg' ] + 'my_pkg__1', & + 'my_pkg__my_pkg' ] package = string_t(package_name) do i=1,size(module_names) - modules = string_t(module_names(i)) + modules = string_t(trim(module_names(i))) !> All these names are valid both with and without enforcing do j=1,2 @@ -883,7 +883,10 @@ subroutine check_invalid_enforced_module_names(error) 'my_mod_1', & 'pkg_mod_1', & 'y_pkg_mod_1', & - '_my_pkg_mod_1' ] + '_my_pkg_mod_1', & + 'my_pkgmy_mod', & + 'my_pkg_', & + 'my_pkg__' ] package = string_t(package_name) @@ -891,11 +894,11 @@ subroutine check_invalid_enforced_module_names(error) !> All these cases should report an invalid name do i=1,size(module_names) - modules = string_t(module_names(i)) + modules = string_t(trim(module_names(i))) if (is_valid_module_name(modules,package,.true.)) then call test_failed(error,'Invalid dummy module name ['//modules%s//'] of package ['// & - package%s//'] unexpectedly passes naming check (enforcing=F).') + package%s//'] unexpectedly passes naming check (enforcing=T).') return end if From 96336046ebf947c5c9b8a843071a57ba6694350a Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 19 Jan 2023 12:36:22 +0100 Subject: [PATCH 11/31] do not enforce module names by default; remove CLI option `--no-module-names`; --- src/fpm.f90 | 3 +-- src/fpm_command_line.f90 | 22 +++++----------------- src/fpm_model.f90 | 2 +- 3 files changed, 7 insertions(+), 20 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index b1cee00de2..b5d134e62f 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -94,7 +94,6 @@ subroutine build_model(model, settings, package, error) model%build_prefix = join_path("build", basename(model%compiler%fc)) model%include_tests = settings%build_tests - model%enforce_module_names = settings%enforce_module_names allocate(model%packages(model%deps%ndep)) @@ -347,7 +346,7 @@ subroutine check_module_names(model, error) if (errors_found) then if (model%enforce_module_names) & - write(stderr, *) " Hint: Try disabling name enforcing with --no-module-names . " + write(stderr, *) " Hint: Try disabling name enforcing in the manifest. " call fatal_error(error,"The package contains invalid module names. "// & "Naming conventions "//merge('are','not',model%enforce_module_names)// & diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index dca68e84ec..659acd1950 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -72,8 +72,6 @@ module fpm_command_line logical :: show_model=.false. logical :: build_tests=.false. logical :: prune=.true. - !> Request all module names in package and dependencies to begin with their package name - logical :: enforce_module_names=.true. character(len=:),allocatable :: compiler character(len=:),allocatable :: c_compiler character(len=:),allocatable :: cxx_compiler @@ -142,11 +140,7 @@ module fpm_command_line ' high optimization and "debug" for full debug options. ',& ' If --flag is not specified the "debug" flags are the ',& ' default. ',& - ' --no-prune Disable tree-shaking/pruning of unused module dependencies ',& - ' --no-module-names Disable enforcing module naming conventions. If specified, ',& - ' modules in the package and its dependencies will only be ',& - ' checked for duplicates; otherwise, all module names are ',& - ' enforced to begin with their package name. '& + ' --no-prune Disable tree-shaking/pruning of unused module dependencies '& ] ! '12345678901234567890123456789012345678901234567890123456789012345678901234567890',& character(len=80), parameter :: help_text_compiler(*) = [character(len=80) :: & @@ -263,7 +257,6 @@ subroutine get_command_line_settings(cmd_settings) compiler_args = & ' --profile " "' // & ' --no-prune F' // & - ' --no-module-names F' // & ' --compiler "'//get_fpm_env(fc_env, fc_default)//'"' // & ' --c-compiler "'//get_fpm_env(cc_env, cc_default)//'"' // & ' --cxx-compiler "'//get_fpm_env(cxx_env, cxx_default)//'"' // & @@ -318,7 +311,6 @@ subroutine get_command_line_settings(cmd_settings) & args=remaining,& & profile=val_profile,& & prune=.not.lget('no-prune'), & - & enforce_module_names=.not.lget('no-module-names'), & & compiler=val_compiler, & & c_compiler=c_compiler, & & cxx_compiler=cxx_compiler, & @@ -350,7 +342,6 @@ subroutine get_command_line_settings(cmd_settings) cmd_settings=fpm_build_settings( & & profile=val_profile,& & prune=.not.lget('no-prune'), & - & enforce_module_names=.not.lget('no-module-names'), & & compiler=val_compiler, & & c_compiler=c_compiler, & & cxx_compiler=cxx_compiler, & @@ -506,7 +497,6 @@ subroutine get_command_line_settings(cmd_settings) list=lget('list'), & profile=val_profile,& prune=.not.lget('no-prune'), & - enforce_module_names=.not.lget('no-module-names'), & compiler=val_compiler, & c_compiler=c_compiler, & cxx_compiler=cxx_compiler, & @@ -567,7 +557,6 @@ subroutine get_command_line_settings(cmd_settings) & args=remaining, & & profile=val_profile, & & prune=.not.lget('no-prune'), & - & enforce_module_names=.not.lget('no-module-names'), & & compiler=val_compiler, & & c_compiler=c_compiler, & & cxx_compiler=cxx_compiler, & @@ -701,7 +690,7 @@ subroutine set_help() help_list_dash = [character(len=80) :: & ' ', & ' build [--compiler COMPILER_NAME] [--profile PROF] [--flag FFLAGS] [--list] ', & - ' [--tests] [--no-prune] [--no-module-names] ', & + ' [--tests] [--no-prune] ', & ' help [NAME(s)] ', & ' new NAME [[--lib|--src] [--app] [--test] [--example]]| ', & ' [--full|--bare][--backfill] ', & @@ -822,16 +811,15 @@ subroutine set_help() ' Their syntax is ', & ' ', & ' build [--profile PROF] [--flag FFLAGS] [--list] [--compiler COMPILER_NAME] ', & - ' [--tests] [--no-prune] [--no-module-names] ', & + ' [--tests] [--no-prune] ', & ' new NAME [[--lib|--src] [--app] [--test] [--example]]| ', & ' [--full|--bare][--backfill] ', & ' update [NAME(s)] [--fetch-only] [--clean] ', & ' run [[--target] NAME(s)] [--profile PROF] [--flag FFLAGS] [--list] [--all] ', & ' [--example] [--runner "CMD"] [--compiler COMPILER_NAME] ', & - ' [--no-prune] [--no-module-names] [-- ARGS] ', & + ' [--no-prune] [-- ARGS] ', & ' test [[--target] NAME(s)] [--profile PROF] [--flag FFLAGS] [--list] ', & - ' [--runner "CMD"] [--compiler COMPILER_NAME] [--no-prune] ', & - ' [--no-module-names] [-- ARGS] ', & + ' [--runner "CMD"] [--compiler COMPILER_NAME] [--no-prune] [-- ARGS] ', & ' help [NAME(s)] ', & ' list [--list] ', & ' install [--profile PROF] [--flag FFLAGS] [--no-rebuild] [--prefix PATH] ', & diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index 3452bc5783..9e973635cb 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -180,7 +180,7 @@ module fpm_model logical :: include_tests = .true. !> Whether module names should be prefixed with the package name - logical :: enforce_module_names = .true. + logical :: enforce_module_names = .false. end type fpm_model_t From 39343e465109293010569ed78cf96083a1f9e9ef Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 19 Jan 2023 12:54:18 +0100 Subject: [PATCH 12/31] add `module-naming` option to the manifest under `[build]` --- src/fpm.f90 | 3 ++- src/fpm/manifest/build.f90 | 13 +++++++++++++ 2 files changed, 15 insertions(+), 1 deletion(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index b5d134e62f..8191a94f82 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -94,6 +94,7 @@ subroutine build_model(model, settings, package, error) model%build_prefix = join_path("build", basename(model%compiler%fc)) model%include_tests = settings%build_tests + model%enforce_module_names = package%build%module_naming allocate(model%packages(model%deps%ndep)) @@ -346,7 +347,7 @@ subroutine check_module_names(model, error) if (errors_found) then if (model%enforce_module_names) & - write(stderr, *) " Hint: Try disabling name enforcing in the manifest. " + write(stderr, *) " Hint: Try disabling module naming in the manifest: [build] module-naming=false . " call fatal_error(error,"The package contains invalid module names. "// & "Naming conventions "//merge('are','not',model%enforce_module_names)// & diff --git a/src/fpm/manifest/build.f90 b/src/fpm/manifest/build.f90 index b24cf431b6..37a026375f 100644 --- a/src/fpm/manifest/build.f90 +++ b/src/fpm/manifest/build.f90 @@ -31,6 +31,9 @@ module fpm_manifest_build !> Automatic discovery of tests logical :: auto_tests + !> Enforcing of package module names + logical :: module_naming = .false. + !> Libraries to link against type(string_t), allocatable :: link(:) @@ -86,6 +89,12 @@ subroutine new_build_config(self, table, error) return end if + call get_value(table, "module-naming", self%module_naming, .false., stat=stat) + + if (stat /= toml_stat%success) then + call fatal_error(error,"Error while reading value for 'module-naming' in fpm.toml, expecting logical") + return + end if call get_list(table, "link", self%link, error) if (allocated(error)) return @@ -119,6 +128,9 @@ subroutine check(table, error) case("auto-executables", "auto-examples", "auto-tests", "link", "external-modules") continue + case ("module-naming") + continue + case default call syntax_error(error, "Key "//list(ikey)%key//" is not allowed in [build]") exit @@ -156,6 +168,7 @@ subroutine info(self, unit, verbosity) write(unit, fmt) " - auto-discovery (apps) ", merge("enabled ", "disabled", self%auto_executables) write(unit, fmt) " - auto-discovery (examples) ", merge("enabled ", "disabled", self%auto_examples) write(unit, fmt) " - auto-discovery (tests) ", merge("enabled ", "disabled", self%auto_tests) + write(unit, fmt) " - enforce module naming ", merge("enabled ", "disabled", self%module_naming) if (allocated(self%link)) then write(unit, fmt) " - link against" do ilink = 1, size(self%link) From 04b78adbf08b02064de6d63fc8d7f90d9f7e2198 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 19 Jan 2023 13:51:24 +0100 Subject: [PATCH 13/31] add manifest tests for `module-naming` fpm.toml flag --- test/fpm_test/test_manifest.f90 | 32 ++++++++++++++++++++++---------- 1 file changed, 22 insertions(+), 10 deletions(-) diff --git a/test/fpm_test/test_manifest.f90 b/test/fpm_test/test_manifest.f90 index e608e79fcf..7e62615375 100644 --- a/test/fpm_test/test_manifest.f90 +++ b/test/fpm_test/test_manifest.f90 @@ -91,6 +91,7 @@ subroutine test_valid_manifest(error) & '[build]', & & 'auto-executables = false', & & 'auto-tests = false', & + & 'module-naming = false', & & '[dependencies.fpm]', & & 'git = "https://github.com/fortran-lang/fpm"', & & '[[executable]]', & @@ -635,7 +636,8 @@ subroutine test_build_valid(error) & 'name = "example"', & & '[build]', & & 'auto-executables = false', & - & 'auto-tests = false' + & 'auto-tests = false ', & + & 'module-naming = true ' close(unit) call get_package_data(package, temp_file, error) @@ -652,6 +654,11 @@ subroutine test_build_valid(error) return end if + if (.not.package%build%module_naming) then + call test_failed(error, "Wong value of 'module-naming' read, expecting .true.") + return + end if + end subroutine test_build_valid @@ -688,6 +695,11 @@ subroutine test_build_empty(error) return end if + if (package%build%module_naming) then + call test_failed(error, "Wong default value of 'module-naming' read, expecting .false.") + return + end if + end subroutine test_build_empty @@ -1225,7 +1237,7 @@ subroutine test_install_wrongkey(error) call new_install_config(install, table, error) end subroutine test_install_wrongkey - + subroutine test_preprocess_empty(error) use fpm_mainfest_preprocess use fpm_toml, only : new_table, toml_table @@ -1261,7 +1273,7 @@ subroutine test_preprocess_wrongkey(error) call add_table(table, 'wrong-field', child, stat) call new_preprocess_config(preprocess, table, error) - + end subroutine test_preprocess_wrongkey !> Preprocess table cannot be empty. @@ -1304,9 +1316,9 @@ subroutine test_macro_parsing(error) & 'name = "example"', & & 'version = "0.1.0"', & & '[preprocess]', & - & '[preprocess.cpp]', & + & '[preprocess.cpp]', & & 'macros = ["FOO", "BAR=2", "VERSION={version}"]' - close(unit) + close(unit) call get_package_data(package, temp_file, error) @@ -1317,7 +1329,7 @@ subroutine test_macro_parsing(error) if (get_macros(id, package%preprocess(1)%macros, version) /= " -DFOO -DBAR=2 -DVERSION=0.1.0") then call test_failed(error, "Macros were not parsed correctly") end if - + end subroutine test_macro_parsing !> Test macro parsing of the package and its dependency. @@ -1346,10 +1358,10 @@ subroutine test_macro_parsing_dependency(error) & 'name = "example"', & & 'version = "0.1.0"', & & '[dependencies]', & - & '[dependencies.dependency-name]', & + & '[dependencies.dependency-name]', & & 'git = "https://github.com/fortran-lang/dependency-name"', & & '[preprocess]', & - & '[preprocess.cpp]', & + & '[preprocess.cpp]', & & 'macros = ["FOO", "BAR=2", "VERSION={version}"]' close(unit) @@ -1358,7 +1370,7 @@ subroutine test_macro_parsing_dependency(error) & 'name = "dependency-name"', & & 'version = "0.2.0"', & & '[preprocess]', & - & '[preprocess.cpp]', & + & '[preprocess.cpp]', & & 'macros = ["FOO1", "BAR2=2", "VERSION={version}"]' close(unit) @@ -1379,7 +1391,7 @@ subroutine test_macro_parsing_dependency(error) if (macrosPackage == macrosDependency) then call test_failed(error, "Macros of package and dependency should not be equal") end if - + end subroutine test_macro_parsing_dependency end module test_manifest From 50e09015da7dec722a9baaf7408e6e43867f635b Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 19 Jan 2023 13:52:28 +0100 Subject: [PATCH 14/31] `test_manifest.f90`: remove unused variables --- test/fpm_test/test_manifest.f90 | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/test/fpm_test/test_manifest.f90 b/test/fpm_test/test_manifest.f90 index 7e62615375..820d6889ea 100644 --- a/test/fpm_test/test_manifest.f90 +++ b/test/fpm_test/test_manifest.f90 @@ -362,7 +362,7 @@ subroutine test_dependency_invalid_git(error) type(toml_table) :: table type(toml_table), pointer :: child - integer :: stat + type(dependency_config_t) :: dependency call new_table(table) @@ -524,7 +524,6 @@ subroutine test_profiles_keyvalue_table(error) type(package_config_t) :: package character(len=*), parameter :: manifest = 'fpm-profiles-error.toml' integer :: unit - character(:), allocatable :: profile_name, compiler, flags open(file=manifest, newunit=unit) write(unit, '(a)') & @@ -1301,7 +1300,6 @@ subroutine test_macro_parsing(error) !> Error handling type(error_t), allocatable, intent(out) :: error - character(len=:), allocatable :: flags character(len=:), allocatable :: version type(package_config_t) :: package From 6b90e47992d9e9bd63f0b2a9e4b00ad987f98d3d Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 20 Jan 2023 09:06:02 +0100 Subject: [PATCH 15/31] Ensure package name does not end with `_` --- src/fpm.f90 | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/fpm.f90 b/src/fpm.f90 index 8191a94f82..2b468e9922 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -627,6 +627,9 @@ logical function is_valid_module_name(module_name,package_name,enforce_module_na fortranized_pkg = to_fortran_name(package_name%s) + + + !> Query string lengths lpkg = len_trim(fortranized_pkg) lmod = len_trim(module_name%s) @@ -645,7 +648,9 @@ logical function is_valid_module_name(module_name,package_name,enforce_module_na !> 2) It must begin with the package name. !> 3) It can be equal to the package name, or, if longer, must be followed by the ! default separator plus at least one character + !> 4) Package name must not end with an underscore valid = is_fortran_name(fortranized_pkg) .and. & + fortranized_pkg(lpkg:lpkg)/='_' .and. & (is_same .or. (lmod>lpkg+lsep .and. has_separator)) end if From 1abf870c54a16f529434dfabad4b3f5adb05e2e2 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 20 Jan 2023 09:35:38 +0100 Subject: [PATCH 16/31] cleanup --- src/fpm.f90 | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 2b468e9922..663689835a 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -627,9 +627,6 @@ logical function is_valid_module_name(module_name,package_name,enforce_module_na fortranized_pkg = to_fortran_name(package_name%s) - - - !> Query string lengths lpkg = len_trim(fortranized_pkg) lmod = len_trim(module_name%s) From 01141ce8af3b8d19f8b7cd453efbb1e644cc73e6 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 31 Jan 2023 15:17:37 +0100 Subject: [PATCH 17/31] fix: case-insensitive naming check --- src/fpm.f90 | 6 +++--- src/fpm_strings.f90 | 14 +++++++++++++- 2 files changed, 16 insertions(+), 4 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 663689835a..a30e4dfe4a 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -317,8 +317,8 @@ subroutine check_module_names(model, error) module_name = model%packages(k)%sources(l)%modules_provided(m) valid = is_valid_module_name(module_name, & - package_name, & - model%enforce_module_names) + package_name, & + model%enforce_module_names) if (.not.valid) then @@ -632,7 +632,7 @@ logical function is_valid_module_name(module_name,package_name,enforce_module_na lmod = len_trim(module_name%s) lsep = len_trim(SEP) - same_beginning = str_begins_with_str(module_name%s,fortranized_pkg) + same_beginning = str_begins_with_str(module_name%s,fortranized_pkg,caseSensitive=.false.) is_same = lpkg==lmod .and. same_beginning diff --git a/src/fpm_strings.f90 b/src/fpm_strings.f90 index 0bb764f019..e2a47c90c0 100644 --- a/src/fpm_strings.f90 +++ b/src/fpm_strings.f90 @@ -116,13 +116,25 @@ pure logical function str_ends_with_any(s, e) result(r) end function str_ends_with_any !> test if a CHARACTER string begins with a specified prefix -pure logical function str_begins_with_str(s, e) result(r) +pure logical function str_begins_with_str(s, e, case_sensitive) result(r) character(*), intent(in) :: s, e + logical, optional, intent(in) :: case_sensitive ! Default option: case sensitive integer :: n1, n2 + logical :: lower_case + + ! Check if case sensitive + if (present(caseSensitive)) then + lower_case = .not.case_sensitive + else + lower_case = .false. + end if + n1 = 1 n2 = 1 + len(e)-1 if (n2 > len(s)) then r = .false. + elseif (lower_case) then + r = lower(s,n1,n2) == lower(e) else r = (s(n1:n2) == e) end if From 1c39290c6f66115d70fff562998377cf68b83afe Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 31 Jan 2023 15:30:16 +0100 Subject: [PATCH 18/31] fix typo --- src/fpm_strings.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fpm_strings.f90 b/src/fpm_strings.f90 index e2a47c90c0..0cff6de1dd 100644 --- a/src/fpm_strings.f90 +++ b/src/fpm_strings.f90 @@ -123,7 +123,7 @@ pure logical function str_begins_with_str(s, e, case_sensitive) result(r) logical :: lower_case ! Check if case sensitive - if (present(caseSensitive)) then + if (present(case_sensitive)) then lower_case = .not.case_sensitive else lower_case = .false. From dbfbd589376304f3077a993d99f6e37b75f204ec Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 31 Jan 2023 15:31:55 +0100 Subject: [PATCH 19/31] case_sensitive typo --- src/fpm.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index a30e4dfe4a..8e90c175f2 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -632,7 +632,7 @@ logical function is_valid_module_name(module_name,package_name,enforce_module_na lmod = len_trim(module_name%s) lsep = len_trim(SEP) - same_beginning = str_begins_with_str(module_name%s,fortranized_pkg,caseSensitive=.false.) + same_beginning = str_begins_with_str(module_name%s,fortranized_pkg,case_sensitive=.false.) is_same = lpkg==lmod .and. same_beginning From 8c15a42ad6af63026595b16bef92da3f151d1210 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 9 Feb 2023 09:10:25 +0100 Subject: [PATCH 20/31] Parse optional custom prefix --- src/fpm/manifest/build.f90 | 61 +++++++++++++++++++++++++++++++++++--- 1 file changed, 57 insertions(+), 4 deletions(-) diff --git a/src/fpm/manifest/build.f90 b/src/fpm/manifest/build.f90 index 37a026375f..0ff756b242 100644 --- a/src/fpm/manifest/build.f90 +++ b/src/fpm/manifest/build.f90 @@ -11,7 +11,7 @@ !>``` module fpm_manifest_build use fpm_error, only : error_t, syntax_error, fatal_error - use fpm_strings, only : string_t + use fpm_strings, only : string_t, len_trim use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, get_list implicit none private @@ -34,6 +34,9 @@ module fpm_manifest_build !> Enforcing of package module names logical :: module_naming = .false. + !> Custom module name prefix + type(string_t) :: module_prefix + !> Libraries to link against type(string_t), allocatable :: link(:) @@ -89,11 +92,34 @@ subroutine new_build_config(self, table, error) return end if + !> Module naming: fist, attempt boolean value first call get_value(table, "module-naming", self%module_naming, .false., stat=stat) - if (stat /= toml_stat%success) then - call fatal_error(error,"Error while reading value for 'module-naming' in fpm.toml, expecting logical") - return + if (stat == toml_stat%success) then + + ! Boolean value found. Set no custom prefix. This also falls back to + ! key not provided + self%module_prefix = string_t("") + + else + + !> Value found, but not a boolean. Attempt to read a prefix string + call get_value(table, "module-naming", self%module_prefix%s) + + if (.not.allocated(self%module_prefix%s)) then + call syntax_error(error,"Could not read value for 'module-naming' in fpm.toml, expecting logical or a string") + return + end if + + if (.not.is_valid_module_prefix(self%module_prefix)) then + call syntax_error(error,"Invalid custom module name prefix for in fpm.toml: <"//self%module_prefix%s// & + ">, expecting a valid alphanumeric string") + return + end if + + ! Set module naming to ON + self%module_naming = .true. + end if call get_list(table, "link", self%link, error) @@ -104,6 +130,33 @@ subroutine new_build_config(self, table, error) end subroutine new_build_config + !> Check that a custom module prefix fits the current naming rules: + !> 1) Only alphanumeric characters (no spaces, dashes, underscores or other characters) + !> 2) Does not begin with a number (Fortran-compatible syntax) + logical function is_valid_module_prefix(module_prefix) result(valid) + + type(string_t), intent(in) :: module_prefix + + character(len=*),parameter :: num='0123456789' + character(len=*),parameter :: lower='abcdefghijklmnopqrstuvwxyz' + character(len=*),parameter :: upper='ABCDEFGHIJKLMNOPQRSTUVWXYZ' + character(len=*),parameter :: alpha =upper//lower + character(len=*),parameter :: allowed=alpha//num + + integer :: i + character(len=:),allocatable :: name + + name = trim(module_prefix%s) + + if (len(name)>0 .and. len(name)<=63) then + valid = verify(name(1:1), alpha) == 0 .and. & + verify(name,allowed) == 0 + else + valid = .false. + endif + + end function is_valid_module_prefix + !> Check local schema for allowed entries subroutine check(table, error) From 236e566d7f2a6d84bc6a6910f95ea158bc1f2b99 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 9 Feb 2023 10:40:18 +0100 Subject: [PATCH 21/31] bugfix tests with new naming option input --- src/fpm.f90 | 99 ++++++++++++++++++++-- src/fpm/manifest/build.f90 | 2 + src/fpm_strings.f90 | 17 +++- test/fpm_test/test_module_dependencies.f90 | 20 +++-- 4 files changed, 121 insertions(+), 17 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 8e90c175f2..a172df199d 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -1,7 +1,7 @@ module fpm use fpm_strings, only: string_t, operator(.in.), glob, join, string_cat, & lower, str_ends_with, is_fortran_name, str_begins_with_str, & - to_fortran_name + to_fortran_name, len_trim use fpm_backend, only: build_package use fpm_command_line, only: fpm_build_settings, fpm_new_settings, & fpm_run_settings, fpm_install_settings, fpm_test_settings, & @@ -21,6 +21,7 @@ module fpm resolve_target_linking, build_target_t, build_target_ptr, & FPM_TARGET_EXECUTABLE, FPM_TARGET_ARCHIVE use fpm_manifest, only : get_package_data, package_config_t +use fpm_manifest_build, only: is_valid_module_prefix use fpm_error, only : error_t, fatal_error, fpm_stop use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, & & stdout=>output_unit, & @@ -299,7 +300,7 @@ subroutine check_module_names(model, error) type(error_t), allocatable, intent(out) :: error integer :: i,j,k,l,m logical :: valid,errors_found - type(string_t) :: package_name,module_name + type(string_t) :: package_name,module_name,package_prefix errors_found = .false. @@ -310,6 +311,9 @@ subroutine check_module_names(model, error) package_name = string_t(model%packages(k)%name) + ! Custom prefix is not currently active + package_prefix = string_t("") + do l=1,size(model%packages(k)%sources) if (allocated(model%packages(k)%sources(l)%modules_provided)) then do m=1,size(model%packages(k)%sources(l)%modules_provided) @@ -318,6 +322,7 @@ subroutine check_module_names(model, error) valid = is_valid_module_name(module_name, & package_name, & + package_prefix, & model%enforce_module_names) if (.not.valid) then @@ -606,12 +611,89 @@ end subroutine cmd_run !> 1) It must be a valid FORTRAN name (<=63 chars, begin with letter, "_" is only allowed non-alphanumeric) !> 2) It must begin with the package name !> 3) If longer, package name must be followed by default separator plus at least one char -logical function is_valid_module_name(module_name,package_name,enforce_module_names) result(valid) +logical function is_valid_module_name(module_name,package_name,custom_prefix,enforce_module_names) result(valid) type(string_t), intent(in) :: module_name type(string_t), intent(in) :: package_name + type(string_t), intent(in) :: custom_prefix logical , intent(in) :: enforce_module_names + + !> Basic check: check the name is Fortran-compliant + valid = is_fortran_name(module_name%s); if (.not.valid) return + + !> FPM package enforcing: check that the module name begins with the package name + if (enforce_module_names) then + + ! Default prefixing is always valid + valid = has_valid_standard_prefix(module_name,package_name) + + ! If a custom prefix was validated, it provides additional naming options + ! Because they never overlap with the default prefix, the former is always an option + if (len_trim(custom_prefix)>0 .and. .not.valid) & + valid = has_valid_custom_prefix(module_name,custom_prefix) + + end if + +end function is_valid_module_name + +!> Check that a module name is prefixed with a custom prefix: +!> 1) It must be a valid FORTRAN name subset (<=63 chars, begin with letter, only alphanumeric allowed) +!> 2) It must begin with the prefix +!> 3) If longer, package name must be followed by default separator ("_") plus at least one char +logical function has_valid_custom_prefix(module_name,custom_prefix) result(valid) + + type(string_t), intent(in) :: module_name + type(string_t), intent(in) :: custom_prefix + + !> custom_module separator: single underscore + character(*), parameter :: SEP = "_" + + logical :: is_same,has_separator,same_beginning + integer :: lpkg,lmod,lsep + + !> Basic check: check that both names are individually valid + valid = is_fortran_name(module_name%s) .and. & + is_valid_module_prefix(custom_prefix) + + !> FPM package enforcing: check that the module name begins with the custom prefix + if (valid) then + + !> Query string lengths + lpkg = len_trim(custom_prefix) + lmod = len_trim(module_name) + lsep = len_trim(SEP) + + same_beginning = str_begins_with_str(module_name%s,custom_prefix%s,case_sensitive=.false.) + + is_same = lpkg==lmod .and. same_beginning + + if (lmod>=lpkg+lsep) then + has_separator = str_begins_with_str(module_name%s(lpkg+1:lpkg+lsep),SEP) + else + has_separator = .false. + endif + + !> 2) It must begin with the package name. + !> 3) It can be equal to the package name, or, if longer, must be followed by the + ! default separator plus at least one character + !> 4) Package name must not end with an underscore + valid = same_beginning .and. (is_same .or. (lmod>lpkg+lsep .and. has_separator)) + + end if + +end function has_valid_custom_prefix + + +!> Check that a module name is prefixed with the default package prefix: +!> 1) It must be a valid FORTRAN name (<=63 chars, begin with letter, "_" is only allowed non-alphanumeric) +!> 2) It must begin with the package name +!> 3) If longer, package name must be followed by default separator plus at least one char +logical function has_valid_standard_prefix(module_name,package_name) result(valid) + + type(string_t), intent(in) :: module_name + type(string_t), intent(in) :: package_name + !> Default package__module separator: two underscores character(*), parameter :: SEP = "__" @@ -623,13 +705,13 @@ logical function is_valid_module_name(module_name,package_name,enforce_module_na valid = is_fortran_name(module_name%s) !> FPM package enforcing: check that the module name begins with the package name - if (valid .and. enforce_module_names) then + if (valid) then fortranized_pkg = to_fortran_name(package_name%s) !> Query string lengths lpkg = len_trim(fortranized_pkg) - lmod = len_trim(module_name%s) + lmod = len_trim(module_name) lsep = len_trim(SEP) same_beginning = str_begins_with_str(module_name%s,fortranized_pkg,case_sensitive=.false.) @@ -648,11 +730,14 @@ logical function is_valid_module_name(module_name,package_name,enforce_module_na !> 4) Package name must not end with an underscore valid = is_fortran_name(fortranized_pkg) .and. & fortranized_pkg(lpkg:lpkg)/='_' .and. & - (is_same .or. (lmod>lpkg+lsep .and. has_separator)) + (same_beginning .and. (is_same .or. (lmod>lpkg+lsep .and. has_separator))) + + print *, 'is_F = ',is_fortran_name(fortranized_pkg),' ends with _ ',fortranized_pkg(lpkg:lpkg)=='_',& + ' same beg=',same_beginning,' is_same=',is_same,' has_sep=',has_separator,' l=',lmod,lpkg,lsep end if -end function is_valid_module_name +end function has_valid_standard_prefix subroutine delete_skip(unix) !> delete directories in the build folder, skipping dependencies diff --git a/src/fpm/manifest/build.f90 b/src/fpm/manifest/build.f90 index 0ff756b242..e98319b178 100644 --- a/src/fpm/manifest/build.f90 +++ b/src/fpm/manifest/build.f90 @@ -18,6 +18,8 @@ module fpm_manifest_build public :: build_config_t, new_build_config + public :: is_valid_module_prefix + !> Configuration data for build type :: build_config_t diff --git a/src/fpm_strings.f90 b/src/fpm_strings.f90 index 0cff6de1dd..c9eec90ea0 100644 --- a/src/fpm_strings.f90 +++ b/src/fpm_strings.f90 @@ -51,6 +51,7 @@ module fpm_strings interface len_trim module procedure :: string_len_trim + module procedure :: strings_len_trim end interface len_trim interface resize @@ -134,7 +135,7 @@ pure logical function str_begins_with_str(s, e, case_sensitive) result(r) if (n2 > len(s)) then r = .false. elseif (lower_case) then - r = lower(s,n1,n2) == lower(e) + r = lower(s(n1:n2)) == lower(e) else r = (s(n1:n2) == e) end if @@ -316,7 +317,7 @@ function string_cat(strings,delim) result(cat) end function string_cat !> Determine total trimmed length of `string_t` array -pure function string_len_trim(strings) result(n) +pure function strings_len_trim(strings) result(n) type(string_t), intent(in) :: strings(:) integer :: i, n @@ -325,6 +326,18 @@ pure function string_len_trim(strings) result(n) n = n + len_trim(strings(i)%s) end do +end function strings_len_trim + +!> Determine total trimmed length of `string_t` array +elemental integer function string_len_trim(string) result(n) + type(string_t), intent(in) :: string + + if (allocated(string%s)) then + n = len_trim(string%s) + else + n = 0 + end if + end function string_len_trim !>Author: John S. Urban diff --git a/test/fpm_test/test_module_dependencies.f90 b/test/fpm_test/test_module_dependencies.f90 index 4f9b9340fd..b42cced8ce 100644 --- a/test/fpm_test/test_module_dependencies.f90 +++ b/test/fpm_test/test_module_dependencies.f90 @@ -799,7 +799,7 @@ subroutine check_valid_enforced_module_names(error) type(error_t), allocatable, intent(out) :: error integer :: i,j - type(string_t) :: package,modules + type(string_t) :: package,modules,prefix logical, parameter :: enforcing(2) = [.false.,.true.] character(*), parameter :: package_name = 'my_pkg' character(len=80), parameter :: module_names(*) = [ character(len=80) :: & @@ -812,6 +812,7 @@ subroutine check_valid_enforced_module_names(error) package = string_t(package_name) + prefix = string_t("") ! Prefix not used do i=1,size(module_names) @@ -819,7 +820,7 @@ subroutine check_valid_enforced_module_names(error) !> All these names are valid both with and without enforcing do j=1,2 - if (.not.is_valid_module_name(modules,package,enforcing(j))) then + if (.not.is_valid_module_name(modules,package,prefix,enforcing(j))) then call test_failed(error,'Valid dummy module name ['//modules%s//'] of package ['// & package%s//'] unexpectedly fails naming check (enforcing='// & merge('T','F',enforcing(j))//').') @@ -837,7 +838,7 @@ subroutine check_valid_enforced_module_names_dashed(error) type(error_t), allocatable, intent(out) :: error integer :: i,j - type(string_t) :: package,modules + type(string_t) :: package,modules,prefix logical, parameter :: enforcing(2) = [.false.,.true.] character(*), parameter :: package_name = 'my-pkg' character(len=80), parameter :: module_names(*) = [ character(len=80) :: & @@ -850,6 +851,7 @@ subroutine check_valid_enforced_module_names_dashed(error) package = string_t(package_name) + prefix = string_t("") ! Prefix not used do i=1,size(module_names) @@ -857,7 +859,7 @@ subroutine check_valid_enforced_module_names_dashed(error) !> All these names are valid both with and without enforcing do j=1,2 - if (.not.is_valid_module_name(modules,package,enforcing(j))) then + if (.not.is_valid_module_name(modules,package,prefix,enforcing(j))) then call test_failed(error,'Valid dummy module name ['//modules%s//'] of package ['// & package%s//'] unexpectedly fails naming check (enforcing='// & merge('T','F',enforcing(j))//').') @@ -875,7 +877,7 @@ subroutine check_invalid_enforced_module_names(error) type(error_t), allocatable, intent(out) :: error integer :: i - type(string_t) :: package,modules + type(string_t) :: package,modules,prefix character(*), parameter :: package_name = 'my_pkg' character(len=80), parameter :: module_names(*) = [ character(len=80) :: & 'mod_1', & @@ -890,13 +892,14 @@ subroutine check_invalid_enforced_module_names(error) package = string_t(package_name) + prefix = string_t("") ! Prefix not used !> All these cases should report an invalid name do i=1,size(module_names) modules = string_t(trim(module_names(i))) - if (is_valid_module_name(modules,package,.true.)) then + if (is_valid_module_name(modules,package,prefix,.true.)) then call test_failed(error,'Invalid dummy module name ['//modules%s//'] of package ['// & package%s//'] unexpectedly passes naming check (enforcing=T).') return @@ -916,7 +919,7 @@ subroutine check_invalid_module_names(error) type(error_t), allocatable, intent(out) :: error integer :: i - type(string_t) :: modules,package + type(string_t) :: modules,package,prefix !> Examples taken from Metcalf/Reid/Cohen character(len=80), parameter :: module_names(*) = [ character(len=80) :: & @@ -928,13 +931,14 @@ subroutine check_invalid_module_names(error) 'and/other?symbols@2' ] package = string_t("") + prefix = string_t("") ! Prefix not used !> All these cases should report an invalid name do i=1,size(module_names) modules = string_t(module_names(i)) - if (is_valid_module_name(modules,package,.false.)) then + if (is_valid_module_name(modules,package,prefix,.false.)) then call test_failed(error,'Invalid Fortran module name ['//modules%s//'] ' & //' unexpectedly passes naming check.') return From 1b9ba7bb1e30b0fc25cde6384d5d6ab6eb9b43c3 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 9 Feb 2023 10:51:17 +0100 Subject: [PATCH 22/31] move naming functions to `fpm_strings.f90` --- src/fpm.f90 | 136 +---------------- src/fpm/manifest/build.f90 | 33 +---- src/fpm_strings.f90 | 162 ++++++++++++++++++++- test/fpm_test/test_module_dependencies.f90 | 4 +- 4 files changed, 165 insertions(+), 170 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index a172df199d..11cd3511b0 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -1,7 +1,7 @@ module fpm use fpm_strings, only: string_t, operator(.in.), glob, join, string_cat, & lower, str_ends_with, is_fortran_name, str_begins_with_str, & - to_fortran_name, len_trim + is_valid_module_name use fpm_backend, only: build_package use fpm_command_line, only: fpm_build_settings, fpm_new_settings, & fpm_run_settings, fpm_install_settings, fpm_test_settings, & @@ -21,7 +21,6 @@ module fpm resolve_target_linking, build_target_t, build_target_ptr, & FPM_TARGET_EXECUTABLE, FPM_TARGET_ARCHIVE use fpm_manifest, only : get_package_data, package_config_t -use fpm_manifest_build, only: is_valid_module_prefix use fpm_error, only : error_t, fatal_error, fpm_stop use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, & & stdout=>output_unit, & @@ -31,7 +30,6 @@ module fpm private public :: cmd_build, cmd_run, cmd_clean public :: build_model, check_modules_for_duplicates -public :: is_valid_module_name contains @@ -607,138 +605,6 @@ end subroutine compact_list end subroutine cmd_run -!> Check that a module name fits the current naming rules: -!> 1) It must be a valid FORTRAN name (<=63 chars, begin with letter, "_" is only allowed non-alphanumeric) -!> 2) It must begin with the package name -!> 3) If longer, package name must be followed by default separator plus at least one char -logical function is_valid_module_name(module_name,package_name,custom_prefix,enforce_module_names) result(valid) - - type(string_t), intent(in) :: module_name - type(string_t), intent(in) :: package_name - type(string_t), intent(in) :: custom_prefix - logical , intent(in) :: enforce_module_names - - - !> Basic check: check the name is Fortran-compliant - valid = is_fortran_name(module_name%s); if (.not.valid) return - - !> FPM package enforcing: check that the module name begins with the package name - if (enforce_module_names) then - - ! Default prefixing is always valid - valid = has_valid_standard_prefix(module_name,package_name) - - ! If a custom prefix was validated, it provides additional naming options - ! Because they never overlap with the default prefix, the former is always an option - if (len_trim(custom_prefix)>0 .and. .not.valid) & - valid = has_valid_custom_prefix(module_name,custom_prefix) - - end if - -end function is_valid_module_name - -!> Check that a module name is prefixed with a custom prefix: -!> 1) It must be a valid FORTRAN name subset (<=63 chars, begin with letter, only alphanumeric allowed) -!> 2) It must begin with the prefix -!> 3) If longer, package name must be followed by default separator ("_") plus at least one char -logical function has_valid_custom_prefix(module_name,custom_prefix) result(valid) - - type(string_t), intent(in) :: module_name - type(string_t), intent(in) :: custom_prefix - - !> custom_module separator: single underscore - character(*), parameter :: SEP = "_" - - logical :: is_same,has_separator,same_beginning - integer :: lpkg,lmod,lsep - - !> Basic check: check that both names are individually valid - valid = is_fortran_name(module_name%s) .and. & - is_valid_module_prefix(custom_prefix) - - !> FPM package enforcing: check that the module name begins with the custom prefix - if (valid) then - - !> Query string lengths - lpkg = len_trim(custom_prefix) - lmod = len_trim(module_name) - lsep = len_trim(SEP) - - same_beginning = str_begins_with_str(module_name%s,custom_prefix%s,case_sensitive=.false.) - - is_same = lpkg==lmod .and. same_beginning - - if (lmod>=lpkg+lsep) then - has_separator = str_begins_with_str(module_name%s(lpkg+1:lpkg+lsep),SEP) - else - has_separator = .false. - endif - - !> 2) It must begin with the package name. - !> 3) It can be equal to the package name, or, if longer, must be followed by the - ! default separator plus at least one character - !> 4) Package name must not end with an underscore - valid = same_beginning .and. (is_same .or. (lmod>lpkg+lsep .and. has_separator)) - - end if - -end function has_valid_custom_prefix - - -!> Check that a module name is prefixed with the default package prefix: -!> 1) It must be a valid FORTRAN name (<=63 chars, begin with letter, "_" is only allowed non-alphanumeric) -!> 2) It must begin with the package name -!> 3) If longer, package name must be followed by default separator plus at least one char -logical function has_valid_standard_prefix(module_name,package_name) result(valid) - - type(string_t), intent(in) :: module_name - type(string_t), intent(in) :: package_name - - !> Default package__module separator: two underscores - character(*), parameter :: SEP = "__" - - character(len=:), allocatable :: fortranized_pkg - logical :: is_same,has_separator,same_beginning - integer :: lpkg,lmod,lsep - - !> Basic check: check the name is Fortran-compliant - valid = is_fortran_name(module_name%s) - - !> FPM package enforcing: check that the module name begins with the package name - if (valid) then - - fortranized_pkg = to_fortran_name(package_name%s) - - !> Query string lengths - lpkg = len_trim(fortranized_pkg) - lmod = len_trim(module_name) - lsep = len_trim(SEP) - - same_beginning = str_begins_with_str(module_name%s,fortranized_pkg,case_sensitive=.false.) - - is_same = lpkg==lmod .and. same_beginning - - if (lmod>=lpkg+lsep) then - has_separator = str_begins_with_str(module_name%s(lpkg+1:lpkg+lsep),SEP) - else - has_separator = .false. - endif - - !> 2) It must begin with the package name. - !> 3) It can be equal to the package name, or, if longer, must be followed by the - ! default separator plus at least one character - !> 4) Package name must not end with an underscore - valid = is_fortran_name(fortranized_pkg) .and. & - fortranized_pkg(lpkg:lpkg)/='_' .and. & - (same_beginning .and. (is_same .or. (lmod>lpkg+lsep .and. has_separator))) - - print *, 'is_F = ',is_fortran_name(fortranized_pkg),' ends with _ ',fortranized_pkg(lpkg:lpkg)=='_',& - ' same beg=',same_beginning,' is_same=',is_same,' has_sep=',has_separator,' l=',lmod,lpkg,lsep - - end if - -end function has_valid_standard_prefix - subroutine delete_skip(unix) !> delete directories in the build folder, skipping dependencies logical, intent(in) :: unix diff --git a/src/fpm/manifest/build.f90 b/src/fpm/manifest/build.f90 index e98319b178..8437b2d2c7 100644 --- a/src/fpm/manifest/build.f90 +++ b/src/fpm/manifest/build.f90 @@ -11,16 +11,13 @@ !>``` module fpm_manifest_build use fpm_error, only : error_t, syntax_error, fatal_error - use fpm_strings, only : string_t, len_trim + use fpm_strings, only : string_t, len_trim, is_valid_module_prefix use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, get_list implicit none private public :: build_config_t, new_build_config - public :: is_valid_module_prefix - - !> Configuration data for build type :: build_config_t @@ -132,34 +129,6 @@ subroutine new_build_config(self, table, error) end subroutine new_build_config - !> Check that a custom module prefix fits the current naming rules: - !> 1) Only alphanumeric characters (no spaces, dashes, underscores or other characters) - !> 2) Does not begin with a number (Fortran-compatible syntax) - logical function is_valid_module_prefix(module_prefix) result(valid) - - type(string_t), intent(in) :: module_prefix - - character(len=*),parameter :: num='0123456789' - character(len=*),parameter :: lower='abcdefghijklmnopqrstuvwxyz' - character(len=*),parameter :: upper='ABCDEFGHIJKLMNOPQRSTUVWXYZ' - character(len=*),parameter :: alpha =upper//lower - character(len=*),parameter :: allowed=alpha//num - - integer :: i - character(len=:),allocatable :: name - - name = trim(module_prefix%s) - - if (len(name)>0 .and. len(name)<=63) then - valid = verify(name(1:1), alpha) == 0 .and. & - verify(name,allowed) == 0 - else - valid = .false. - endif - - end function is_valid_module_prefix - - !> Check local schema for allowed entries subroutine check(table, error) diff --git a/src/fpm_strings.f90 b/src/fpm_strings.f90 index c9eec90ea0..253f4dee6d 100644 --- a/src/fpm_strings.f90 +++ b/src/fpm_strings.f90 @@ -45,6 +45,10 @@ module fpm_strings public :: replace, resize, str, join, glob public :: notabs +!> Module naming +public :: is_valid_module_name, is_valid_module_prefix, & + has_valid_custom_prefix, has_valid_standard_prefix + type string_t character(len=:), allocatable :: s end type @@ -1028,7 +1032,163 @@ function is_fortran_name(line) result (lout) else lout = .false. endif - end function is_fortran_name +end function is_fortran_name + +!> Check that a module name fits the current naming rules: +!> 1) It must be a valid FORTRAN name (<=63 chars, begin with letter, "_" is only allowed non-alphanumeric) +!> 2) It must begin with the package name +!> 3) If longer, package name must be followed by default separator plus at least one char +logical function is_valid_module_name(module_name,package_name,custom_prefix,enforce_module_names) result(valid) + + type(string_t), intent(in) :: module_name + type(string_t), intent(in) :: package_name + type(string_t), intent(in) :: custom_prefix + logical , intent(in) :: enforce_module_names + + + !> Basic check: check the name is Fortran-compliant + valid = is_fortran_name(module_name%s); if (.not.valid) return + + !> FPM package enforcing: check that the module name begins with the package name + if (enforce_module_names) then + + ! Default prefixing is always valid + valid = has_valid_standard_prefix(module_name,package_name) + + ! If a custom prefix was validated, it provides additional naming options + ! Because they never overlap with the default prefix, the former is always an option + if (len_trim(custom_prefix)>0 .and. .not.valid) & + valid = has_valid_custom_prefix(module_name,custom_prefix) + + end if + +end function is_valid_module_name + +!> Check that a custom module prefix fits the current naming rules: +!> 1) Only alphanumeric characters (no spaces, dashes, underscores or other characters) +!> 2) Does not begin with a number (Fortran-compatible syntax) +logical function is_valid_module_prefix(module_prefix) result(valid) + + type(string_t), intent(in) :: module_prefix + + character(len=*),parameter :: num='0123456789' + character(len=*),parameter :: lower='abcdefghijklmnopqrstuvwxyz' + character(len=*),parameter :: upper='ABCDEFGHIJKLMNOPQRSTUVWXYZ' + character(len=*),parameter :: alpha =upper//lower + character(len=*),parameter :: allowed=alpha//num + + character(len=:),allocatable :: name + + name = trim(module_prefix%s) + + if (len(name)>0 .and. len(name)<=63) then + valid = verify(name(1:1), alpha) == 0 .and. & + verify(name,allowed) == 0 + else + valid = .false. + endif + +end function is_valid_module_prefix + +!> Check that a module name is prefixed with a custom prefix: +!> 1) It must be a valid FORTRAN name subset (<=63 chars, begin with letter, only alphanumeric allowed) +!> 2) It must begin with the prefix +!> 3) If longer, package name must be followed by default separator ("_") plus at least one char +logical function has_valid_custom_prefix(module_name,custom_prefix) result(valid) + + type(string_t), intent(in) :: module_name + type(string_t), intent(in) :: custom_prefix + + !> custom_module separator: single underscore + character(*), parameter :: SEP = "_" + + logical :: is_same,has_separator,same_beginning + integer :: lpkg,lmod,lsep + + !> Basic check: check that both names are individually valid + valid = is_fortran_name(module_name%s) .and. & + is_valid_module_prefix(custom_prefix) + + !> FPM package enforcing: check that the module name begins with the custom prefix + if (valid) then + + !> Query string lengths + lpkg = len_trim(custom_prefix) + lmod = len_trim(module_name) + lsep = len_trim(SEP) + + same_beginning = str_begins_with_str(module_name%s,custom_prefix%s,case_sensitive=.false.) + + is_same = lpkg==lmod .and. same_beginning + + if (lmod>=lpkg+lsep) then + has_separator = str_begins_with_str(module_name%s(lpkg+1:lpkg+lsep),SEP) + else + has_separator = .false. + endif + + !> 2) It must begin with the package name. + !> 3) It can be equal to the package name, or, if longer, must be followed by the + ! default separator plus at least one character + !> 4) Package name must not end with an underscore + valid = same_beginning .and. (is_same .or. (lmod>lpkg+lsep .and. has_separator)) + + end if + +end function has_valid_custom_prefix + + +!> Check that a module name is prefixed with the default package prefix: +!> 1) It must be a valid FORTRAN name (<=63 chars, begin with letter, "_" is only allowed non-alphanumeric) +!> 2) It must begin with the package name +!> 3) If longer, package name must be followed by default separator plus at least one char +logical function has_valid_standard_prefix(module_name,package_name) result(valid) + + type(string_t), intent(in) :: module_name + type(string_t), intent(in) :: package_name + + !> Default package__module separator: two underscores + character(*), parameter :: SEP = "__" + + character(len=:), allocatable :: fortranized_pkg + logical :: is_same,has_separator,same_beginning + integer :: lpkg,lmod,lsep + + !> Basic check: check the name is Fortran-compliant + valid = is_fortran_name(module_name%s) + + !> FPM package enforcing: check that the module name begins with the package name + if (valid) then + + fortranized_pkg = to_fortran_name(package_name%s) + + !> Query string lengths + lpkg = len_trim(fortranized_pkg) + lmod = len_trim(module_name) + lsep = len_trim(SEP) + + same_beginning = str_begins_with_str(module_name%s,fortranized_pkg,case_sensitive=.false.) + + is_same = lpkg==lmod .and. same_beginning + + if (lmod>=lpkg+lsep) then + has_separator = str_begins_with_str(module_name%s(lpkg+1:lpkg+lsep),SEP) + else + has_separator = .false. + endif + + !> 2) It must begin with the package name. + !> 3) It can be equal to the package name, or, if longer, must be followed by the + ! default separator plus at least one character + !> 4) Package name must not end with an underscore + valid = is_fortran_name(fortranized_pkg) .and. & + fortranized_pkg(lpkg:lpkg)/='_' .and. & + (same_beginning .and. (is_same .or. (lmod>lpkg+lsep .and. has_separator))) + + end if + +end function has_valid_standard_prefix + !> !!### NAME !! notabs(3f) - [fpm_strings:NONALPHA] expand tab characters diff --git a/test/fpm_test/test_module_dependencies.f90 b/test/fpm_test/test_module_dependencies.f90 index b42cced8ce..60e7d26ae1 100644 --- a/test/fpm_test/test_module_dependencies.f90 +++ b/test/fpm_test/test_module_dependencies.f90 @@ -9,8 +9,8 @@ module test_module_dependencies FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, & FPM_UNIT_CHEADER, FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, & FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST - use fpm_strings, only: string_t, operator(.in.) - use fpm, only: check_modules_for_duplicates, is_valid_module_name + use fpm_strings, only: string_t, operator(.in.), is_valid_module_name + use fpm, only: check_modules_for_duplicates implicit none private From f6f309d33173a8e7f5cc3f7532c490aa360be81d Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 9 Feb 2023 10:58:19 +0100 Subject: [PATCH 23/31] test custom prefixes --- test/fpm_test/test_module_dependencies.f90 | 59 +++++++++++++++++++++- 1 file changed, 57 insertions(+), 2 deletions(-) diff --git a/test/fpm_test/test_module_dependencies.f90 b/test/fpm_test/test_module_dependencies.f90 index 60e7d26ae1..2b2aef670d 100644 --- a/test/fpm_test/test_module_dependencies.f90 +++ b/test/fpm_test/test_module_dependencies.f90 @@ -9,7 +9,7 @@ module test_module_dependencies FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, & FPM_UNIT_CHEADER, FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, & FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST - use fpm_strings, only: string_t, operator(.in.), is_valid_module_name + use fpm_strings, only: string_t, operator(.in.), is_valid_module_name, is_valid_module_prefix use fpm, only: check_modules_for_duplicates implicit none private @@ -63,7 +63,9 @@ subroutine collect_module_dependencies(testsuite) & new_unittest("invalid-enforced-module-names", & check_invalid_enforced_module_names, should_fail=.false.), & & new_unittest("invalid-module-names", & - check_invalid_module_names, should_fail=.false.) & + check_invalid_module_names, should_fail=.false.), & + & new_unittest("custom-module-prefixes", & + check_valid_custom_prefix, should_fail=.false.) & ] end subroutine collect_module_dependencies @@ -948,6 +950,59 @@ subroutine check_invalid_module_names(error) end subroutine check_invalid_module_names + !> Check several module prefixes that are valid + subroutine check_valid_custom_prefix(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: i + type(string_t) :: prefix + character(len=80), parameter :: valid_prefixes(*) = [ character(len=80) :: & + 'm', & + 'mp', & + 'mypkg', & + 'mypkg123', & + 'mypackage', & + 'tomlf' ] + + character(len=80), parameter :: invalid_prefixes(*) = [ character(len=80) :: & + 'm_', & + 'm-p', & + 'my_pkg', & + 'my-pkg123', & + 'my package', & + 'toml-f', & + '123pkg', & + 'mypkg_' ] + ! All valid + do i=1,size(valid_prefixes) + + prefix = string_t(valid_prefixes(i)) + + !> All these names are valid both with and without enforcing + if (.not.is_valid_module_prefix(prefix)) then + call test_failed(error,'Valid dummy module prefix ['//prefix%s//'] '//& + ' unexpectedly fails naming check.') + return + endif + end do + + ! All invalid + do i=1,size(invalid_prefixes) + + prefix = string_t(invalid_prefixes(i)) + + !> All these names are valid both with and without enforcing + if (is_valid_module_prefix(prefix)) then + call test_failed(error,'Invalid dummy module prefix ['//prefix%s//'] '//& + ' unexpectedly passed naming check.') + return + endif + end do + + end subroutine check_valid_custom_prefix + !> Helper to check if a build target is in a list of build_target_ptr logical function target_in(needle,haystack) type(build_target_t), intent(in), target :: needle From f8a94f30f0926f7184493e5d88e617aebb2f7051 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 9 Feb 2023 11:12:04 +0100 Subject: [PATCH 24/31] test standard and custom-prefixed module names --- test/fpm_test/test_module_dependencies.f90 | 65 +++++++++++++++++++++- 1 file changed, 64 insertions(+), 1 deletion(-) diff --git a/test/fpm_test/test_module_dependencies.f90 b/test/fpm_test/test_module_dependencies.f90 index 2b2aef670d..b9ca37144e 100644 --- a/test/fpm_test/test_module_dependencies.f90 +++ b/test/fpm_test/test_module_dependencies.f90 @@ -65,7 +65,9 @@ subroutine collect_module_dependencies(testsuite) & new_unittest("invalid-module-names", & check_invalid_module_names, should_fail=.false.), & & new_unittest("custom-module-prefixes", & - check_valid_custom_prefix, should_fail=.false.) & + check_valid_custom_prefix, should_fail=.false.), & + & new_unittest("custom-prefixed-module-names", & + check_custom_prefixed_modules, should_fail=.false.) & ] end subroutine collect_module_dependencies @@ -1003,6 +1005,67 @@ subroutine check_valid_custom_prefix(error) end subroutine check_valid_custom_prefix + !> Check several module prefixes that are valid + subroutine check_custom_prefixed_modules(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: i + type(string_t) :: prefix,modules,package + character(len=*), parameter :: custom_prefix = 'mp123' + character(len=*), parameter :: package_name = 'my-package' + + character(len=80), parameter :: module_names(*) = [ character(len=80) :: & + 'mp123', & + 'mp123_utils', & + 'mp123__utils', & + 'mp123_test', & + 'mp123_my_module_name',& + 'my_package__utils',& + 'my_package',& + 'my_package__123'] + + character(len=80), parameter :: invalid_names(*) = [ character(len=80) :: & + 'utils', & + 'mp_123_utils', & + 'mypackage__utils', & + 'my_package_utils', & + 'my_package_test'] + + prefix = string_t(custom_prefix) + package = string_t(package_name) + + ! All valid + do i=1,size(module_names) + + modules = string_t(module_names(i)) + + !> All these names are valid both with and without enforcing + if (.not.is_valid_module_name(modules,package,prefix,.true.)) then + call test_failed(error,'Valid prefixed module ['//modules%s//'] ' //& + ' from package ['//package%s//'] with prefix ['//& + prefix%s//'] unexpectedly fails naming check.') + return + endif + end do + + ! All invalid + do i=1,size(invalid_names) + + modules = string_t(invalid_names(i)) + + !> All these names are valid both with and without enforcing + if (is_valid_module_name(modules,package,prefix,.true.)) then + call test_failed(error,'Invalid prefixed module ['//modules%s//'] ' //& + ' from package ['//package%s//'] with prefix ['//& + prefix%s//'] unexpectedly passed naming check.') + return + endif + end do + + end subroutine check_custom_prefixed_modules + !> Helper to check if a build target is in a list of build_target_ptr logical function target_in(needle,haystack) type(build_target_t), intent(in), target :: needle From bf4b837a6625275c0fe38c51d98846ba2d811ed1 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 9 Feb 2023 11:49:38 +0100 Subject: [PATCH 25/31] query and check custom prefix from all dependencies --- src/fpm.f90 | 26 +++++++++++++++++++++++--- src/fpm/manifest/build.f90 | 2 -- src/fpm_model.f90 | 19 ++++++++++++++++++- 3 files changed, 41 insertions(+), 6 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 11cd3511b0..a145e0159a 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -1,7 +1,7 @@ module fpm use fpm_strings, only: string_t, operator(.in.), glob, join, string_cat, & lower, str_ends_with, is_fortran_name, str_begins_with_str, & - is_valid_module_name + is_valid_module_name, len_trim use fpm_backend, only: build_package use fpm_command_line, only: fpm_build_settings, fpm_new_settings, & fpm_run_settings, fpm_install_settings, fpm_test_settings, & @@ -94,6 +94,7 @@ subroutine build_model(model, settings, package, error) model%include_tests = settings%build_tests model%enforce_module_names = package%build%module_naming + model%module_prefix = package%build%module_prefix allocate(model%packages(model%deps%ndep)) @@ -155,6 +156,11 @@ subroutine build_model(model, settings, package, error) if (allocated(dependency%build%external_modules)) then model%external_modules = [model%external_modules, dependency%build%external_modules] end if + + ! Copy naming conventions from this dependency's manifest + model%packages(i)%enforce_module_names = dependency%build%module_naming + model%packages(i)%module_prefix = dependency%build%module_prefix + end associate end do if (allocated(error)) return @@ -309,8 +315,12 @@ subroutine check_module_names(model, error) package_name = string_t(model%packages(k)%name) - ! Custom prefix is not currently active - package_prefix = string_t("") + ! Custom prefix is taken from each dependency's manifest + if (model%packages(k)%enforce_module_names) then + package_prefix = model%packages(k)%module_prefix + else + package_prefix = string_t("") + end if do l=1,size(model%packages(k)%sources) if (allocated(model%packages(k)%sources(l)%modules_provided)) then @@ -327,10 +337,20 @@ subroutine check_module_names(model, error) if (model%enforce_module_names) then + if (len_trim(package_prefix)>0) then + + write(stderr, *) "ERROR: Module ",module_name%s, & + " in ",model%packages(k)%sources(l)%file_name, & + " does not match its package name ("//package_name%s// & + ") or custom prefix ("//package_prefix%s//")." + else + write(stderr, *) "ERROR: Module ",module_name%s, & " in ",model%packages(k)%sources(l)%file_name, & " does not match its package name ("//package_name%s//")." + endif + else write(stderr, *) "ERROR: Module ",module_name%s, & diff --git a/src/fpm/manifest/build.f90 b/src/fpm/manifest/build.f90 index 8437b2d2c7..8047dd045d 100644 --- a/src/fpm/manifest/build.f90 +++ b/src/fpm/manifest/build.f90 @@ -32,8 +32,6 @@ module fpm_manifest_build !> Enforcing of package module names logical :: module_naming = .false. - - !> Custom module name prefix type(string_t) :: module_prefix !> Libraries to link against diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index 9e973635cb..c5fe38cc77 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -38,7 +38,7 @@ module fpm_model use iso_fortran_env, only: int64 use fpm_compiler, only: compiler_t, archiver_t, debug use fpm_dependency, only: dependency_tree_t -use fpm_strings, only: string_t, str +use fpm_strings, only: string_t, str, len_trim implicit none private @@ -130,6 +130,10 @@ module fpm_model !> Package version number. character(:), allocatable :: version + !> Module naming conventions + logical :: enforce_module_names + type(string_t) :: module_prefix + end type package_t @@ -181,6 +185,7 @@ module fpm_model !> Whether module names should be prefixed with the package name logical :: enforce_module_names = .false. + type(string_t) :: module_prefix end type fpm_model_t @@ -202,6 +207,14 @@ function info_package(p) result(s) if (i < size(p%sources)) s = s // ", " end do s = s // "]" + + ! Print module naming convention + s = s // ', enforce_module_names="' // merge('T','F',p%enforce_module_names) // '"' + + ! Print custom prefix + if (p%enforce_module_names .and. len_trim(p%module_prefix)>0) & + s = s // ', custom_prefix="' // p%module_prefix%s // '"' + s = s // ")" end function info_package @@ -350,6 +363,10 @@ function info_model(model) result(s) ! Print module naming convention s = s // ', enforce_module_names="' // merge('T','F',model%enforce_module_names) // '"' + ! Print custom prefix + if (model%enforce_module_names .and. len_trim(model%module_prefix)>0) & + s = s // ', custom_prefix="' // model%module_prefix%s // '"' + !end type fpm_model_t s = s // ")" end function info_model From 396524c232930c10edc59d150705bc1a8baa96d5 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 9 Feb 2023 12:00:55 +0100 Subject: [PATCH 26/31] add warning --- src/fpm.f90 | 6 ++++++ src/fpm_strings.f90 | 32 +++++++++++++++++++++++++++++++- 2 files changed, 37 insertions(+), 1 deletion(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index a145e0159a..351ccb078b 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -322,6 +322,12 @@ subroutine check_module_names(model, error) package_prefix = string_t("") end if + ! Warn the user if some of the dependencies have loose naming + if (model%enforce_module_names .and. .not.model%packages(k)%enforce_module_names) then + write(stderr, *) "Warning: Dependency ",package_name%s // & + " does not enforce module naming, but project does. " + end if + do l=1,size(model%packages(k)%sources) if (allocated(model%packages(k)%sources(l)%modules_provided)) then do m=1,size(model%packages(k)%sources(l)%modules_provided) diff --git a/src/fpm_strings.f90 b/src/fpm_strings.f90 index 253f4dee6d..f8dc4e6daf 100644 --- a/src/fpm_strings.f90 +++ b/src/fpm_strings.f90 @@ -47,7 +47,8 @@ module fpm_strings !> Module naming public :: is_valid_module_name, is_valid_module_prefix, & - has_valid_custom_prefix, has_valid_standard_prefix + has_valid_custom_prefix, has_valid_standard_prefix, & + module_prefix_template, module_prefix_type type string_t character(len=:), allocatable :: s @@ -1090,6 +1091,35 @@ logical function is_valid_module_prefix(module_prefix) result(valid) end function is_valid_module_prefix + +type(string_t) function module_prefix_template(project_name,custom_prefix) result(prefix) + type(string_t), intent(in) :: project_name + type(string_t), intent(in) :: custom_prefix + + if (is_valid_module_prefix(custom_prefix)) then + + prefix = string_t(trim(custom_prefix%s)//"_") + + else + + prefix = string_t(to_fortran_name(project_name%s)//"__") + + end if + +end function module_prefix_template + +type(string_t) function module_prefix_type(project_name,custom_prefix) result(ptype) + type(string_t), intent(in) :: project_name + type(string_t), intent(in) :: custom_prefix + + if (is_valid_module_prefix(custom_prefix)) then + ptype = string_t("custom") + else + ptype = string_t("default") + end if + +end function module_prefix_type + !> Check that a module name is prefixed with a custom prefix: !> 1) It must be a valid FORTRAN name subset (<=63 chars, begin with letter, only alphanumeric allowed) !> 2) It must begin with the prefix From ee2bb685a5dfd4e2d6c660a660f8f844cc468e83 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 9 Feb 2023 12:14:36 +0100 Subject: [PATCH 27/31] rename all test modules to `fpm_test*` --- test/fpm_test/main.f90 | 18 +++++++++--------- test/fpm_test/test_backend.f90 | 8 ++++---- test/fpm_test/test_filesystem.f90 | 6 +++--- test/fpm_test/test_installer.f90 | 6 +++--- test/fpm_test/test_manifest.f90 | 6 +++--- test/fpm_test/test_module_dependencies.f90 | 6 +++--- test/fpm_test/test_package_dependencies.f90 | 6 +++--- test/fpm_test/test_source_parsing.f90 | 8 ++++---- test/fpm_test/test_toml.f90 | 6 +++--- test/fpm_test/test_versioning.f90 | 6 +++--- test/fpm_test/testsuite.f90 | 4 ++-- 11 files changed, 40 insertions(+), 40 deletions(-) diff --git a/test/fpm_test/main.f90 b/test/fpm_test/main.f90 index 0a653076d6..4713032b49 100644 --- a/test/fpm_test/main.f90 +++ b/test/fpm_test/main.f90 @@ -3,15 +3,15 @@ program fpm_testing use, intrinsic :: iso_fortran_env, only : error_unit use testsuite, only : run_testsuite, new_testsuite, testsuite_t, & & select_suite, run_selected - use test_toml, only : collect_toml - use test_manifest, only : collect_manifest - use test_filesystem, only : collect_filesystem - use test_source_parsing, only : collect_source_parsing - use test_module_dependencies, only : collect_module_dependencies - use test_package_dependencies, only : collect_package_dependencies - use test_backend, only: collect_backend - use test_installer, only : collect_installer - use test_versioning, only : collect_versioning + use fpm_test_toml, only : collect_toml + use fpm_test_manifest, only : collect_manifest + use fpm_test_filesystem, only : collect_filesystem + use fpm_test_source_parsing, only : collect_source_parsing + use fpm_test_module_dependencies, only : collect_module_dependencies + use fpm_test_package_dependencies, only : collect_package_dependencies + use fpm_test_backend, only: collect_backend + use fpm_test_installer, only : collect_installer + use fpm_test_versioning, only : collect_versioning implicit none integer :: stat, is character(len=:), allocatable :: suite_name, test_name diff --git a/test/fpm_test/test_backend.f90 b/test/fpm_test/test_backend.f90 index 402e8b4d0b..2709f81d1f 100644 --- a/test/fpm_test/test_backend.f90 +++ b/test/fpm_test/test_backend.f90 @@ -1,7 +1,7 @@ !> Define tests for the `fpm_backend` module (build scheduling) -module test_backend - use testsuite, only : new_unittest, unittest_t, error_t, test_failed - use test_module_dependencies, only: operator(.in.) +module fpm_test_backend + use fpm_testsuite, only : new_unittest, unittest_t, error_t, test_failed + use fpm_test_module_dependencies, only: operator(.in.) use fpm_filesystem, only: exists, mkdir, get_temp_filename use fpm_targets, only: build_target_t, build_target_ptr, & FPM_TARGET_OBJECT, FPM_TARGET_ARCHIVE, & @@ -355,4 +355,4 @@ function new_test_package() result(targets) end function new_test_package -end module test_backend +end module fpm_test_backend diff --git a/test/fpm_test/test_filesystem.f90 b/test/fpm_test/test_filesystem.f90 index b6b7681706..b6ab320046 100644 --- a/test/fpm_test/test_filesystem.f90 +++ b/test/fpm_test/test_filesystem.f90 @@ -1,5 +1,5 @@ -module test_filesystem - use testsuite, only : new_unittest, unittest_t, error_t, test_failed +module fpm_test_filesystem + use fpm_testsuite, only : new_unittest, unittest_t, error_t, test_failed use fpm_filesystem, only: canon_path, is_dir, mkdir, os_delete_dir, & join_path use fpm_environment, only: OS_WINDOWS, get_os_type, os_is_unix @@ -176,4 +176,4 @@ subroutine check_rmdir(error, path) end subroutine check_rmdir -end module test_filesystem +end module fpm_test_filesystem diff --git a/test/fpm_test/test_installer.f90 b/test/fpm_test/test_installer.f90 index 1235ba5bc2..b272e06190 100644 --- a/test/fpm_test/test_installer.f90 +++ b/test/fpm_test/test_installer.f90 @@ -2,8 +2,8 @@ !> !> The tests here setup a mock environment to allow testing for Unix and Windows !> platforms at the same time. -module test_installer - use testsuite, only : new_unittest, unittest_t, error_t, test_failed, & +module fpm_test_installer + use fpm_testsuite, only : new_unittest, unittest_t, error_t, test_failed, & & check_string use fpm_environment, only : OS_WINDOWS, OS_LINUX use fpm_filesystem, only : join_path @@ -165,4 +165,4 @@ subroutine run(self, command, error) call check_string(error, self%expected_run, command, "run") end subroutine run -end module test_installer +end module fpm_test_installer diff --git a/test/fpm_test/test_manifest.f90 b/test/fpm_test/test_manifest.f90 index 820d6889ea..c8ceb397dd 100644 --- a/test/fpm_test/test_manifest.f90 +++ b/test/fpm_test/test_manifest.f90 @@ -1,7 +1,7 @@ !> Define tests for the `fpm_manifest` modules -module test_manifest +module fpm_test_manifest use fpm_filesystem, only: get_temp_filename - use testsuite, only : new_unittest, unittest_t, error_t, test_failed, & + use fpm_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 @@ -1392,4 +1392,4 @@ subroutine test_macro_parsing_dependency(error) end subroutine test_macro_parsing_dependency -end module test_manifest +end module fpm_test_manifest diff --git a/test/fpm_test/test_module_dependencies.f90 b/test/fpm_test/test_module_dependencies.f90 index b9ca37144e..d3519fa136 100644 --- a/test/fpm_test/test_module_dependencies.f90 +++ b/test/fpm_test/test_module_dependencies.f90 @@ -1,6 +1,6 @@ !> Define tests for the `fpm_sources` module (module dependency checking) -module test_module_dependencies - use testsuite, only : new_unittest, unittest_t, error_t, test_failed +module fpm_test_module_dependencies + use fpm_testsuite, only : new_unittest, unittest_t, error_t, test_failed use fpm_targets, only: targets_from_sources, resolve_module_dependencies, & resolve_target_linking, build_target_t, build_target_ptr, & FPM_TARGET_EXECUTABLE, FPM_TARGET_OBJECT, FPM_TARGET_ARCHIVE @@ -1086,4 +1086,4 @@ logical function target_in(needle,haystack) end function target_in -end module test_module_dependencies +end module fpm_test_module_dependencies diff --git a/test/fpm_test/test_package_dependencies.f90 b/test/fpm_test/test_package_dependencies.f90 index 26f6852a0e..70a715f4b4 100644 --- a/test/fpm_test/test_package_dependencies.f90 +++ b/test/fpm_test/test_package_dependencies.f90 @@ -1,7 +1,7 @@ !> Define tests for the `fpm_dependency` module -module test_package_dependencies +module fpm_test_package_dependencies use fpm_filesystem, only: get_temp_filename - use testsuite, only : new_unittest, unittest_t, error_t, test_failed + use fpm_testsuite, only : new_unittest, unittest_t, error_t, test_failed use fpm_dependency use fpm_manifest use fpm_manifest_dependency @@ -234,4 +234,4 @@ subroutine resolve_dependency_once(self, dependency, root, error) end subroutine resolve_dependency_once -end module test_package_dependencies +end module fpm_test_package_dependencies diff --git a/test/fpm_test/test_source_parsing.f90 b/test/fpm_test/test_source_parsing.f90 index 73e7e6b162..8382d477e4 100644 --- a/test/fpm_test/test_source_parsing.f90 +++ b/test/fpm_test/test_source_parsing.f90 @@ -1,6 +1,6 @@ !> Define tests for the `fpm_sources` module (parsing routines) -module test_source_parsing - use testsuite, only : new_unittest, unittest_t, error_t, test_failed +module fpm_test_source_parsing + use fpm_testsuite, only : new_unittest, unittest_t, error_t, test_failed use fpm_filesystem, only: get_temp_filename use fpm_source_parsing, only: parse_f_source, parse_c_source use fpm_model, only: srcfile_t, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & @@ -819,7 +819,7 @@ subroutine test_csource(error) call test_failed(error,'Unexpected link_libraries - expecting unallocated') return end if - + if (size(f_source%parent_modules) /= 0) then call test_failed(error,'Incorrect number of parent_modules - expecting zero') return @@ -947,4 +947,4 @@ end subroutine test_invalid_submodule -end module test_source_parsing +end module fpm_test_source_parsing diff --git a/test/fpm_test/test_toml.f90 b/test/fpm_test/test_toml.f90 index 1ffea1d651..ea74bce538 100644 --- a/test/fpm_test/test_toml.f90 +++ b/test/fpm_test/test_toml.f90 @@ -1,6 +1,6 @@ !> Define tests for the `fpm_toml` modules -module test_toml - use testsuite, only : new_unittest, unittest_t, error_t +module fpm_test_toml + use fpm_testsuite, only : new_unittest, unittest_t, error_t use fpm_toml implicit none private @@ -104,4 +104,4 @@ subroutine test_missing_file(error) end subroutine test_missing_file -end module test_toml +end module fpm_test_toml diff --git a/test/fpm_test/test_versioning.f90 b/test/fpm_test/test_versioning.f90 index b309d1382c..f0cf61531e 100644 --- a/test/fpm_test/test_versioning.f90 +++ b/test/fpm_test/test_versioning.f90 @@ -1,6 +1,6 @@ !> Test implementation of version data type -module test_versioning - use testsuite, only : new_unittest, unittest_t, error_t, test_failed +module fpm_test_versioning + use fpm_testsuite, only : new_unittest, unittest_t, error_t, test_failed use fpm_versioning implicit none private @@ -401,4 +401,4 @@ subroutine test_invalid_overflow(error) end subroutine test_invalid_overflow -end module test_versioning +end module fpm_test_versioning diff --git a/test/fpm_test/testsuite.f90 b/test/fpm_test/testsuite.f90 index 124d19a5b4..afcf7825f6 100644 --- a/test/fpm_test/testsuite.f90 +++ b/test/fpm_test/testsuite.f90 @@ -1,5 +1,5 @@ !> Define some procedures to automate collecting and launching of tests -module testsuite +module fpm_testsuite use fpm_error, only : error_t, test_failed => fatal_error implicit none private @@ -283,4 +283,4 @@ subroutine check_string(error, actual, expected, name) end subroutine check_string -end module testsuite +end module fpm_testsuite From 691c9cccf34ab5fa151cf054773970ea0b8004ab Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 9 Feb 2023 12:53:24 +0100 Subject: [PATCH 28/31] bugfix: rename `testsuite` to `fpm_testsuite` in test main file --- test/fpm_test/main.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/fpm_test/main.f90 b/test/fpm_test/main.f90 index 4713032b49..a532396920 100644 --- a/test/fpm_test/main.f90 +++ b/test/fpm_test/main.f90 @@ -1,7 +1,7 @@ !> Driver for unit testing program fpm_testing use, intrinsic :: iso_fortran_env, only : error_unit - use testsuite, only : run_testsuite, new_testsuite, testsuite_t, & + use fpm_testsuite, only : run_testsuite, new_testsuite, testsuite_t, & & select_suite, run_selected use fpm_test_toml, only : collect_toml use fpm_test_manifest, only : collect_manifest From 7780d7e89d50745ae1ec20f6aaa3341887be476b Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 17 Feb 2023 11:23:08 +0100 Subject: [PATCH 29/31] restore original test module names: `fpm_test*`->`test*` --- test/fpm_test/main.f90 | 20 ++++++++++---------- test/fpm_test/test_backend.f90 | 8 ++++---- test/fpm_test/test_filesystem.f90 | 6 +++--- test/fpm_test/test_installer.f90 | 6 +++--- test/fpm_test/test_manifest.f90 | 6 +++--- test/fpm_test/test_module_dependencies.f90 | 6 +++--- test/fpm_test/test_package_dependencies.f90 | 6 +++--- test/fpm_test/test_source_parsing.f90 | 6 +++--- test/fpm_test/test_toml.f90 | 6 +++--- test/fpm_test/test_versioning.f90 | 6 +++--- test/fpm_test/testsuite.f90 | 4 ++-- 11 files changed, 40 insertions(+), 40 deletions(-) diff --git a/test/fpm_test/main.f90 b/test/fpm_test/main.f90 index a532396920..0a653076d6 100644 --- a/test/fpm_test/main.f90 +++ b/test/fpm_test/main.f90 @@ -1,17 +1,17 @@ !> Driver for unit testing program fpm_testing use, intrinsic :: iso_fortran_env, only : error_unit - use fpm_testsuite, only : run_testsuite, new_testsuite, testsuite_t, & + use testsuite, only : run_testsuite, new_testsuite, testsuite_t, & & select_suite, run_selected - use fpm_test_toml, only : collect_toml - use fpm_test_manifest, only : collect_manifest - use fpm_test_filesystem, only : collect_filesystem - use fpm_test_source_parsing, only : collect_source_parsing - use fpm_test_module_dependencies, only : collect_module_dependencies - use fpm_test_package_dependencies, only : collect_package_dependencies - use fpm_test_backend, only: collect_backend - use fpm_test_installer, only : collect_installer - use fpm_test_versioning, only : collect_versioning + use test_toml, only : collect_toml + use test_manifest, only : collect_manifest + use test_filesystem, only : collect_filesystem + use test_source_parsing, only : collect_source_parsing + use test_module_dependencies, only : collect_module_dependencies + use test_package_dependencies, only : collect_package_dependencies + use test_backend, only: collect_backend + use test_installer, only : collect_installer + use test_versioning, only : collect_versioning implicit none integer :: stat, is character(len=:), allocatable :: suite_name, test_name diff --git a/test/fpm_test/test_backend.f90 b/test/fpm_test/test_backend.f90 index 2709f81d1f..402e8b4d0b 100644 --- a/test/fpm_test/test_backend.f90 +++ b/test/fpm_test/test_backend.f90 @@ -1,7 +1,7 @@ !> Define tests for the `fpm_backend` module (build scheduling) -module fpm_test_backend - use fpm_testsuite, only : new_unittest, unittest_t, error_t, test_failed - use fpm_test_module_dependencies, only: operator(.in.) +module test_backend + use testsuite, only : new_unittest, unittest_t, error_t, test_failed + use test_module_dependencies, only: operator(.in.) use fpm_filesystem, only: exists, mkdir, get_temp_filename use fpm_targets, only: build_target_t, build_target_ptr, & FPM_TARGET_OBJECT, FPM_TARGET_ARCHIVE, & @@ -355,4 +355,4 @@ function new_test_package() result(targets) end function new_test_package -end module fpm_test_backend +end module test_backend diff --git a/test/fpm_test/test_filesystem.f90 b/test/fpm_test/test_filesystem.f90 index b6ab320046..b6b7681706 100644 --- a/test/fpm_test/test_filesystem.f90 +++ b/test/fpm_test/test_filesystem.f90 @@ -1,5 +1,5 @@ -module fpm_test_filesystem - use fpm_testsuite, only : new_unittest, unittest_t, error_t, test_failed +module test_filesystem + use testsuite, only : new_unittest, unittest_t, error_t, test_failed use fpm_filesystem, only: canon_path, is_dir, mkdir, os_delete_dir, & join_path use fpm_environment, only: OS_WINDOWS, get_os_type, os_is_unix @@ -176,4 +176,4 @@ subroutine check_rmdir(error, path) end subroutine check_rmdir -end module fpm_test_filesystem +end module test_filesystem diff --git a/test/fpm_test/test_installer.f90 b/test/fpm_test/test_installer.f90 index b272e06190..1235ba5bc2 100644 --- a/test/fpm_test/test_installer.f90 +++ b/test/fpm_test/test_installer.f90 @@ -2,8 +2,8 @@ !> !> The tests here setup a mock environment to allow testing for Unix and Windows !> platforms at the same time. -module fpm_test_installer - use fpm_testsuite, only : new_unittest, unittest_t, error_t, test_failed, & +module test_installer + use testsuite, only : new_unittest, unittest_t, error_t, test_failed, & & check_string use fpm_environment, only : OS_WINDOWS, OS_LINUX use fpm_filesystem, only : join_path @@ -165,4 +165,4 @@ subroutine run(self, command, error) call check_string(error, self%expected_run, command, "run") end subroutine run -end module fpm_test_installer +end module test_installer diff --git a/test/fpm_test/test_manifest.f90 b/test/fpm_test/test_manifest.f90 index c8ceb397dd..820d6889ea 100644 --- a/test/fpm_test/test_manifest.f90 +++ b/test/fpm_test/test_manifest.f90 @@ -1,7 +1,7 @@ !> Define tests for the `fpm_manifest` modules -module fpm_test_manifest +module test_manifest use fpm_filesystem, only: get_temp_filename - use fpm_testsuite, only : new_unittest, unittest_t, error_t, test_failed, & + 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 @@ -1392,4 +1392,4 @@ subroutine test_macro_parsing_dependency(error) end subroutine test_macro_parsing_dependency -end module fpm_test_manifest +end module test_manifest diff --git a/test/fpm_test/test_module_dependencies.f90 b/test/fpm_test/test_module_dependencies.f90 index d3519fa136..b9ca37144e 100644 --- a/test/fpm_test/test_module_dependencies.f90 +++ b/test/fpm_test/test_module_dependencies.f90 @@ -1,6 +1,6 @@ !> Define tests for the `fpm_sources` module (module dependency checking) -module fpm_test_module_dependencies - use fpm_testsuite, only : new_unittest, unittest_t, error_t, test_failed +module test_module_dependencies + use testsuite, only : new_unittest, unittest_t, error_t, test_failed use fpm_targets, only: targets_from_sources, resolve_module_dependencies, & resolve_target_linking, build_target_t, build_target_ptr, & FPM_TARGET_EXECUTABLE, FPM_TARGET_OBJECT, FPM_TARGET_ARCHIVE @@ -1086,4 +1086,4 @@ logical function target_in(needle,haystack) end function target_in -end module fpm_test_module_dependencies +end module test_module_dependencies diff --git a/test/fpm_test/test_package_dependencies.f90 b/test/fpm_test/test_package_dependencies.f90 index 70a715f4b4..26f6852a0e 100644 --- a/test/fpm_test/test_package_dependencies.f90 +++ b/test/fpm_test/test_package_dependencies.f90 @@ -1,7 +1,7 @@ !> Define tests for the `fpm_dependency` module -module fpm_test_package_dependencies +module test_package_dependencies use fpm_filesystem, only: get_temp_filename - use fpm_testsuite, only : new_unittest, unittest_t, error_t, test_failed + use testsuite, only : new_unittest, unittest_t, error_t, test_failed use fpm_dependency use fpm_manifest use fpm_manifest_dependency @@ -234,4 +234,4 @@ subroutine resolve_dependency_once(self, dependency, root, error) end subroutine resolve_dependency_once -end module fpm_test_package_dependencies +end module test_package_dependencies diff --git a/test/fpm_test/test_source_parsing.f90 b/test/fpm_test/test_source_parsing.f90 index 8382d477e4..b480e76c33 100644 --- a/test/fpm_test/test_source_parsing.f90 +++ b/test/fpm_test/test_source_parsing.f90 @@ -1,6 +1,6 @@ !> Define tests for the `fpm_sources` module (parsing routines) -module fpm_test_source_parsing - use fpm_testsuite, only : new_unittest, unittest_t, error_t, test_failed +module test_source_parsing + use testsuite, only : new_unittest, unittest_t, error_t, test_failed use fpm_filesystem, only: get_temp_filename use fpm_source_parsing, only: parse_f_source, parse_c_source use fpm_model, only: srcfile_t, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & @@ -947,4 +947,4 @@ end subroutine test_invalid_submodule -end module fpm_test_source_parsing +end module test_source_parsing diff --git a/test/fpm_test/test_toml.f90 b/test/fpm_test/test_toml.f90 index ea74bce538..1ffea1d651 100644 --- a/test/fpm_test/test_toml.f90 +++ b/test/fpm_test/test_toml.f90 @@ -1,6 +1,6 @@ !> Define tests for the `fpm_toml` modules -module fpm_test_toml - use fpm_testsuite, only : new_unittest, unittest_t, error_t +module test_toml + use testsuite, only : new_unittest, unittest_t, error_t use fpm_toml implicit none private @@ -104,4 +104,4 @@ subroutine test_missing_file(error) end subroutine test_missing_file -end module fpm_test_toml +end module test_toml diff --git a/test/fpm_test/test_versioning.f90 b/test/fpm_test/test_versioning.f90 index f0cf61531e..b309d1382c 100644 --- a/test/fpm_test/test_versioning.f90 +++ b/test/fpm_test/test_versioning.f90 @@ -1,6 +1,6 @@ !> Test implementation of version data type -module fpm_test_versioning - use fpm_testsuite, only : new_unittest, unittest_t, error_t, test_failed +module test_versioning + use testsuite, only : new_unittest, unittest_t, error_t, test_failed use fpm_versioning implicit none private @@ -401,4 +401,4 @@ subroutine test_invalid_overflow(error) end subroutine test_invalid_overflow -end module fpm_test_versioning +end module test_versioning diff --git a/test/fpm_test/testsuite.f90 b/test/fpm_test/testsuite.f90 index afcf7825f6..124d19a5b4 100644 --- a/test/fpm_test/testsuite.f90 +++ b/test/fpm_test/testsuite.f90 @@ -1,5 +1,5 @@ !> Define some procedures to automate collecting and launching of tests -module fpm_testsuite +module testsuite use fpm_error, only : error_t, test_failed => fatal_error implicit none private @@ -283,4 +283,4 @@ subroutine check_string(error, actual, expected, name) end subroutine check_string -end module fpm_testsuite +end module testsuite From 60b90b86bf8a06b5fe7a70797deebbbc4bec9f99 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 17 Feb 2023 11:23:34 +0100 Subject: [PATCH 30/31] do not enforce naming on test modules --- src/fpm.f90 | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 351ccb078b..98ba0293ca 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -303,7 +303,7 @@ subroutine check_module_names(model, error) type(fpm_model_t), intent(in) :: model type(error_t), allocatable, intent(out) :: error integer :: i,j,k,l,m - logical :: valid,errors_found + logical :: valid,errors_found,enforce_this_file type(string_t) :: package_name,module_name,package_prefix errors_found = .false. @@ -334,14 +334,18 @@ subroutine check_module_names(model, error) module_name = model%packages(k)%sources(l)%modules_provided(m) + ! Module naming is not enforced in test modules + enforce_this_file = model%enforce_module_names .and. & + model%packages(k)%sources(l)%unit_scope/=FPM_SCOPE_TEST + valid = is_valid_module_name(module_name, & package_name, & package_prefix, & - model%enforce_module_names) + enforce_this_file) if (.not.valid) then - if (model%enforce_module_names) then + if (enforce_this_file) then if (len_trim(package_prefix)>0) then From 2a26611417d901d80383be95645b9edbf84f0819 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 17 Feb 2023 11:27:22 +0100 Subject: [PATCH 31/31] move to the source loop --- src/fpm.f90 | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 98ba0293ca..a7ff6fa6b1 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -329,15 +329,17 @@ subroutine check_module_names(model, error) end if do l=1,size(model%packages(k)%sources) + + ! Module naming is not enforced in test modules + enforce_this_file = model%enforce_module_names .and. & + model%packages(k)%sources(l)%unit_scope/=FPM_SCOPE_TEST + if (allocated(model%packages(k)%sources(l)%modules_provided)) then + do m=1,size(model%packages(k)%sources(l)%modules_provided) module_name = model%packages(k)%sources(l)%modules_provided(m) - ! Module naming is not enforced in test modules - enforce_this_file = model%enforce_module_names .and. & - model%packages(k)%sources(l)%unit_scope/=FPM_SCOPE_TEST - valid = is_valid_module_name(module_name, & package_name, & package_prefix, &