Enforce module naming

.gitignore

@@ -2,3 +2,6 @@ build/*
 
 # Visual Studio Code
 .vscode/
+
+# CodeBlocks
+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, &
+                      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, &
@@ -29,6 +30,7 @@ module fpm
 private
 public :: cmd_build, cmd_run, cmd_clean
 public :: build_model, check_modules_for_duplicates
+public :: is_valid_module_name
 
 contains
 
@@ -92,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))
 
@@ -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
@@ -233,7 +236,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 +293,69 @@ 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
+
+                        if (model%enforce_module_names) 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//")."
+
+                        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
@@ -532,6 +602,58 @@ 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,enforce_module_names) result(valid)
+
+    type(string_t), intent(in) :: module_name
+    type(string_t), intent(in) :: package_name
+    logical       , intent(in) :: enforce_module_names
+
+    !> 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
+        !> 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
+
+end function is_valid_module_name
+
 subroutine delete_skip(unix)
     !> delete directories in the build folder, skipping dependencies
     logical, intent(in) :: unix

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)

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 = .false.
+
 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

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]]', &
@@ -361,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)
@@ -523,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)') &
@@ -635,7 +635,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 +653,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 +694,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 +1236,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 +1272,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.
@@ -1289,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
@@ -1304,9 +1314,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 +1327,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 +1356,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 +1368,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 +1389,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