Merge pull request #676 from LKedward/tree-shaking

LKedward · web-flow · commit cb753869f131 · 2022-06-03T15:20:34.000+01:00
Tree shaking for modules
diff --git a/ci/run_tests.sh b/ci/run_tests.sh
@@ -62,6 +62,24 @@ 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 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
@@ -20,6 +20,8 @@ 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  |
+| 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
@@ -0,0 +1 @@
+build/*
diff --git a/example_packages/submodule_tree_shake/app/main.f90 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
diff --git a/example_packages/submodule_tree_shake/fpm.toml 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
@@ -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
diff --git a/example_packages/submodule_tree_shake/src/child2.f90 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
diff --git a/example_packages/submodule_tree_shake/src/child_unused.f90 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
diff --git a/example_packages/submodule_tree_shake/src/grandchild.f90 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
diff --git a/example_packages/submodule_tree_shake/src/parent.f90 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
diff --git a/example_packages/submodule_tree_shake/src/parent_unused.f90 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
diff --git a/example_packages/tree_shake/.gitignore 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
@@ -0,0 +1,15 @@
+program say_Hello
+    use greet_m, only: make_greeting
+
+    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/fpm.toml b/example_packages/tree_shake/fpm.toml
@@ -0,0 +1 @@
+name = "tree_shake"
diff --git a/example_packages/tree_shake/src/extra_m.f90 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
diff --git a/example_packages/tree_shake/src/farewell_m.f90 b/example_packages/tree_shake/src/farewell_m.f90
@@ -0,0 +1,17 @@
+! 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
+    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
@@ -0,0 +1,16 @@
+! 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
+    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
@@ -0,0 +1,9 @@
+! This module is used indirectly by the executables
+!  and hence should not be dropped during tree-shaking/pruning
+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
@@ -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
diff --git a/src/fpm.f90 b/src/fpm.f90
@@ -278,7 +278,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
@@ -324,7 +324,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
@@ -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
diff --git a/src/fpm_model.f90 b/src/fpm_model.f90
diff --git a/src/fpm_source_parsing.f90 b/src/fpm_source_parsing.f90
diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90
diff --git a/test/fpm_test/test_backend.f90 b/test/fpm_test/test_backend.f90
diff --git a/test/fpm_test/test_module_dependencies.f90 b/test/fpm_test/test_module_dependencies.f90
diff --git a/test/fpm_test/test_source_parsing.f90 b/test/fpm_test/test_source_parsing.f90
