Enforce module naming

.gitignore

@@ -4,4 +4,5 @@ build/*
 .vscode/
 
 # CodeBlocks
-project/*
+project/
+

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
+                      lower, str_ends_with, is_fortran_name, str_begins_with_str, &
+                      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, &
@@ -92,6 +93,8 @@ 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
+    model%module_prefix = package%build%module_prefix
 
     allocate(model%packages(model%deps%ndep))
 
@@ -107,7 +110,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
@@ -153,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
@@ -233,7 +241,11 @@ subroutine build_model(model, settings, package, error)
         write(*,*)'<INFO> CXX COMPILER OPTIONS: ', model%cxx_compile_flags
         write(*,*)'<INFO> LINKER OPTIONS:  ', model%link_flags
         write(*,*)'<INFO> 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)
@@ -286,6 +298,99 @@ 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,enforce_this_file
+    type(string_t) :: package_name,module_name,package_prefix
+
+    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)
+
+        ! 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
+
+        ! 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)
+
+            ! 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)
+
+                    valid = is_valid_module_name(module_name, &
+                                                 package_name, &
+                                                 package_prefix, &
+                                                 enforce_this_file)
+
+                    if (.not.valid) then
+
+                        if (enforce_this_file) 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, &
+                                             " 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
+
+        if (model%enforce_module_names) &
+            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)// &
+                               " 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

src/fpm/manifest/build.f90

@@ -11,14 +11,13 @@
 !>```
 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, 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
 
-
     !> Configuration data for build
     type :: build_config_t
 
@@ -31,6 +30,10 @@ module fpm_manifest_build
         !> Automatic discovery of tests
         logical :: auto_tests
 
+        !> Enforcing of package module names
+        logical :: module_naming = .false.
+        type(string_t) :: module_prefix
+
         !> Libraries to link against
         type(string_t), allocatable :: link(:)
 
@@ -86,6 +89,35 @@ 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
+
+            ! 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)
         if (allocated(error)) return
@@ -95,7 +127,6 @@ subroutine new_build_config(self, table, error)
 
     end subroutine new_build_config
 
-
     !> Check local schema for allowed entries
     subroutine check(table, error)
 
@@ -119,6 +150,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 +190,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)

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
 
 
@@ -179,6 +183,10 @@ 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 = .false.
+    type(string_t) :: module_prefix
+
 end type fpm_model_t
 
 contains
@@ -199,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
@@ -343,6 +359,14 @@ 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) // '"'
+
+    ! 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