Merge pull request #180 from LKedward/recursive_discovery

Recursive source discovery

Author: milancurcic

fpm/src/fpm_backend.f90

@@ -2,7 +2,7 @@ module fpm_backend
 
 ! Implements the native fpm build backend
 
-use fpm_environment, only: run
+use fpm_environment, only: run, get_os_type, OS_WINDOWS
 use fpm_filesystem, only: basename, join_path, exists, mkdir
 use fpm_model, only: fpm_model_t, srcfile_t, FPM_UNIT_MODULE, &
                      FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, &
@@ -109,8 +109,7 @@ recursive subroutine build_source(model,source_file,linking)
 
     end do
 
-    object_file = join_path(model%output_directory, model%package_name, &
-                        basename(source_file%file_name,suffix=.false.)//'.o')
+    object_file = get_object_name(model,source_file%file_name)
 
     call run("gfortran -c " // source_file%file_name // model%fortran_compile_flags &
               // " -o " // object_file)
@@ -120,4 +119,41 @@ recursive subroutine build_source(model,source_file,linking)
 
 end subroutine build_source
 
+
+function get_object_name(model,source_file_name) result(object_file)
+    ! Generate object target path from source name and model params
+    !  
+    !  src/test.f90        ->  <output-dir>/<package-name>/test.o
+    !  src/subdir/test.f90 ->  <output-dir>/<package-name>/subdir_test.o
+    !
+    type(fpm_model_t), intent(in) :: model
+    character(*), intent(in) :: source_file_name
+    character(:), allocatable :: object_file
+
+    integer :: i
+    character(1) :: filesep
+
+    select case(get_os_type())
+    case (OS_WINDOWS)
+        filesep = '\'
+    case default
+        filesep = '/'
+    end select
+
+    ! Exclude first directory level from path
+    object_file = source_file_name(index(source_file_name,filesep)+1:)
+
+    ! Convert remaining directory separators to underscores
+    i = index(object_file,filesep)
+    do while(i > 0)
+        object_file(i:i) = '_'
+        i = index(object_file,filesep)
+    end do
+
+    ! Construct full target path
+    object_file = join_path(model%output_directory, model%package_name, &
+                        object_file//'.o')
+
+end function get_object_name
+
 end module fpm_backend

fpm/src/fpm_filesystem.f90

@@ -40,6 +40,25 @@ function basename(path,suffix) result (base)
 end function basename
 
 
+logical function is_dir(dir) 
+    character(*), intent(in) :: dir 
+    integer :: stat 
+
+    select case (get_os_type()) 
+
+    case (OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD)
+        call execute_command_line("test -d " // dir , exitstat=stat) 
+
+    case (OS_WINDOWS) 
+        call execute_command_line('cmd /c "if not exist ' // windows_path(dir) // '\ exit /B 1"', exitstat=stat) 
+
+    end select 
+
+    is_dir = (stat == 0) 
+
+end function is_dir 
+
+
 function join_path(a1,a2,a3,a4,a5) result(path)
     ! Construct path by joining strings with os file separator
     !
@@ -130,11 +149,15 @@ subroutine mkdir(dir)
 end subroutine mkdir
 
 
-subroutine list_files(dir, files)
-    character(len=*),            intent(in)  :: dir
+recursive subroutine list_files(dir, files, recurse)
+    character(len=*), intent(in) :: dir
     type(string_t), allocatable, intent(out) :: files(:)
-    character(len=:), allocatable            :: temp_file
-    integer                                  :: stat, fh
+    logical, intent(in), optional :: recurse
+
+    integer :: stat, fh, i
+    character(:), allocatable :: temp_file
+    type(string_t), allocatable :: dir_files(:)
+    type(string_t), allocatable :: sub_dir_files(:)
 
     ! Using `inquire` / exists on directories works with gfortran, but not ifort
     if (.not. exists(dir)) then
@@ -160,7 +183,31 @@ subroutine list_files(dir, files)
 
     open (newunit=fh, file=temp_file, status='old')
     files = read_lines(fh)
-    close (fh, status='delete')
+    close(fh,status="delete")
+
+    do i=1,size(files)
+        files(i)%s = join_path(dir,files(i)%s)
+    end do
+
+    if (present(recurse)) then
+        if (recurse) then
+
+            allocate(sub_dir_files(0))
+
+            do i=1,size(files)
+                if (is_dir(files(i)%s)) then
+
+                    call list_files(files(i)%s, dir_files, recurse=.true.) 
+                    sub_dir_files = [sub_dir_files, dir_files]
+
+                end if
+            end do
+
+            files = [files, sub_dir_files]
+
+        end if
+    end if
+
 end subroutine list_files
 
 

fpm/src/fpm_sources.f90

@@ -37,8 +37,7 @@ subroutine add_sources_from_dir(sources,directory,with_executables,error)
     type(srcfile_t), allocatable :: dir_sources(:)
 
     ! Scan directory for sources
-    call list_files(directory, file_names)
-    file_names = [(string_t(directory//'/'//file_names(j)%s),j=1,size(file_names))]
+    call list_files(directory, file_names,recurse=.true.)
 
     is_source = [(str_ends_with(lower(file_names(i)%s), ".f90") .or. &
                   str_ends_with(lower(file_names(i)%s), ".c") .or. &

test/example_packages/hello_complex/source/farewell_m.f90

@@ -1,4 +1,5 @@
 module farewell_m
+    use subdir_constants, only: FAREWELL_STR
     implicit none
     private
 
@@ -8,6 +9,6 @@ function make_farewell(name) result(greeting)
         character(len=*), intent(in) :: name
         character(len=:), allocatable :: greeting
 
-        greeting = "Goodbye, " // name // "!"
+        greeting = FAREWELL_STR // name // "!"
     end function make_farewell
 end module farewell_m

test/example_packages/hello_complex/source/greet_m.f90

@@ -1,4 +1,5 @@
 module greet_m
+    use subdir_constants, only: GREET_STR
     implicit none
     private
 
@@ -8,6 +9,6 @@ function make_greeting(name) result(greeting)
         character(len=*), intent(in) :: name
         character(len=:), allocatable :: greeting
 
-        greeting = "Hello, " // name // "!"
+        greeting = GREET_STR // name // "!"
     end function make_greeting
 end module greet_m

test/example_packages/hello_complex/source/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