From 39d67cb35227b001b5671ea1e2f8010c9a64de3f Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sun, 13 Mar 2022 10:55:18 +0000 Subject: [PATCH 01/19] Refactor parsing: immediately skip commented lines --- src/fpm_source_parsing.f90 | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/fpm_source_parsing.f90 b/src/fpm_source_parsing.f90 index 17a99bcf67..06cbd95461 100644 --- a/src/fpm_source_parsing.f90 +++ b/src/fpm_source_parsing.f90 @@ -105,6 +105,11 @@ function parse_f_source(f_filename,error) result(f_source) n_mod = 0 file_loop: do i=1,size(file_lines_lower) + ! Skip comment lines + if (index(file_lines_lower(i)%s,'!') == 1) then + cycle + end if + ! Skip lines that are continued: not statements if (i > 1) then ic = index(file_lines_lower(i-1)%s,'!') From 20643a48939486ba0f6031c89f51a4b21c30b066 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sun, 13 Mar 2022 10:57:30 +0000 Subject: [PATCH 02/19] Refactor parsing: stop parsing line after successful parse Add cycle statements after a line has been parse successfully to avoid reparsing it as a different kind of statement. --- src/fpm_source_parsing.f90 | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/src/fpm_source_parsing.f90 b/src/fpm_source_parsing.f90 index 06cbd95461..8e514cdcc9 100644 --- a/src/fpm_source_parsing.f90 +++ b/src/fpm_source_parsing.f90 @@ -173,6 +173,8 @@ function parse_f_source(f_filename,error) result(f_source) end if + cycle + end if ! Process 'INCLUDE' statements @@ -194,6 +196,9 @@ function parse_f_source(f_filename,error) result(f_source) return end if end if + + cycle + end if end if @@ -239,6 +244,8 @@ function parse_f_source(f_filename,error) result(f_source) f_source%unit_type = FPM_UNIT_MODULE + cycle + end if ! Extract name of submodule if is submodule @@ -293,6 +300,8 @@ function parse_f_source(f_filename,error) result(f_source) end if + cycle + end if ! Detect if contains a program @@ -313,6 +322,8 @@ function parse_f_source(f_filename,error) result(f_source) f_source%unit_type = FPM_UNIT_PROGRAM + cycle + end if end do file_loop From 17ac86bdcbd34d37459ac333d8d613798b824176 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sun, 13 Mar 2022 11:48:50 +0000 Subject: [PATCH 03/19] Update parsing: to detect subprograms outside modules Sources files are only designated as FPM_UNIT_MODULE if they only contain modules. Non-program sources that contain subprograms not in modules are designated as FPM_UNIT_SUBPROGRAM. --- src/fpm_model.f90 | 25 +++++++++++-- src/fpm_source_parsing.f90 | 47 +++++++++++++++++++----- test/fpm_test/test_source_parsing.f90 | 53 ++++++++++++++++++++++++++- 3 files changed, 111 insertions(+), 14 deletions(-) diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index d3ff038044..c13ac6b8f9 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -14,6 +14,23 @@ !> __Source type:__ `FPM_UNIT_*` !> Describes the type of source file — determines build target generation !> +!> The logical order of precedence for assigning `unit_type` is as follows: +!> +!>``` +!> if source-file contains program then +!> unit_type = FPM_UNIT_PROGRAM +!> else if source-file contains non-module subroutine/function then +!> unit_type = FPM_UNIT_SUBPROGRAM +!> else if source-file contains submodule then +!> unit_type = FPM_UNIT_SUBMODULE +!> else if source-file contains module then +!> unit_type = FPM_UNIT_MODULE +!> end if +!>``` +!> +!> @note A source file is only designated `FPM_UNIT_MODULE` if it **only** contains modules - no non-module subprograms. +!> (This allows tree-shaking/pruning of build targets based on unused module dependencies.) +!> !> __Source scope:__ `FPM_SCOPE_*` !> Describes the scoping rules for using modules — controls module dependency resolution !> @@ -34,13 +51,13 @@ module fpm_model !> Source type unknown integer, parameter :: FPM_UNIT_UNKNOWN = -1 -!> Source type is fortran program +!> Source contains a fortran program integer, parameter :: FPM_UNIT_PROGRAM = 1 -!> Source type is fortran module +!> Source **only** contains one or more fortran modules integer, parameter :: FPM_UNIT_MODULE = 2 -!> Source type is fortran submodule +!> Source contains one or more fortran submodules integer, parameter :: FPM_UNIT_SUBMODULE = 3 -!> Source type is fortran subprogram +!> Source contains one or more fortran subprogram not within modules integer, parameter :: FPM_UNIT_SUBPROGRAM = 4 !> Source type is c source file integer, parameter :: FPM_UNIT_CSOURCE = 5 diff --git a/src/fpm_source_parsing.f90 b/src/fpm_source_parsing.f90 index 8e514cdcc9..c1fba3ae49 100644 --- a/src/fpm_source_parsing.f90 +++ b/src/fpm_source_parsing.f90 @@ -76,6 +76,7 @@ function parse_f_source(f_filename,error) result(f_source) type(srcfile_t) :: f_source type(error_t), allocatable, intent(out) :: error + logical :: inside_module integer :: stat integer :: fh, n_use, n_include, n_mod, i, j, ic, pass type(string_t), allocatable :: file_lines(:), file_lines_lower(:) @@ -103,6 +104,7 @@ function parse_f_source(f_filename,error) result(f_source) n_use = 0 n_include = 0 n_mod = 0 + inside_module = .false. file_loop: do i=1,size(file_lines_lower) ! Skip comment lines @@ -242,7 +244,11 @@ function parse_f_source(f_filename,error) result(f_source) f_source%modules_provided(n_mod) = string_t(mod_name) end if - f_source%unit_type = FPM_UNIT_MODULE + if (f_source%unit_type == FPM_UNIT_UNKNOWN) then + f_source%unit_type = FPM_UNIT_MODULE + end if + + inside_module = .true. cycle @@ -274,11 +280,15 @@ function parse_f_source(f_filename,error) result(f_source) file_lines_lower(i)%s) return end if - - f_source%unit_type = FPM_UNIT_SUBMODULE + + if (f_source%unit_type /= FPM_UNIT_PROGRAM) then + f_source%unit_type = FPM_UNIT_SUBMODULE + end if n_use = n_use + 1 + inside_module = .true. + if (pass == 2) then if (index(temp_string,':') > 0) then @@ -323,15 +333,34 @@ function parse_f_source(f_filename,error) result(f_source) f_source%unit_type = FPM_UNIT_PROGRAM cycle - + end if - end do file_loop + ! Parse end module statement + ! (to check for code outside of modules) + if (index(file_lines_lower(i)%s,'end') == 1) then - ! Default to subprogram unit type - if (f_source%unit_type == FPM_UNIT_UNKNOWN) then - f_source%unit_type = FPM_UNIT_SUBPROGRAM - end if + temp_string = split_n(file_lines_lower(i)%s,n=2,delims=' ',stat=stat) + + if (stat == 0) then + if (temp_string == 'module' .or. temp_string == 'submodule') then + + inside_module = .false. + cycle + + end if + end if + + end if + + ! Any statements not yet parsed are assumed to be other code statements + if (.not.inside_module .and. f_source%unit_type /= FPM_UNIT_PROGRAM) then + + f_source%unit_type = FPM_UNIT_SUBPROGRAM + + end if + + end do file_loop if (pass == 1) then allocate(f_source%modules_used(n_use)) diff --git a/test/fpm_test/test_source_parsing.f90 b/test/fpm_test/test_source_parsing.f90 index 047b289b03..1e8a9db8a3 100644 --- a/test/fpm_test/test_source_parsing.f90 +++ b/test/fpm_test/test_source_parsing.f90 @@ -26,6 +26,7 @@ subroutine collect_source_parsing(testsuite) & new_unittest("include-stmt", test_include_stmt), & & new_unittest("program", test_program), & & new_unittest("module", test_module), & + & new_unittest("module-with-subprogram", test_module_with_subprogram), & & new_unittest("program-with-module", test_program_with_module), & & new_unittest("submodule", test_submodule), & & new_unittest("submodule-ancestor", test_submodule_ancestor), & @@ -335,7 +336,8 @@ subroutine test_module(error) & 'string = " &', & & 'module name !"', & & 'end function i', & - & 'end module test' + & 'end module test', & + & '! A trailing comment outside of module' close(unit) f_source = parse_f_source(temp_file,error) @@ -371,6 +373,55 @@ subroutine test_module(error) end subroutine test_module + !> Try to parse fortran module with subroutine outside of module + !> (this should be detected as FPM_UNIT_SUBPROGRAM not FPM_UNIT_MODULE) + subroutine test_module_with_subprogram(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: unit + character(:), allocatable :: temp_file + type(srcfile_t), allocatable :: f_source + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'module my_mod', & + & 'contains', & + & 'module subroutine f()', & + & 'end subroutine f', & + & 'module function g()', & + & 'end function g', & + & 'end module test',& + & 'function h()', & + & 'end function' + close(unit) + + f_source = parse_f_source(temp_file,error) + if (allocated(error)) then + return + end if + + if (f_source%unit_type /= FPM_UNIT_SUBPROGRAM) then + call test_failed(error,'Wrong unit type detected - expecting FPM_UNIT_SUBPROGRAM') + return + end if + + if (size(f_source%modules_provided) /= 1) then + call test_failed(error,'Unexpected modules_provided - expecting one') + return + end if + + if (size(f_source%modules_used) /= 0) then + call test_failed(error,'Incorrect number of modules_used - expecting zero') + return + end if + + end subroutine test_module_with_subprogram + + !> Try to parse combined fortran module and program !> Check that parsed unit type is FPM_UNIT_PROGRAM subroutine test_program_with_module(error) From 219c98c094629d93132a2e6bcb9b62662e4ef4f4 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sun, 13 Mar 2022 12:37:51 +0000 Subject: [PATCH 04/19] Add: tree-shaking/pruning of unused modules --- src/fpm_source_parsing.f90 | 15 ++++- src/fpm_targets.f90 | 115 +++++++++++++++++++++++++++++++++++++ 2 files changed, 129 insertions(+), 1 deletion(-) diff --git a/src/fpm_source_parsing.f90 b/src/fpm_source_parsing.f90 index c1fba3ae49..40002077fd 100644 --- a/src/fpm_source_parsing.f90 +++ b/src/fpm_source_parsing.f90 @@ -248,7 +248,14 @@ function parse_f_source(f_filename,error) result(f_source) f_source%unit_type = FPM_UNIT_MODULE end if - inside_module = .true. + if (.not.inside_module) then + inside_module = .true. + else + ! Must have missed an end module statement (can't assume a pure module) + if (f_source%unit_type /= FPM_UNIT_PROGRAM) then + f_source%unit_type = FPM_UNIT_SUBPROGRAM + end if + end if cycle @@ -362,6 +369,12 @@ function parse_f_source(f_filename,error) result(f_source) end do file_loop + ! If unable to parse end of module statement, then can't assume pure module + ! (there could be non-module subprograms present) + if (inside_module .and. f_source%unit_type == FPM_UNIT_MODULE) then + f_source%unit_type = FPM_UNIT_SUBPROGRAM + end if + if (pass == 1) then allocate(f_source%modules_used(n_use)) allocate(f_source%include_dependencies(n_include)) diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index 122d73a7cd..7e6641ab36 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -136,6 +136,8 @@ subroutine targets_from_sources(targets,model,error) call resolve_module_dependencies(targets,model%external_modules,error) if (allocated(error)) return + call prune_build_targets(targets) + call resolve_target_linking(targets,model) end subroutine targets_from_sources @@ -453,6 +455,119 @@ function find_module_dependency(targets,module_name,include_dir) result(target_p end function find_module_dependency +!> Perform tree-shaking to remove unused module targets +subroutine prune_build_targets(targets) + type(build_target_ptr), intent(inout), allocatable :: targets(:) + + integer :: i, j, nexec + type(string_t), allocatable :: modules_used(:) + logical :: exclude_target(size(targets)) + logical, allocatable :: exclude_from_archive(:) + + nexec = 0 + allocate(modules_used(0)) + + ! Enumerate modules used by executables and their dependencies + do i=1,size(targets) + + if (targets(i)%ptr%target_type == FPM_TARGET_EXECUTABLE) then + + nexec = nexec + 1 + call collect_used_modules(targets(i)%ptr) + + end if + + end do + + ! Can't prune targets without executables + ! (everything will be built) + if (nexec < 1) then + return + end if + + exclude_target(:) = .false. + + ! Exclude purely module targets if they are not used anywhere + do i=1,size(targets) + associate(target=>targets(i)%ptr) + + if (allocated(target%source)) then + if (target%source%unit_type == FPM_UNIT_MODULE) then + + exclude_target(i) = .true. + target%skip = .true. + + do j=1,size(target%source%modules_provided) + + if (target%source%modules_provided(j)%s .in. modules_used) then + + exclude_target(i) = .false. + target%skip = .false. + + end if + + end do + + end if + end if + + end associate + end do + + targets = pack(targets,.not.exclude_target) + + ! Remove unused targets from archive dependency list + if (targets(1)%ptr%target_type == FPM_TARGET_ARCHIVE) then + associate(archive=>targets(1)%ptr) + + allocate(exclude_from_archive(size(archive%dependencies))) + exclude_from_archive(:) = .false. + + do i=1,size(archive%dependencies) + + if (archive%dependencies(i)%ptr%skip) then + + exclude_from_archive(i) = .true. + + end if + + end do + + archive%dependencies = pack(archive%dependencies,.not.exclude_from_archive) + + end associate + end if + + contains + + recursive subroutine collect_used_modules(target) + type(build_target_t), intent(in) :: target + + integer :: j + + if (allocated(target%source)) then + do j=1,size(target%source%modules_used) + + if (.not.(target%source%modules_used(j)%s .in. modules_used)) then + + modules_used = [modules_used, target%source%modules_used(j)] + + end if + + end do + end if + + do j=1,size(target%dependencies) + + call collect_used_modules(target%dependencies(j)%ptr) + + end do + + end subroutine collect_used_modules + +end subroutine prune_build_targets + + !> Construct the linker flags string for each target !> `target%link_flags` includes non-library objects and library flags !> From 7d65003405ed9a654122070192259edb39b86466 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sun, 13 Mar 2022 12:38:22 +0000 Subject: [PATCH 05/19] Add: test package for tree-shaking --- ci/run_tests.sh | 8 ++++++++ example_packages/README.md | 1 + example_packages/tree_shake/.gitignore | 1 + example_packages/tree_shake/app/say_Hello.f90 | 7 +++++++ example_packages/tree_shake/fpm.toml | 1 + example_packages/tree_shake/src/farewell_m.f90 | 14 ++++++++++++++ example_packages/tree_shake/src/greet_m.f90 | 14 ++++++++++++++ .../tree_shake/src/subdir/constants.f90 | 7 +++++++ .../tree_shake/test/greet_test.f90 | 18 ++++++++++++++++++ 9 files changed, 71 insertions(+) create mode 100644 example_packages/tree_shake/.gitignore create mode 100644 example_packages/tree_shake/app/say_Hello.f90 create mode 100644 example_packages/tree_shake/fpm.toml create mode 100644 example_packages/tree_shake/src/farewell_m.f90 create mode 100644 example_packages/tree_shake/src/greet_m.f90 create mode 100644 example_packages/tree_shake/src/subdir/constants.f90 create mode 100644 example_packages/tree_shake/test/greet_test.f90 diff --git a/ci/run_tests.sh b/ci/run_tests.sh index 9525422f80..109273e933 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -62,6 +62,14 @@ test ! -x ./build/gfortran_*/app/unused test ! -x ./build/gfortran_*/test/unused_test popd +pushd tree_shake +"$fpm" build +"$fpm" run +"$fpm" test +test ! -e ./build/gfortran_*/tree_shake/src_farewell_m.f90.o +test ! -e ./build/gfortran_*/tree_shake/src_farewell_m.f90.o.log +popd + pushd version_file "$fpm" build "$fpm" run diff --git a/example_packages/README.md b/example_packages/README.md index 139f8dc6ed..a102269158 100644 --- a/example_packages/README.md +++ b/example_packages/README.md @@ -20,6 +20,7 @@ the features demonstrated in each package and which versions of fpm are supporte | makefile_complex | External build command (makefile); local path dependency | Y | N | | program_with_module | App-only; module+program in single source file | Y | Y | | submodules | Lib-only; submodules (3 levels) | N | Y | +| tree_shake | Test tree-shaking/pruning of unused module dependencies | N | Y | | link_external | Link external library | N | Y | | link_executable | Link external library to a single executable | N | Y | | version_file | Read version number from a file in the project root | N | Y | diff --git a/example_packages/tree_shake/.gitignore b/example_packages/tree_shake/.gitignore new file mode 100644 index 0000000000..a007feab07 --- /dev/null +++ b/example_packages/tree_shake/.gitignore @@ -0,0 +1 @@ +build/* diff --git a/example_packages/tree_shake/app/say_Hello.f90 b/example_packages/tree_shake/app/say_Hello.f90 new file mode 100644 index 0000000000..cf4a7421d3 --- /dev/null +++ b/example_packages/tree_shake/app/say_Hello.f90 @@ -0,0 +1,7 @@ +program say_Hello + use greet_m, only: make_greeting + + implicit none + + print *, make_greeting("World") +end program say_Hello diff --git a/example_packages/tree_shake/fpm.toml b/example_packages/tree_shake/fpm.toml new file mode 100644 index 0000000000..78267ce7cc --- /dev/null +++ b/example_packages/tree_shake/fpm.toml @@ -0,0 +1 @@ +name = "tree_shake" \ No newline at end of file diff --git a/example_packages/tree_shake/src/farewell_m.f90 b/example_packages/tree_shake/src/farewell_m.f90 new file mode 100644 index 0000000000..fbc45edf22 --- /dev/null +++ b/example_packages/tree_shake/src/farewell_m.f90 @@ -0,0 +1,14 @@ +module farewell_m + use subdir_constants, only: FAREWELL_STR + implicit none + private + + public :: make_farewell +contains + function make_farewell(name) result(greeting) + character(len=*), intent(in) :: name + character(len=:), allocatable :: greeting + + greeting = FAREWELL_STR // name // "!" + end function make_farewell +end module farewell_m diff --git a/example_packages/tree_shake/src/greet_m.f90 b/example_packages/tree_shake/src/greet_m.f90 new file mode 100644 index 0000000000..38afd08352 --- /dev/null +++ b/example_packages/tree_shake/src/greet_m.f90 @@ -0,0 +1,14 @@ +module greet_m + use subdir_constants, only: GREET_STR + implicit none + private + + public :: make_greeting +contains + function make_greeting(name) result(greeting) + character(len=*), intent(in) :: name + character(len=:), allocatable :: greeting + + greeting = GREET_STR // name // "!" + end function make_greeting +end module greet_m diff --git a/example_packages/tree_shake/src/subdir/constants.f90 b/example_packages/tree_shake/src/subdir/constants.f90 new file mode 100644 index 0000000000..59d6e5fee6 --- /dev/null +++ b/example_packages/tree_shake/src/subdir/constants.f90 @@ -0,0 +1,7 @@ +module subdir_constants +implicit none + +character(*), parameter :: GREET_STR = 'Hello, ' +character(*), parameter :: FAREWELL_STR = 'Goodbye, ' + +end module subdir_constants diff --git a/example_packages/tree_shake/test/greet_test.f90 b/example_packages/tree_shake/test/greet_test.f90 new file mode 100644 index 0000000000..41fa50878e --- /dev/null +++ b/example_packages/tree_shake/test/greet_test.f90 @@ -0,0 +1,18 @@ +program greet_test + use greet_m, only: make_greeting + use iso_fortran_env, only: error_unit, output_unit + + implicit none + + character(len=:), allocatable :: greeting + + allocate(character(len=0) :: greeting) + greeting = make_greeting("World") + + if (greeting == "Hello, World!") then + write(output_unit, *) "Passed" + else + write(error_unit, *) "Failed" + call exit(1) + end if +end program greet_test From 4eedd3aef3792508521fd0c3c5a00726ca2427b7 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sun, 13 Mar 2022 13:21:50 +0000 Subject: [PATCH 06/19] Add: test case for tree shaking of unused modules --- test/fpm_test/test_module_dependencies.f90 | 77 +++++++++++++++++++++- 1 file changed, 75 insertions(+), 2 deletions(-) diff --git a/test/fpm_test/test_module_dependencies.f90 b/test/fpm_test/test_module_dependencies.f90 index 53256be095..af26fc7528 100644 --- a/test/fpm_test/test_module_dependencies.f90 +++ b/test/fpm_test/test_module_dependencies.f90 @@ -51,9 +51,11 @@ subroutine collect_module_dependencies(testsuite) & new_unittest("subdirectory-module-use", & test_subdirectory_module_use), & & new_unittest("invalid-subdirectory-module-use", & - test_invalid_subdirectory_module_use, should_fail=.true.) & + test_invalid_subdirectory_module_use, should_fail=.true.), & + & new_unittest("tree-shake-module", & + test_tree_shake_module, should_fail=.false.) & ] - + end subroutine collect_module_dependencies @@ -495,6 +497,77 @@ subroutine test_package_module_duplicates_two_packages(error) end if end subroutine test_package_module_duplicates_two_packages + + !> Check tree-shaking of unused modules + !> Unused module should not be included in targets + subroutine test_tree_shake_module(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(fpm_model_t) :: model + type(build_target_ptr), allocatable :: targets(:) + character(:), allocatable :: scope_str + + allocate(model%external_modules(0)) + allocate(model%packages(1)) + allocate(model%packages(1)%sources(4)) + + model%packages(1)%sources(1) = new_test_source(FPM_UNIT_MODULE,file_name="src/my_mod_1.f90", & + scope = FPM_SCOPE_LIB, & + provides=[string_t('my_mod_1')]) ! indirectly used + + model%packages(1)%sources(2) = new_test_source(FPM_UNIT_MODULE,file_name="src/my_mod_2.f90", & + scope = FPM_SCOPE_LIB, & + provides=[string_t('my_mod_2')], & + uses=[string_t('my_mod_1')]) ! directly used + + model%packages(1)%sources(3) = new_test_source(FPM_UNIT_MODULE,file_name="src/my_mod_3.f90", & + scope = FPM_SCOPE_LIB, & + provides=[string_t('my_mod_3')]) ! unused module + + model%packages(1)%sources(4) = new_test_source(FPM_UNIT_PROGRAM,file_name="app/my_program.f90", & + scope=FPM_SCOPE_APP, & + uses=[string_t('my_mod_2')]) + + call targets_from_sources(targets,model,error) + if (allocated(error)) return + + if (size(targets) /= 5) then + call test_failed(error,scope_str//'Incorrect number of targets - expecting three') + return + end if + + call check_target(targets(1)%ptr,type=FPM_TARGET_ARCHIVE,n_depends=2, & + deps=[targets(2),targets(3)], & + links=[targets(2),targets(3)],error=error) + + if (allocated(error)) return + + call check_target(targets(2)%ptr,type=FPM_TARGET_OBJECT,n_depends=0, & + source=model%packages(1)%sources(1),error=error) + + if (allocated(error)) return + + call check_target(targets(3)%ptr,type=FPM_TARGET_OBJECT,n_depends=1, & + deps=[targets(2)],source=model%packages(1)%sources(2),error=error) + + if (allocated(error)) return + + call check_target(targets(4)%ptr,type=FPM_TARGET_OBJECT,n_depends=1, & + deps=[targets(3)],source=model%packages(1)%sources(4),error=error) + + if (allocated(error)) return + + call check_target(targets(5)%ptr,type=FPM_TARGET_EXECUTABLE,n_depends=2, & + deps=[targets(1),targets(4)], & + links=[targets(4)], error=error) + + if (allocated(error)) return + + end subroutine test_tree_shake_module + + !> Check program using a non-library module in a differente sub-directory subroutine test_invalid_subdirectory_module_use(error) From 4c05a6f08e43b120760491997d10d470929f5bc1 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sun, 13 Mar 2022 14:23:37 +0000 Subject: [PATCH 07/19] Add: parsing test case where we can't detect end module statement If we can't detect the end of a module, then we can't assume that there aren't non-module subprograms present, hence unit type becomes FPM_UNIT_SUBPROGRAM --- test/fpm_test/test_source_parsing.f90 | 66 +++++++++++++++++++++++++++ 1 file changed, 66 insertions(+) diff --git a/test/fpm_test/test_source_parsing.f90 b/test/fpm_test/test_source_parsing.f90 index 1e8a9db8a3..3a668f43cf 100644 --- a/test/fpm_test/test_source_parsing.f90 +++ b/test/fpm_test/test_source_parsing.f90 @@ -27,6 +27,7 @@ subroutine collect_source_parsing(testsuite) & new_unittest("program", test_program), & & new_unittest("module", test_module), & & new_unittest("module-with-subprogram", test_module_with_subprogram), & + & new_unittest("module-end-stmt", test_module_end_stmt), & & new_unittest("program-with-module", test_program_with_module), & & new_unittest("submodule", test_submodule), & & new_unittest("submodule-ancestor", test_submodule_ancestor), & @@ -422,6 +423,71 @@ subroutine test_module_with_subprogram(error) end subroutine test_module_with_subprogram + !> Try to parse fortran modules without the full end module statement + !> This should be detected as FPM_UNIT_SUBPROGRAM not FPM_UNIT_MODULE + !> because we cannot guarantee if non-module subprograms are present + subroutine test_module_end_stmt(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: unit + character(:), allocatable :: temp_file + type(srcfile_t), allocatable :: f_source + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'module mod1', & + & 'contains', & + & 'module subroutine f()', & + & 'end subroutine f', & + & 'module function g()', & + & 'end function g', & + & 'end', & + & 'module mod2', & + & 'contains', & + & 'module subroutine f()', & + & 'end subroutine f', & + & 'module function g()', & + & 'end function g', & + & 'end module mod2' + close(unit) + + f_source = parse_f_source(temp_file,error) + if (allocated(error)) then + return + end if + + if (f_source%unit_type /= FPM_UNIT_SUBPROGRAM) then + call test_failed(error,'Wrong unit type detected - expecting FPM_UNIT_SUBPROGRAM') + return + end if + + if (size(f_source%modules_provided) /= 2) then + call test_failed(error,'Unexpected modules_provided - expecting two') + return + end if + + if (size(f_source%modules_used) /= 0) then + call test_failed(error,'Incorrect number of modules_used - expecting zero') + return + end if + + if (.not.('mod1' .in. f_source%modules_provided)) then + call test_failed(error,'Missing module in modules_provided') + return + end if + + if (.not.('mod2' .in. f_source%modules_provided)) then + call test_failed(error,'Missing module in modules_provided') + return + end if + + end subroutine test_module_end_stmt + + !> Try to parse combined fortran module and program !> Check that parsed unit type is FPM_UNIT_PROGRAM subroutine test_program_with_module(error) From 089f9dc96ade5e5b545403d48cfd38c993138b75 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sun, 13 Mar 2022 14:31:07 +0000 Subject: [PATCH 08/19] Update: tree-shaking test for external function case --- example_packages/tree_shake/app/say_Hello.f90 | 8 ++++++++ example_packages/tree_shake/src/extra_m.f90 | 15 +++++++++++++++ example_packages/tree_shake/src/farewell_m.f90 | 3 +++ example_packages/tree_shake/src/greet_m.f90 | 2 ++ .../tree_shake/src/subdir/constants.f90 | 2 ++ 5 files changed, 30 insertions(+) create mode 100644 example_packages/tree_shake/src/extra_m.f90 diff --git a/example_packages/tree_shake/app/say_Hello.f90 b/example_packages/tree_shake/app/say_Hello.f90 index cf4a7421d3..f620dc2aa5 100644 --- a/example_packages/tree_shake/app/say_Hello.f90 +++ b/example_packages/tree_shake/app/say_Hello.f90 @@ -3,5 +3,13 @@ program say_Hello implicit none + interface + function external_function() result(i) + integer :: i + end function external_function + end interface + print *, make_greeting("World") + print *, external_function() + end program say_Hello diff --git a/example_packages/tree_shake/src/extra_m.f90 b/example_packages/tree_shake/src/extra_m.f90 new file mode 100644 index 0000000000..772fe6b789 --- /dev/null +++ b/example_packages/tree_shake/src/extra_m.f90 @@ -0,0 +1,15 @@ +! This module is not used by any other sources, +! however because it also contains an external function +! it cannot be dropped during tree-shaking/pruning +module extra_m + use subdir_constants, only: FAREWELL_STR + implicit none + private + + integer, parameter :: m = 0 +end + +function external_function() result(i) + integer :: i + i = 1 +end function external_function \ No newline at end of file diff --git a/example_packages/tree_shake/src/farewell_m.f90 b/example_packages/tree_shake/src/farewell_m.f90 index fbc45edf22..5a48ffffb9 100644 --- a/example_packages/tree_shake/src/farewell_m.f90 +++ b/example_packages/tree_shake/src/farewell_m.f90 @@ -1,3 +1,6 @@ +! This module is not used by any other sources +! and only contains a module (no non-module subprograms), +! therefore it should be dropped during tree-shaking/pruning module farewell_m use subdir_constants, only: FAREWELL_STR implicit none diff --git a/example_packages/tree_shake/src/greet_m.f90 b/example_packages/tree_shake/src/greet_m.f90 index 38afd08352..c2992e744e 100644 --- a/example_packages/tree_shake/src/greet_m.f90 +++ b/example_packages/tree_shake/src/greet_m.f90 @@ -1,3 +1,5 @@ +! This module is directly by the executables and +! hence should not be dropped during tree-shaking/pruning module greet_m use subdir_constants, only: GREET_STR implicit none diff --git a/example_packages/tree_shake/src/subdir/constants.f90 b/example_packages/tree_shake/src/subdir/constants.f90 index 59d6e5fee6..d34307bd00 100644 --- a/example_packages/tree_shake/src/subdir/constants.f90 +++ b/example_packages/tree_shake/src/subdir/constants.f90 @@ -1,3 +1,5 @@ +! This module is used indirectly by the executables +! and hence should not be dropped during tree-shaking/pruning module subdir_constants implicit none From 69a5673e3a20b0a9c0a257cf85b0b3e7c6abeeab Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sun, 13 Mar 2022 15:40:59 +0000 Subject: [PATCH 09/19] Update: tree-shaking to handle submodules correctly --- src/fpm_model.f90 | 9 +++++++++ src/fpm_source_parsing.f90 | 11 ++++++++--- src/fpm_targets.f90 | 34 ++++++++++++++++++++++++++++++++-- 3 files changed, 49 insertions(+), 5 deletions(-) diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index c13ac6b8f9..fc4b6796e7 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -95,6 +95,9 @@ module fpm_model !> Type of source unit integer :: unit_type = FPM_UNIT_UNKNOWN + !> Parent modules (submodules only) + type(string_t), allocatable :: parent_modules(:) + !> Modules USEd by this source file (lowerstring) type(string_t), allocatable :: modules_used(:) @@ -224,6 +227,12 @@ function info_srcfile(source) result(s) if (i < size(source%modules_provided)) s = s // ", " end do s = s // "]" + s = s // ", parent_modules=[" + do i = 1, size(source%parent_modules) + s = s // '"' // source%parent_modules(i)%s // '"' + if (i < size(source%parent_modules)) s = s // ", " + end do + s = s // "]" ! integer :: unit_type = FPM_UNIT_UNKNOWN s = s // ", unit_type=" select case(source%unit_type) diff --git a/src/fpm_source_parsing.f90 b/src/fpm_source_parsing.f90 index 40002077fd..c72e918ade 100644 --- a/src/fpm_source_parsing.f90 +++ b/src/fpm_source_parsing.f90 @@ -78,7 +78,7 @@ function parse_f_source(f_filename,error) result(f_source) logical :: inside_module integer :: stat - integer :: fh, n_use, n_include, n_mod, i, j, ic, pass + integer :: fh, n_use, n_include, n_mod, n_parent, i, j, ic, pass type(string_t), allocatable :: file_lines(:), file_lines_lower(:) character(:), allocatable :: temp_string, mod_name, string_parts(:) @@ -104,11 +104,13 @@ function parse_f_source(f_filename,error) result(f_source) n_use = 0 n_include = 0 n_mod = 0 + n_parent = 0 inside_module = .false. file_loop: do i=1,size(file_lines_lower) ! Skip comment lines - if (index(file_lines_lower(i)%s,'!') == 1) then + if (index(file_lines_lower(i)%s,'!') == 1 .or. & + len_trim(file_lines_lower(i)%s) < 1) then cycle end if @@ -296,6 +298,8 @@ function parse_f_source(f_filename,error) result(f_source) inside_module = .true. + n_parent = n_parent + 1 + if (pass == 2) then if (index(temp_string,':') > 0) then @@ -312,7 +316,7 @@ function parse_f_source(f_filename,error) result(f_source) end if f_source%modules_used(n_use)%s = temp_string - + f_source%parent_modules(n_parent)%s = temp_string f_source%modules_provided(n_mod)%s = mod_name end if @@ -379,6 +383,7 @@ function parse_f_source(f_filename,error) result(f_source) allocate(f_source%modules_used(n_use)) allocate(f_source%include_dependencies(n_include)) allocate(f_source%modules_provided(n_mod)) + allocate(f_source%parent_modules(n_parent)) end if end do diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index 7e6641ab36..ef33fa65b2 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -508,6 +508,22 @@ subroutine prune_build_targets(targets) end do + elseif (target%source%unit_type == FPM_UNIT_SUBMODULE) then + ! Remove submodules if their parents are not used + + exclude_target(i) = .true. + target%skip = .true. + do j=1,size(target%source%parent_modules) + + if (target%source%parent_modules(j)%s .in. modules_used) then + + exclude_target(i) = .false. + target%skip = .false. + + end if + + end do + end if end if @@ -543,7 +559,7 @@ subroutine prune_build_targets(targets) recursive subroutine collect_used_modules(target) type(build_target_t), intent(in) :: target - integer :: j + integer :: j, k if (allocated(target%source)) then do j=1,size(target%source%modules_used) @@ -552,14 +568,28 @@ recursive subroutine collect_used_modules(target) modules_used = [modules_used, target%source%modules_used(j)] + ! Recurse into child submodules + do k=1,size(targets) + if (allocated(targets(k)%ptr%source)) then + if (targets(k)%ptr%source%unit_type == FPM_UNIT_SUBMODULE) then + if (target%source%modules_used(j)%s .in. targets(k)%ptr%source%parent_modules) then + call collect_used_modules(targets(k)%ptr) + end if + end if + end if + end do + end if end do end if + ! Recurse into dependencies do j=1,size(target%dependencies) - call collect_used_modules(target%dependencies(j)%ptr) + if (target%dependencies(j)%ptr%target_type /= FPM_TARGET_ARCHIVE) then + call collect_used_modules(target%dependencies(j)%ptr) + end if end do From 5d044dfe60a111468828246e3bcd37904df6eb86 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sun, 13 Mar 2022 16:12:06 +0000 Subject: [PATCH 10/19] Add: test package for submodule tree-shaking --- ci/run_tests.sh | 10 ++++++++++ example_packages/README.md | 1 + example_packages/submodule_tree_shake/.gitignore | 1 + .../submodule_tree_shake/app/main.f90 | 9 +++++++++ example_packages/submodule_tree_shake/fpm.toml | 1 + .../submodule_tree_shake/src/child1.f90 | 16 ++++++++++++++++ .../submodule_tree_shake/src/child2.f90 | 10 ++++++++++ .../submodule_tree_shake/src/child_unused.f90 | 10 ++++++++++ .../submodule_tree_shake/src/grandchild.f90 | 10 ++++++++++ .../submodule_tree_shake/src/parent.f90 | 15 +++++++++++++++ .../submodule_tree_shake/src/parent_unused.f90 | 12 ++++++++++++ 11 files changed, 95 insertions(+) create mode 100644 example_packages/submodule_tree_shake/.gitignore create mode 100644 example_packages/submodule_tree_shake/app/main.f90 create mode 100644 example_packages/submodule_tree_shake/fpm.toml create mode 100644 example_packages/submodule_tree_shake/src/child1.f90 create mode 100644 example_packages/submodule_tree_shake/src/child2.f90 create mode 100644 example_packages/submodule_tree_shake/src/child_unused.f90 create mode 100644 example_packages/submodule_tree_shake/src/grandchild.f90 create mode 100644 example_packages/submodule_tree_shake/src/parent.f90 create mode 100644 example_packages/submodule_tree_shake/src/parent_unused.f90 diff --git a/ci/run_tests.sh b/ci/run_tests.sh index 109273e933..c315d55f06 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -70,6 +70,16 @@ test ! -e ./build/gfortran_*/tree_shake/src_farewell_m.f90.o test ! -e ./build/gfortran_*/tree_shake/src_farewell_m.f90.o.log popd +pushd submodule_tree_shake +"$fpm" run +test ! -e ./build/gfortran_*/submodule_tree_shake/src_parent_unused.f90.o +test ! -e ./build/gfortran_*/submodule_tree_shake/src_parent_unused.f90.o.log +test ! -e ./build/gfortran_*/submodule_tree_shake/src_child_unused.f90.o +test ! -e ./build/gfortran_*/submodule_tree_shake/src_child_unused.f90.o.log +test ! -e ./build/gfortran_*/submodule_tree_shake/src_grandchild.f90.o +test ! -e ./build/gfortran_*/submodule_tree_shake/src_grandchild.f90.o.log +popd + pushd version_file "$fpm" build "$fpm" run diff --git a/example_packages/README.md b/example_packages/README.md index a102269158..2cf9fa09b8 100644 --- a/example_packages/README.md +++ b/example_packages/README.md @@ -21,6 +21,7 @@ the features demonstrated in each package and which versions of fpm are supporte | program_with_module | App-only; module+program in single source file | Y | Y | | submodules | Lib-only; submodules (3 levels) | N | Y | | tree_shake | Test tree-shaking/pruning of unused module dependencies | N | Y | +| submodule_tree_shake| Test tree-shaking/pruning with submodules dependencies | N | Y | | link_external | Link external library | N | Y | | link_executable | Link external library to a single executable | N | Y | | version_file | Read version number from a file in the project root | N | Y | diff --git a/example_packages/submodule_tree_shake/.gitignore b/example_packages/submodule_tree_shake/.gitignore new file mode 100644 index 0000000000..a007feab07 --- /dev/null +++ b/example_packages/submodule_tree_shake/.gitignore @@ -0,0 +1 @@ +build/* diff --git a/example_packages/submodule_tree_shake/app/main.f90 b/example_packages/submodule_tree_shake/app/main.f90 new file mode 100644 index 0000000000..4bbd2f8c48 --- /dev/null +++ b/example_packages/submodule_tree_shake/app/main.f90 @@ -0,0 +1,9 @@ +program test +use parent + +integer :: a, b + +call my_sub1(a) +call my_sub2(b) + +end program test \ No newline at end of file diff --git a/example_packages/submodule_tree_shake/fpm.toml b/example_packages/submodule_tree_shake/fpm.toml new file mode 100644 index 0000000000..731b8f9cd2 --- /dev/null +++ b/example_packages/submodule_tree_shake/fpm.toml @@ -0,0 +1 @@ +name = "submodule_tree_shake" diff --git a/example_packages/submodule_tree_shake/src/child1.f90 b/example_packages/submodule_tree_shake/src/child1.f90 new file mode 100644 index 0000000000..dbd0fa5395 --- /dev/null +++ b/example_packages/submodule_tree_shake/src/child1.f90 @@ -0,0 +1,16 @@ +submodule(parent) child1 +implicit none + +interface + module function my_fun() result (b) + integer :: b + end function my_fun +end interface + +contains + +module procedure my_sub1 + a = 1 +end procedure my_sub1 + +end submodule child1 \ No newline at end of file diff --git a/example_packages/submodule_tree_shake/src/child2.f90 b/example_packages/submodule_tree_shake/src/child2.f90 new file mode 100644 index 0000000000..179cc3209a --- /dev/null +++ b/example_packages/submodule_tree_shake/src/child2.f90 @@ -0,0 +1,10 @@ +submodule(parent) child2 +implicit none + +contains + +module procedure my_sub2 + a = 2 +end procedure my_sub2 + +end submodule child2 \ No newline at end of file diff --git a/example_packages/submodule_tree_shake/src/child_unused.f90 b/example_packages/submodule_tree_shake/src/child_unused.f90 new file mode 100644 index 0000000000..2f5a45ff65 --- /dev/null +++ b/example_packages/submodule_tree_shake/src/child_unused.f90 @@ -0,0 +1,10 @@ +submodule(parent_unused) child_unused +implicit none + +contains + +module procedure unused_sub + a = 1 +end procedure unused_sub + +end submodule child_unused \ No newline at end of file diff --git a/example_packages/submodule_tree_shake/src/grandchild.f90 b/example_packages/submodule_tree_shake/src/grandchild.f90 new file mode 100644 index 0000000000..8c5aa17708 --- /dev/null +++ b/example_packages/submodule_tree_shake/src/grandchild.f90 @@ -0,0 +1,10 @@ +submodule(parent:child1) grandchild +implicit none + +contains + +module procedure my_fun + b = 2 +end procedure my_fun + +end submodule grandchild \ No newline at end of file diff --git a/example_packages/submodule_tree_shake/src/parent.f90 b/example_packages/submodule_tree_shake/src/parent.f90 new file mode 100644 index 0000000000..570827cd06 --- /dev/null +++ b/example_packages/submodule_tree_shake/src/parent.f90 @@ -0,0 +1,15 @@ +module parent +implicit none + +interface + + module subroutine my_sub1(a) + integer, intent(out) :: a + end subroutine my_sub1 + + module subroutine my_sub2(a) + integer, intent(out) :: a + end subroutine my_sub2 +end interface + +end module parent \ No newline at end of file diff --git a/example_packages/submodule_tree_shake/src/parent_unused.f90 b/example_packages/submodule_tree_shake/src/parent_unused.f90 new file mode 100644 index 0000000000..73ceb24c8f --- /dev/null +++ b/example_packages/submodule_tree_shake/src/parent_unused.f90 @@ -0,0 +1,12 @@ +module parent_unused +implicit none + +interface + + module subroutine unused_sub(a) + integer, intent(out) :: a + end subroutine unused_sub + +end interface + +end module parent_unused \ No newline at end of file From 142d25910758092e549935c1cfefc9ad0eb6d373 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sat, 19 Mar 2022 12:51:39 +0000 Subject: [PATCH 11/19] Add: --no-prune argument to disable tree-shaking/pruning of dependencies --- src/fpm.f90 | 4 +-- src/fpm/cmd/install.f90 | 2 +- src/fpm_command_line.f90 | 54 +++++++++++++++++++--------------------- src/fpm_targets.f90 | 9 +++++-- 4 files changed, 35 insertions(+), 34 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 7291247993..14522fe6e6 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -275,7 +275,7 @@ subroutine cmd_build(settings) call fpm_stop(1,'*cmd_build*:model error:'//error%message) end if -call targets_from_sources(targets, model, error) +call targets_from_sources(targets, model, settings%prune, error) if (allocated(error)) then call fpm_stop(1,'*cmd_build*:target error:'//error%message) end if @@ -321,7 +321,7 @@ subroutine cmd_run(settings,test) call fpm_stop(1, '*cmd_run*:model error:'//error%message) end if - call targets_from_sources(targets, model, error) + call targets_from_sources(targets, model, settings%prune, error) if (allocated(error)) then call fpm_stop(1, '*cmd_run*:targets error:'//error%message) end if diff --git a/src/fpm/cmd/install.f90 b/src/fpm/cmd/install.f90 index 46f24a7ae3..f81b4dfc44 100644 --- a/src/fpm/cmd/install.f90 +++ b/src/fpm/cmd/install.f90 @@ -38,7 +38,7 @@ subroutine cmd_install(settings) call build_model(model, settings%fpm_build_settings, package, error) call handle_error(error) - call targets_from_sources(targets, model, error) + call targets_from_sources(targets, model, settings%prune, error) call handle_error(error) installable = (allocated(package%library) .and. package%install%library) & diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 836c1a9d4a..b449657794 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -70,6 +70,7 @@ module fpm_command_line logical :: list=.false. logical :: show_model=.false. logical :: build_tests=.false. + logical :: prune=.true. character(len=:),allocatable :: compiler character(len=:),allocatable :: c_compiler character(len=:),allocatable :: archiver @@ -122,6 +123,15 @@ module fpm_command_line val_profile ! '12345678901234567890123456789012345678901234567890123456789012345678901234567890',& +character(len=80), parameter :: help_text_build_common(*) = [character(len=80) :: & + ' --profile PROF Selects the compilation profile for the build. ',& + ' Currently available profiles are "release" for ',& + ' 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 '& + ] +! '12345678901234567890123456789012345678901234567890123456789012345678901234567890',& character(len=80), parameter :: help_text_compiler(*) = [character(len=80) :: & ' --compiler NAME Specify a compiler name. The default is "gfortran" ',& ' unless set by the environment variable FPM_FC. ',& @@ -219,6 +229,7 @@ subroutine get_command_line_settings(cmd_settings) compiler_args = & ' --profile " "' // & + ' --no-prune F' // & ' --compiler "'//get_fpm_env(fc_env, fc_default)//'"' // & ' --c-compiler "'//get_fpm_env(cc_env, cc_default)//'"' // & ' --archiver "'//get_fpm_env(ar_env, ar_default)//'"' // & @@ -269,6 +280,7 @@ subroutine get_command_line_settings(cmd_settings) cmd_settings=fpm_run_settings(& & args=remaining,& & profile=val_profile,& + & prune=.not.lget('no-prune'), & & compiler=val_compiler, & & c_compiler=c_compiler, & & archiver=archiver, & @@ -296,6 +308,7 @@ subroutine get_command_line_settings(cmd_settings) allocate( fpm_build_settings :: cmd_settings ) cmd_settings=fpm_build_settings( & & profile=val_profile,& + & prune=.not.lget('no-prune'), & & compiler=val_compiler, & & c_compiler=c_compiler, & & archiver=archiver, & @@ -447,6 +460,7 @@ subroutine get_command_line_settings(cmd_settings) install_settings = fpm_install_settings(& list=lget('list'), & profile=val_profile,& + prune=.not.lget('no-prune'), & compiler=val_compiler, & c_compiler=c_compiler, & archiver=archiver, & @@ -500,6 +514,7 @@ subroutine get_command_line_settings(cmd_settings) cmd_settings=fpm_test_settings(& & args=remaining, & & profile=val_profile, & + & prune=.not.lget('no-prune'), & & compiler=val_compiler, & & c_compiler=c_compiler, & & archiver=archiver, & @@ -614,7 +629,7 @@ subroutine set_help() help_list_dash = [character(len=80) :: & ' ', & ' build [--compiler COMPILER_NAME] [--profile PROF] [--flag FFLAGS] [--list] ', & - ' [--tests] ', & + ' [--tests] [--no-prune] ', & ' help [NAME(s)] ', & ' new NAME [[--lib|--src] [--app] [--test] [--example]]| ', & ' [--full|--bare][--backfill] ', & @@ -732,14 +747,15 @@ subroutine set_help() ' Their syntax is ', & ' ', & ' build [--profile PROF] [--flag FFLAGS] [--list] [--compiler COMPILER_NAME] ', & - ' [--tests] ', & + ' [--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] [-- ARGS] ', & + ' [--example] [--runner "CMD"] [--compiler COMPILER_NAME] ', & + ' [--no-prune] [-- ARGS] ', & ' test [[--target] NAME(s)] [--profile PROF] [--flag FFLAGS] [--list] ', & - ' [--runner "CMD"] [--compiler COMPILER_NAME] [-- ARGS] ', & + ' [--runner "CMD"] [--compiler COMPILER_NAME] [--no-prune] [-- ARGS] ', & ' help [NAME(s)] ', & ' list [--list] ', & ' install [--profile PROF] [--flag FFLAGS] [--no-rebuild] [--prefix PATH] ', & @@ -748,11 +764,7 @@ subroutine set_help() 'SUBCOMMAND OPTIONS ', & ' -C, --directory PATH', & ' Change working directory to PATH before running any command', & - ' --profile PROF selects the compilation profile for the build.',& - ' Currently available profiles are "release" for',& - ' high optimization and "debug" for full debug options.',& - ' If --flag is not specified the "debug" flags are the',& - ' default. ',& + help_text_build_common, & help_text_compiler, & help_text_flag, & ' --list List candidates instead of building or running them. On ', & @@ -870,11 +882,7 @@ subroutine set_help() ' the special characters from shell expansion. ', & ' --all Run all examples or applications. An alias for --target ''*''. ', & ' --example Run example programs instead of applications. ', & - ' --profile PROF selects the compilation profile for the build.',& - ' Currently available profiles are "release" for',& - ' high optimization and "debug" for full debug options.',& - ' If --flag is not specified the "debug" flags are the',& - ' default. ',& + help_text_build_common, & help_text_compiler, & help_text_flag, & ' --runner CMD A command to prefix the program execution paths with. ', & @@ -941,11 +949,7 @@ subroutine set_help() ' specified in the "fpm.toml" file. ', & ' ', & 'OPTIONS ', & - ' --profile PROF selects the compilation profile for the build.',& - ' Currently available profiles are "release" for',& - ' high optimization and "debug" for full debug options.',& - ' If --flag is not specified the "debug" flags are the',& - ' default. ',& + help_text_build_common,& help_text_compiler, & help_text_flag, & ' --list list candidates instead of building or running them ', & @@ -1118,11 +1122,7 @@ subroutine set_help() ' any single character and "*" represents any string. ', & ' Note The glob string normally needs quoted to ', & ' protect the special characters from shell expansion.', & - ' --profile PROF selects the compilation profile for the build.',& - ' Currently available profiles are "release" for',& - ' high optimization and "debug" for full debug options.',& - ' If --flag is not specified the "debug" flags are the',& - ' default. ',& + help_text_build_common,& help_text_compiler, & help_text_flag, & ' --runner CMD A command to prefix the program execution paths with. ', & @@ -1187,11 +1187,7 @@ subroutine set_help() 'OPTIONS', & ' --list list all installable targets for this project,', & ' but do not install any of them', & - ' --profile PROF selects the compilation profile for the build.',& - ' Currently available profiles are "release" for',& - ' high optimization and "debug" for full debug options.',& - ' If --flag is not specified the "debug" flags are the',& - ' default. ',& + help_text_build_common,& help_text_flag, & ' --no-rebuild do not rebuild project before installation', & ' --prefix DIR path to installation directory (requires write access),', & diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index ef33fa65b2..d1621e06e6 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -120,7 +120,7 @@ module fpm_targets contains !> High-level wrapper to generate build target information -subroutine targets_from_sources(targets,model,error) +subroutine targets_from_sources(targets,model,prune,error) !> The generated list of build targets type(build_target_ptr), intent(out), allocatable :: targets(:) @@ -128,6 +128,9 @@ subroutine targets_from_sources(targets,model,error) !> The package model from which to construct the target list type(fpm_model_t), intent(inout), target :: model + !> Enable tree-shaking/pruning of module dependencies + logical, intent(in) :: prune + !> Error structure type(error_t), intent(out), allocatable :: error @@ -136,7 +139,9 @@ subroutine targets_from_sources(targets,model,error) call resolve_module_dependencies(targets,model%external_modules,error) if (allocated(error)) return - call prune_build_targets(targets) + if (prune) then + call prune_build_targets(targets) + end if call resolve_target_linking(targets,model) From e51579640327b32efef43319dbe0bf88a2f66d7d Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sat, 19 Mar 2022 12:58:01 +0000 Subject: [PATCH 12/19] Update: unit tests with new prune flag. --- test/fpm_test/test_module_dependencies.f90 | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/test/fpm_test/test_module_dependencies.f90 b/test/fpm_test/test_module_dependencies.f90 index af26fc7528..f17b651254 100644 --- a/test/fpm_test/test_module_dependencies.f90 +++ b/test/fpm_test/test_module_dependencies.f90 @@ -81,7 +81,7 @@ subroutine test_library_module_use(error) provides=[string_t('my_mod_2')], & uses=[string_t('my_mod_1')]) - call targets_from_sources(targets,model,error) + call targets_from_sources(targets,model,.false.,error) if (allocated(error)) return if (allocated(error)) then @@ -151,7 +151,7 @@ subroutine test_scope(exe_scope,error) scope=exe_scope, & uses=[string_t('my_mod_1')]) - call targets_from_sources(targets,model,error) + call targets_from_sources(targets,model,.false.,error) if (allocated(error)) return if (size(targets) /= 4) then @@ -204,7 +204,7 @@ subroutine test_program_with_module(error) provides=[string_t('app_mod')], & uses=[string_t('app_mod')]) - call targets_from_sources(targets,model,error) + call targets_from_sources(targets,model,.false.,error) if (allocated(error)) return if (size(targets) /= 2) then @@ -266,7 +266,7 @@ subroutine test_scope(exe_scope,error) scope=exe_scope, & uses=[string_t('app_mod2')]) - call targets_from_sources(targets,model,error) + call targets_from_sources(targets,model,.false.,error) if (allocated(error)) return if (size(targets) /= 4) then @@ -320,7 +320,7 @@ subroutine test_missing_library_use(error) provides=[string_t('my_mod_2')], & uses=[string_t('my_mod_3')]) - call targets_from_sources(targets,model,error) + call targets_from_sources(targets,model,.false.,error) end subroutine test_missing_library_use @@ -346,7 +346,7 @@ subroutine test_missing_program_use(error) scope=FPM_SCOPE_APP, & uses=[string_t('my_mod_2')]) - call targets_from_sources(targets,model,error) + call targets_from_sources(targets,model,.false.,error) end subroutine test_missing_program_use @@ -373,7 +373,7 @@ subroutine test_invalid_library_use(error) provides=[string_t('my_mod')], & uses=[string_t('app_mod')]) - call targets_from_sources(targets,model,error) + call targets_from_sources(targets,model,.false.,error) end subroutine test_invalid_library_use @@ -399,7 +399,7 @@ subroutine test_subdirectory_module_use(error) scope=FPM_SCOPE_APP, & uses=[string_t('app_mod')]) - call targets_from_sources(targets,model,error) + call targets_from_sources(targets,model,.false.,error) end subroutine test_subdirectory_module_use @@ -530,7 +530,7 @@ subroutine test_tree_shake_module(error) scope=FPM_SCOPE_APP, & uses=[string_t('my_mod_2')]) - call targets_from_sources(targets,model,error) + call targets_from_sources(targets,model,prune=.true.,error=error) if (allocated(error)) return if (size(targets) /= 5) then @@ -589,7 +589,7 @@ subroutine test_invalid_subdirectory_module_use(error) scope=FPM_SCOPE_APP, & uses=[string_t('app_mod')]) - call targets_from_sources(targets,model,error) + call targets_from_sources(targets,model,.false.,error) end subroutine test_invalid_subdirectory_module_use From 28dcdc4f0edaab4df587fc86a79691757843d452 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sat, 19 Mar 2022 13:42:51 +0000 Subject: [PATCH 13/19] Update: to allow pruning based on root package modules when there are no top-level executables to prune from. --- src/fpm_targets.f90 | 51 +++++++++++++++++++++++++++------- test/fpm_test/test_backend.f90 | 8 +++--- 2 files changed, 45 insertions(+), 14 deletions(-) diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index d1621e06e6..2abe2ef50c 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -78,6 +78,9 @@ module fpm_targets !> File path of build log file relative to cwd character(:), allocatable :: output_log_file + !> Name of parent package + character(:), allocatable :: package_name + !> Primary source for this build target type(srcfile_t), allocatable :: source @@ -140,7 +143,7 @@ subroutine targets_from_sources(targets,model,prune,error) if (allocated(error)) return if (prune) then - call prune_build_targets(targets) + call prune_build_targets(targets,root_package=model%package_name) end if call resolve_target_linking(targets,model) @@ -198,7 +201,7 @@ subroutine build_target_list(targets,model) i=1,size(model%packages(j)%sources)), & j=1,size(model%packages))]) - if (with_lib) call add_target(targets,type = FPM_TARGET_ARCHIVE,& + if (with_lib) call add_target(targets,package=model%package_name,type = FPM_TARGET_ARCHIVE,& output_name = join_path(& model%package_name,'lib'//model%package_name//'.a')) @@ -215,7 +218,7 @@ subroutine build_target_list(targets,model) select case (sources(i)%unit_type) case (FPM_UNIT_MODULE,FPM_UNIT_SUBMODULE,FPM_UNIT_SUBPROGRAM,FPM_UNIT_CSOURCE) - call add_target(targets,source = sources(i), & + call add_target(targets,package=model%packages(j)%name,source = sources(i), & type = merge(FPM_TARGET_C_OBJECT,FPM_TARGET_OBJECT,& sources(i)%unit_type==FPM_UNIT_CSOURCE), & output_name = get_object_name(sources(i))) @@ -227,7 +230,7 @@ subroutine build_target_list(targets,model) case (FPM_UNIT_PROGRAM) - call add_target(targets,type = FPM_TARGET_OBJECT,& + call add_target(targets,package=model%packages(j)%name,type = FPM_TARGET_OBJECT,& output_name = get_object_name(sources(i)), & source = sources(i) & ) @@ -246,7 +249,7 @@ subroutine build_target_list(targets,model) end if - call add_target(targets,type = FPM_TARGET_EXECUTABLE,& + call add_target(targets,package=model%packages(j)%name,type = FPM_TARGET_EXECUTABLE,& link_libraries = sources(i)%link_libraries, & output_name = join_path(exe_dir, & sources(i)%exe_name//xsuffix)) @@ -296,8 +299,9 @@ end subroutine build_target_list !> Allocate a new target and append to target list -subroutine add_target(targets,type,output_name,source,link_libraries) +subroutine add_target(targets,package,type,output_name,source,link_libraries) type(build_target_ptr), allocatable, intent(inout) :: targets(:) + character(*), intent(in) :: package integer, intent(in) :: type character(*), intent(in) :: output_name type(srcfile_t), intent(in), optional :: source @@ -325,6 +329,7 @@ subroutine add_target(targets,type,output_name,source,link_libraries) allocate(new_target) new_target%target_type = type new_target%output_name = output_name + new_target%package_name = package if (present(source)) new_target%source = source if (present(link_libraries)) new_target%link_libraries = link_libraries allocate(new_target%dependencies(0)) @@ -461,14 +466,23 @@ end function find_module_dependency !> Perform tree-shaking to remove unused module targets -subroutine prune_build_targets(targets) +subroutine prune_build_targets(targets, root_package) + + !> Build target list to prune type(build_target_ptr), intent(inout), allocatable :: targets(:) + !> Name of root package + character(*), intent(in) :: root_package + integer :: i, j, nexec type(string_t), allocatable :: modules_used(:) logical :: exclude_target(size(targets)) logical, allocatable :: exclude_from_archive(:) + if (size(targets) < 1) then + return + end if + nexec = 0 allocate(modules_used(0)) @@ -484,10 +498,21 @@ subroutine prune_build_targets(targets) end do - ! Can't prune targets without executables - ! (everything will be built) + ! If there aren't any executables, then prune + ! based on modules used in root package if (nexec < 1) then - return + + do i=1,size(targets) + + if (targets(i)%ptr%package_name == root_package .and. & + targets(i)%ptr%target_type /= FPM_TARGET_ARCHIVE) then + + call collect_used_modules(targets(i)%ptr) + + end if + + end do + end if exclude_target(:) = .false. @@ -532,6 +557,12 @@ subroutine prune_build_targets(targets) end if end if + ! (If there aren't any executables then we only prune modules from dependencies) + if (nexec < 1 .and. target%package_name == root_package) then + exclude_target(i) = .false. + target%skip = .false. + end if + end associate end do diff --git a/test/fpm_test/test_backend.f90 b/test/fpm_test/test_backend.f90 index cb8d6c8b52..402e8b4d0b 100644 --- a/test/fpm_test/test_backend.f90 +++ b/test/fpm_test/test_backend.f90 @@ -330,13 +330,13 @@ function new_test_package() result(targets) type(build_target_ptr), allocatable :: targets(:) integer :: i - call add_target(targets,FPM_TARGET_ARCHIVE,get_temp_filename()) + call add_target(targets,'test-package',FPM_TARGET_ARCHIVE,get_temp_filename()) - call add_target(targets,FPM_TARGET_OBJECT,get_temp_filename()) + call add_target(targets,'test-package',FPM_TARGET_OBJECT,get_temp_filename()) - call add_target(targets,FPM_TARGET_OBJECT,get_temp_filename()) + call add_target(targets,'test-package',FPM_TARGET_OBJECT,get_temp_filename()) - call add_target(targets,FPM_TARGET_OBJECT,get_temp_filename()) + call add_target(targets,'test-package',FPM_TARGET_OBJECT,get_temp_filename()) ! Library depends on all objects call add_dependency(targets(1)%ptr,targets(2)%ptr) From b0c855d473bd7bc0f2c26322c3417efc279b14ab Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Mon, 9 May 2022 11:19:49 +0100 Subject: [PATCH 14/19] Update: enumeration of used modules for efficiency Add redundancy check to recursive exploration of used modules to avoid redundant re-processing and consequent poor-scaling for large projects. --- src/fpm_targets.f90 | 25 ++++++++++++++++++++++++- 1 file changed, 24 insertions(+), 1 deletion(-) diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index 2abe2ef50c..2e36975115 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -515,6 +515,8 @@ subroutine prune_build_targets(targets, root_package) end if + call reset_target_flags(targets) + exclude_target(:) = .false. ! Exclude purely module targets if they are not used anywhere @@ -592,11 +594,18 @@ subroutine prune_build_targets(targets, root_package) contains + !> Recursively collect which modules are actually used recursive subroutine collect_used_modules(target) - type(build_target_t), intent(in) :: target + type(build_target_t), intent(inout) :: target integer :: j, k + if (target%touched) then + return + else + target%touched = .true. + end if + if (allocated(target%source)) then do j=1,size(target%source%modules_used) @@ -631,6 +640,20 @@ recursive subroutine collect_used_modules(target) end subroutine collect_used_modules + !> Reset target flags after recursive search + subroutine reset_target_flags(targets) + type(build_target_ptr), intent(inout) :: targets(:) + + integer :: i + + do i=1,size(targets) + + targets(i)%ptr%touched = .false. + + end do + + end subroutine reset_target_flags + end subroutine prune_build_targets From e08b64a8440669af16de3884fe128c235db77d22 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Mon, 9 May 2022 11:26:21 +0100 Subject: [PATCH 15/19] Fix: issue with pruning of non-module dependencies Make sure to always enumerate used modules from non-module sources because these can't be pruned. Adds unit test for this case. --- src/fpm_targets.f90 | 10 ++- test/fpm_test/test_module_dependencies.f90 | 75 +++++++++++++++++++++- 2 files changed, 82 insertions(+), 3 deletions(-) diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index 2e36975115..d5a645b06d 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -486,7 +486,7 @@ subroutine prune_build_targets(targets, root_package) nexec = 0 allocate(modules_used(0)) - ! Enumerate modules used by executables and their dependencies + ! Enumerate modules used by executables, non-module subprograms and their dependencies do i=1,size(targets) if (targets(i)%ptr%target_type == FPM_TARGET_EXECUTABLE) then @@ -494,6 +494,14 @@ subroutine prune_build_targets(targets, root_package) nexec = nexec + 1 call collect_used_modules(targets(i)%ptr) + elseif (allocated(targets(i)%ptr%source)) then + + if (targets(i)%ptr%source%unit_type == FPM_UNIT_SUBPROGRAM) then + + call collect_used_modules(targets(i)%ptr) + + end if + end if end do diff --git a/test/fpm_test/test_module_dependencies.f90 b/test/fpm_test/test_module_dependencies.f90 index f17b651254..805cc25590 100644 --- a/test/fpm_test/test_module_dependencies.f90 +++ b/test/fpm_test/test_module_dependencies.f90 @@ -53,7 +53,9 @@ subroutine collect_module_dependencies(testsuite) & new_unittest("invalid-subdirectory-module-use", & test_invalid_subdirectory_module_use, should_fail=.true.), & & new_unittest("tree-shake-module", & - test_tree_shake_module, should_fail=.false.) & + test_tree_shake_module, should_fail=.false.), & + & new_unittest("tree-shake-subprogram-with-module", & + test_tree_shake_subprogram_with_module, should_fail=.false.) & ] end subroutine collect_module_dependencies @@ -534,7 +536,7 @@ subroutine test_tree_shake_module(error) if (allocated(error)) return if (size(targets) /= 5) then - call test_failed(error,scope_str//'Incorrect number of targets - expecting three') + call test_failed(error,scope_str//'Incorrect number of targets - expecting five') return end if @@ -568,6 +570,75 @@ subroutine test_tree_shake_module(error) end subroutine test_tree_shake_module + !> Check tree-shaking of modules used via a subprogram source + !> (Subprogram type is a source containing any non-module subroutines/functions) + !> Subprograms cannot be pruned, so neither can their dependencies + subroutine test_tree_shake_subprogram_with_module(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(fpm_model_t) :: model + type(build_target_ptr), allocatable :: targets(:) + character(:), allocatable :: scope_str + + allocate(model%external_modules(0)) + allocate(model%packages(1)) + allocate(model%packages(1)%sources(4)) + + model%packages(1)%sources(1) = new_test_source(FPM_UNIT_MODULE,file_name="src/my_mod_1.f90", & + scope = FPM_SCOPE_LIB, & + provides=[string_t('my_mod_1')]) ! used via subprogram + + model%packages(1)%sources(2) = new_test_source(FPM_UNIT_SUBPROGRAM,file_name="src/my_subprogram.f90", & + scope = FPM_SCOPE_LIB, & + uses=[string_t('my_mod_1')]) ! subprogram (never pruned) + + model%packages(1)%sources(3) = new_test_source(FPM_UNIT_MODULE,file_name="src/my_mod_3.f90", & + scope = FPM_SCOPE_LIB, & + provides=[string_t('my_mod_3')]) ! unused module + + model%packages(1)%sources(4) = new_test_source(FPM_UNIT_PROGRAM,file_name="app/my_program.f90", & + scope=FPM_SCOPE_APP) + + call targets_from_sources(targets,model,prune=.true.,error=error) + if (allocated(error)) return + + if (size(targets) /= 5) then + call test_failed(error,scope_str//'Incorrect number of targets - expecting five') + return + end if + + call check_target(targets(1)%ptr,type=FPM_TARGET_ARCHIVE,n_depends=2, & + deps=[targets(2)], & + links=[targets(2),targets(3)],error=error) + + if (allocated(error)) return + + call check_target(targets(2)%ptr,type=FPM_TARGET_OBJECT,n_depends=0, & + source=model%packages(1)%sources(1),error=error) + + if (allocated(error)) return + + call check_target(targets(3)%ptr,type=FPM_TARGET_OBJECT,n_depends=1, & + deps=[targets(2)],source=model%packages(1)%sources(2),error=error) + + if (allocated(error)) return + + call check_target(targets(4)%ptr,type=FPM_TARGET_OBJECT,n_depends=0, & + source=model%packages(1)%sources(4),error=error) + + if (allocated(error)) return + + call check_target(targets(5)%ptr,type=FPM_TARGET_EXECUTABLE,n_depends=2, & + deps=[targets(1),targets(4)], & + links=[targets(4)], error=error) + + if (allocated(error)) return + + end subroutine test_tree_shake_subprogram_with_module + + !> Check program using a non-library module in a differente sub-directory subroutine test_invalid_subdirectory_module_use(error) From cfb0a51291b8eace45f8bb568cc59b27fe66d9cf Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Mon, 9 May 2022 11:29:31 +0100 Subject: [PATCH 16/19] Update: source parsing to skip pre-processor lines Avoids misidentifying pure module sources as non-module (subprogram) sources due to presence of code outside of modules. --- src/fpm_source_parsing.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/fpm_source_parsing.f90 b/src/fpm_source_parsing.f90 index 707e1ef48e..ab227c2df4 100644 --- a/src/fpm_source_parsing.f90 +++ b/src/fpm_source_parsing.f90 @@ -113,8 +113,9 @@ function parse_f_source(f_filename,error) result(f_source) inside_module = .false. file_loop: do i=1,size(file_lines_lower) - ! Skip comment lines + ! Skip comment lines and preprocessor directives if (index(file_lines_lower(i)%s,'!') == 1 .or. & + index(file_lines_lower(i)%s,'#') == 1 .or. & len_trim(file_lines_lower(i)%s) < 1) then cycle end if From 722a32594da1182e4cdc4e046240e9746cc7c6cf Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Mon, 9 May 2022 11:45:56 +0100 Subject: [PATCH 17/19] Update: source parsing test with preprocessor line --- test/fpm_test/test_source_parsing.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/test/fpm_test/test_source_parsing.f90 b/test/fpm_test/test_source_parsing.f90 index 3a668f43cf..cf2c248b1d 100644 --- a/test/fpm_test/test_source_parsing.f90 +++ b/test/fpm_test/test_source_parsing.f90 @@ -311,6 +311,7 @@ subroutine test_module(error) open(file=temp_file, newunit=unit) write(unit, '(a)') & + & '#define preprocesor_line_outside', & & 'module my_mod ! A trailing comment', & & 'use module_one', & & 'interface', & From 895f774d31ae5145c6580360d06dfd9085456a27 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sun, 29 May 2022 11:11:06 +0100 Subject: [PATCH 18/19] Update: to detect exported C API in modules via bind(C) Sources containing module subroutines and functions with bind(C) are labelled as SUBPROGRAM to disable pruning. --- src/fpm_source_parsing.f90 | 54 +++++++++++++++++++++++++- test/fpm_test/test_source_parsing.f90 | 55 ++++++++++++++++++++++++++- 2 files changed, 107 insertions(+), 2 deletions(-) diff --git a/src/fpm_source_parsing.f90 b/src/fpm_source_parsing.f90 index ab227c2df4..17e53e81d3 100644 --- a/src/fpm_source_parsing.f90 +++ b/src/fpm_source_parsing.f90 @@ -76,7 +76,7 @@ function parse_f_source(f_filename,error) result(f_source) type(srcfile_t) :: f_source type(error_t), allocatable, intent(out) :: error - logical :: inside_module + logical :: inside_module, inside_interface integer :: stat integer :: fh, n_use, n_include, n_mod, n_parent, i, j, ic, pass type(string_t), allocatable :: file_lines(:), file_lines_lower(:) @@ -111,6 +111,7 @@ function parse_f_source(f_filename,error) result(f_source) n_mod = 0 n_parent = 0 inside_module = .false. + inside_interface = .false. file_loop: do i=1,size(file_lines_lower) ! Skip comment lines and preprocessor directives @@ -120,6 +121,36 @@ function parse_f_source(f_filename,error) result(f_source) cycle end if + ! Detect exported C-API via bind(C) + if (.not.inside_interface .and. & + index(file_lines_lower(i)%s,'bind(c') > 0) then + + do j=i,1,-1 + + if (index(file_lines_lower(j)%s,'function') > 0 .or. & + index(file_lines_lower(j)%s,'subroutine') > 0) then + f_source%unit_type = FPM_UNIT_SUBPROGRAM + exit + end if + + if (j>1) then + + ic = index(file_lines_lower(j-1)%s,'!') + if (ic < 1) then + ic = len(file_lines_lower(j-1)%s) + end if + + temp_string = trim(file_lines_lower(j-1)%s(1:ic)) + if (index(temp_string,'&') /= len(temp_string)) then + exit + end if + + end if + + end do + + end if + ! Skip lines that are continued: not statements if (i > 1) then ic = index(file_lines_lower(i-1)%s,'!') @@ -132,6 +163,27 @@ function parse_f_source(f_filename,error) result(f_source) end if end if + ! Detect beginning of interface block + if (index(file_lines_lower(i)%s,'interface') == 1) then + + inside_interface = .true. + cycle + + end if + + ! Detect end of interface block + if (index(file_lines_lower(i)%s,'end') == 1 .and. & + len(file_lines_lower(i)%s) > 3) then + + if (index(adjustl(file_lines_lower(i)%s(4:)),'interface') == 1) then + + inside_interface = .false. + cycle + + end if + + end if + ! Process 'USE' statements if (index(file_lines_lower(i)%s,'use ') == 1 .or. & index(file_lines_lower(i)%s,'use::') == 1) then diff --git a/test/fpm_test/test_source_parsing.f90 b/test/fpm_test/test_source_parsing.f90 index cf2c248b1d..0f40c2ffdd 100644 --- a/test/fpm_test/test_source_parsing.f90 +++ b/test/fpm_test/test_source_parsing.f90 @@ -27,6 +27,7 @@ subroutine collect_source_parsing(testsuite) & new_unittest("program", test_program), & & new_unittest("module", test_module), & & new_unittest("module-with-subprogram", test_module_with_subprogram), & + & new_unittest("module-with-c-api", test_module_with_c_api), & & new_unittest("module-end-stmt", test_module_end_stmt), & & new_unittest("program-with-module", test_program_with_module), & & new_unittest("submodule", test_submodule), & @@ -315,7 +316,7 @@ subroutine test_module(error) & 'module my_mod ! A trailing comment', & & 'use module_one', & & 'interface', & - & ' module subroutine f()', & + & ' module subroutine f() bind(C)', & & 'end interface', & & 'integer :: program', & & 'program = 1', & @@ -325,6 +326,10 @@ subroutine test_module(error) & 'contains', & & 'module subroutine&', & & ' e()', & + & ' integer, parameter :: c = 1', & + & ' integer :: & ', & + & ' bind(c)', & + & ' bind(c) = 1', & & 'end subroutine e', & & 'module subroutine f()', & & 'end subroutine f', & @@ -489,6 +494,54 @@ subroutine test_module_end_stmt(error) end subroutine test_module_end_stmt + !> Try to parse fortran module with exported C-API via bind(c) + !> (this should be detected as FPM_UNIT_SUBPROGRAM not FPM_UNIT_MODULE to prevent pruning) + subroutine test_module_with_c_api(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: unit + character(:), allocatable :: temp_file + type(srcfile_t), allocatable :: f_source + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'module my_mod', & + & 'contains', & + & 'subroutine f() &', & + & ' bind(C)', & + & 'end subroutine f', & + & 'module function g()', & + & 'end function g', & + & 'end module test' + close(unit) + + f_source = parse_f_source(temp_file,error) + if (allocated(error)) then + return + end if + + if (f_source%unit_type /= FPM_UNIT_SUBPROGRAM) then + call test_failed(error,'Wrong unit type detected - expecting FPM_UNIT_SUBPROGRAM') + return + end if + + if (size(f_source%modules_provided) /= 1) then + call test_failed(error,'Unexpected modules_provided - expecting one') + return + end if + + if (size(f_source%modules_used) /= 0) then + call test_failed(error,'Incorrect number of modules_used - expecting zero') + return + end if + + end subroutine test_module_with_c_api + + !> Try to parse combined fortran module and program !> Check that parsed unit type is FPM_UNIT_PROGRAM subroutine test_program_with_module(error) From 13f9c85e4a11683c478d48b1a81438b7cb675804 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sun, 29 May 2022 14:19:46 +0100 Subject: [PATCH 19/19] Update: parsing with parse_sequence helper fcn Adds a parse_sequence helper utility to parse sequences of tokens separated by zero or more spaces --- src/fpm_source_parsing.f90 | 124 ++++++++++++++++++++++++++++++------- 1 file changed, 103 insertions(+), 21 deletions(-) diff --git a/src/fpm_source_parsing.f90 b/src/fpm_source_parsing.f90 index 17e53e81d3..7f807b9207 100644 --- a/src/fpm_source_parsing.f90 +++ b/src/fpm_source_parsing.f90 @@ -123,7 +123,7 @@ function parse_f_source(f_filename,error) result(f_source) ! Detect exported C-API via bind(C) if (.not.inside_interface .and. & - index(file_lines_lower(i)%s,'bind(c') > 0) then + parse_subsequence(file_lines_lower(i)%s,'bind','(','c')) then do j=i,1,-1 @@ -172,15 +172,10 @@ function parse_f_source(f_filename,error) result(f_source) end if ! Detect end of interface block - if (index(file_lines_lower(i)%s,'end') == 1 .and. & - len(file_lines_lower(i)%s) > 3) then + if (parse_sequence(file_lines_lower(i)%s,'end','interface')) then - if (index(adjustl(file_lines_lower(i)%s(4:)),'interface') == 1) then - - inside_interface = .false. - cycle - - end if + inside_interface = .false. + cycle end if @@ -407,18 +402,11 @@ function parse_f_source(f_filename,error) result(f_source) ! Parse end module statement ! (to check for code outside of modules) - if (index(file_lines_lower(i)%s,'end') == 1) then - - temp_string = split_n(file_lines_lower(i)%s,n=2,delims=' ',stat=stat) - - if (stat == 0) then - if (temp_string == 'module' .or. temp_string == 'submodule') then - - inside_module = .false. - cycle - - end if - end if + if (parse_sequence(file_lines_lower(i)%s,'end','module') .or. & + parse_sequence(file_lines_lower(i)%s,'end','submodule')) then + + inside_module = .false. + cycle end if @@ -567,4 +555,98 @@ function split_n(string,delims,n,stat) result(substring) end function split_n + +!> Parse a subsequence of blank-separated tokens within a string +!> (see parse_sequence) +function parse_subsequence(string,t1,t2,t3,t4) result(found) + character(*), intent(in) :: string + character(*), intent(in) :: t1 + character(*), intent(in), optional :: t2, t3, t4 + logical :: found + + integer :: offset, i + + found = .false. + offset = 1 + + do + + i = index(string(offset:),t1) + + if (i == 0) return + + offset = offset + i - 1 + + found = parse_sequence(string(offset:),t1,t2,t3,t4) + + if (found) return + + offset = offset + len(t1) + + if (offset > len(string)) return + + end do + +end function parse_subsequence + +!> Helper utility to parse sequences of tokens +!> that may be optionally separated by zero or more spaces +function parse_sequence(string,t1,t2,t3,t4) result(found) + character(*), intent(in) :: string + character(*), intent(in) :: t1 + character(*), intent(in), optional :: t2, t3, t4 + logical :: found + + integer :: post, n, incr, pos, token_n + logical :: match + + n = len(string) + found = .false. + pos = 1 + + do token_n=1,4 + + do while (pos <= n) + if (string(pos:pos) /= ' ') then + exit + end if + pos = pos + 1 + end do + + select case(token_n) + case(1) + incr = len(t1) + match = string(pos:pos+incr-1) == t1 + case(2) + if (.not.present(t2)) exit + incr = len(t2) + if (pos+incr-1>n) return + match = string(pos:pos+incr-1) == t2 + case(3) + if (.not.present(t3)) exit + incr = len(t3) + if (pos+incr-1>n) return + match = string(pos:pos+incr-1) == t3 + case(4) + if (.not.present(t4)) exit + incr = len(t4) + if (pos+incr-1>n) return + match = string(pos:pos+incr-1) == t4 + case default + exit + end select + + if (.not.match) then + return + end if + + pos = pos + incr + + end do + + found = .true. + +end function parse_sequence + end module fpm_source_parsing +