Merge pull request #178 from LKedward/more_examples

Add more example packages

16 files changed, 303 insertions, 25 deletions

diff --git a/ci/run_tests.bat b/ci/run_tests.bat
index 9435e0d..92b3cd6 100755
--- a/ci/run_tests.bat
+++ b/ci/run_tests.bat
@@ -41,4 +41,31 @@ if errorlevel 1 exit 1
 if errorlevel 1 exit 1
 
 .\build\gfortran_debug\test\farewell_test
+if errorlevel 1 exit 1
+
+
+cd ..\with_c
+if errorlevel 1 exit 1
+
+..\..\..\fpm\build\gfortran_debug\app\fpm build
+if errorlevel 1 exit 1
+
+.\build\gfortran_debug\app\with_c
+if errorlevel 1 exit 1
+
+
+cd ..\submodules
+if errorlevel 1 exit 1
+
+..\..\..\fpm\build\gfortran_debug\app\fpm build
+if errorlevel 1 exit 1
+
+
+cd ..\program_with_module
+if errorlevel 1 exit 1
+
+..\..\..\fpm\build\gfortran_debug\app\fpm build
+if errorlevel 1 exit 1
+
+.\build\gfortran_debug\app\Program_with_module
 if errorlevel 1 exit 1
\ No newline at end of file
diff --git a/ci/run_tests.sh b/ci/run_tests.sh
index 3033c2a..418fcf2 100755
--- a/ci/run_tests.sh
+++ b/ci/run_tests.sh
@@ -17,4 +17,15 @@ cd ../hello_complex
 ./build/gfortran_debug/app/say_Hello
 ./build/gfortran_debug/app/say_goodbye
 ./build/gfortran_debug/test/greet_test
-./build/gfortran_debug/test/farewell_test
\ No newline at end of file
+./build/gfortran_debug/test/farewell_test
+
+cd ../with_c
+../../../fpm/build/gfortran_debug/app/fpm build
+./build/gfortran_debug/app/with_c
+
+cd ../submodules
+../../../fpm/build/gfortran_debug/app/fpm build
+
+cd ../program_with_module
+../../../fpm/build/gfortran_debug/app/fpm build
+./build/gfortran_debug/app/Program_with_module
\ No newline at end of file
diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90
index a9e9bd6..ead4ed3 100644
--- a/fpm/src/fpm_sources.f90
+++ b/fpm/src/fpm_sources.f90
@@ -309,7 +309,7 @@ function parse_f_source(f_filename,error) result(f_source)
                 if (.not.validate_name(mod_name)) then
                     call file_parse_error(error,f_filename, &
                           'empty or invalid name for module',i, &
-                          file_lines(i)%s)
+                          file_lines(i)%s, index(file_lines(i)%s,mod_name))
                     return
                 end if
 
@@ -326,6 +326,22 @@ function parse_f_source(f_filename,error) result(f_source)
             ! Extract name of submodule if is submodule
             if (index(adjustl(lower(file_lines(i)%s)),'submodule') == 1) then
 
+                mod_name = split_n(file_lines(i)%s,n=3,delims='()',stat=stat)
+                if (stat /= 0) then
+                    call file_parse_error(error,f_filename, &
+                          'unable to get submodule name',i, &
+                          file_lines(i)%s)
+                    return
+                end if
+                if (.not.validate_name(mod_name)) then
+                    call file_parse_error(error,f_filename, &
+                          'empty or invalid name for submodule',i, &
+                          file_lines(i)%s, index(file_lines(i)%s,mod_name))
+                    return
+                end if
+
+                n_mod = n_mod + 1
+
                 temp_string = split_n(file_lines(i)%s,n=2,delims='()',stat=stat)
                 if (stat /= 0) then
                     call file_parse_error(error,f_filename, &
@@ -346,8 +362,6 @@ function parse_f_source(f_filename,error) result(f_source)
                         
                     end if
 
-                    f_source%modules_used(n_use)%s = lower(temp_string)
-
                     if (.not.validate_name(temp_string)) then
                         call file_parse_error(error,f_filename, &
                           'empty or invalid name for submodule parent',i, &
@@ -355,13 +369,17 @@ function parse_f_source(f_filename,error) result(f_source)
                         return
                     end if
 
+                    f_source%modules_used(n_use)%s = lower(temp_string)
+
+                    f_source%modules_provided(n_mod)%s = lower(mod_name)
+
                 end if
 
             end if
 
-            ! Detect if is program
-            if (f_source%unit_type == FPM_UNIT_UNKNOWN .and. &
-                index(adjustl(lower(file_lines(i)%s)),'program') == 1) then
+            ! Detect if contains a program
+            !  (no modules allowed after program def)
+            if (index(adjustl(lower(file_lines(i)%s)),'program') == 1) then
 
                 f_source%unit_type = FPM_UNIT_PROGRAM
 
@@ -525,7 +543,7 @@ function split_n(string,delims,n,stat) result(substring)
         return
     end if
 
-    substring = trim(string_parts(i))
+    substring = trim(adjustl(string_parts(i)))
     stat = 0
 
 end function split_n
@@ -537,22 +555,42 @@ subroutine resolve_module_dependencies(sources)
     !
     type(srcfile_t), intent(inout), target :: sources(:)
 
-    integer :: n_depend, i, j
+    type(srcfile_ptr) :: dep
+
+    integer :: n_depend, i, pass, j
 
     do i=1,size(sources)
         
-        n_depend = size(sources(i)%modules_used)
+        do pass=1,2
+
+            n_depend = 0
+
+            do j=1,size(sources(i)%modules_used)
+
+                if (sources(i)%modules_used(j)%s .in. sources(i)%modules_provided) then
+                    ! Dependency satisfied in same file, skip
+                    cycle
+                end if
 
-        allocate(sources(i)%file_dependencies(n_depend))
+                dep%ptr => find_module_dependency(sources,sources(i)%modules_used(j)%s)
+
+                if (.not.associated(dep%ptr)) then
+                    write(*,*) '(!) Unable to find source for module dependency: ', &
+                               sources(i)%modules_used(j)%s
+                    write(*,*) '    for file ',sources(i)%file_name
+                    ! stop
+                end if
 
-        do j=1,n_depend
+                n_depend = n_depend + 1
+
+                if (pass == 2) then
+                    sources(i)%file_dependencies(n_depend) = dep
+                end if
 
-            sources(i)%file_dependencies(j)%ptr => &
-                 find_module_dependency(sources,sources(i)%modules_used(j)%s)
+            end do
 
-            if (.not.associated(sources(i)%file_dependencies(j)%ptr)) then
-                write(*,*) '(!) Unable to find source for module dependency: ',sources(i)%modules_used(j)%s
-                ! stop
+            if (pass == 1) then
+                allocate(sources(i)%file_dependencies(n_depend))
             end if
 
         end do
diff --git a/fpm/test/test_source_parsing.f90 b/fpm/test/test_source_parsing.f90
index c55a206..0b92bef 100644
--- a/fpm/test/test_source_parsing.f90
+++ b/fpm/test/test_source_parsing.f90
@@ -25,6 +25,7 @@ contains
             & new_unittest("intrinsic-modules-used", test_intrinsic_modules_used), &
             & new_unittest("include-stmt", test_include_stmt), &
             & new_unittest("module", test_module), &
+            & new_unittest("program-with-module", test_program_with_module), &
             & new_unittest("submodule", test_submodule), &
             & new_unittest("submodule-ancestor", test_submodule_ancestor), &
             & new_unittest("subprogram", test_subprogram), &
@@ -258,7 +259,7 @@ contains
             & 'contains', &
             & 'module procedure f()', &
             & 'end procedure f', &
-            & 'end submodule test'
+            & 'end module test'
         close(unit)
 
         f_source = parse_f_source(temp_file,error)
@@ -287,13 +288,76 @@ contains
         end if
 
         if (.not.('module_one' .in. f_source%modules_used)) then
-            call test_failed(error,'Missing parent module in modules_used')
+            call test_failed(error,'Missing module in modules_used')
             return
         end if
 
     end subroutine test_module
 
 
+    !> Try to parse combined fortran module and program
+    !>  Check that parsed unit type is FPM_UNIT_PROGRAM
+    subroutine test_program_with_module(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', &
+            & 'use module_one', &
+            & 'interface', &
+            & '  module subroutine f()', &
+            & 'end interface', &
+            & 'contains', &
+            & 'module procedure f()', &
+            & 'end procedure f', &
+            & 'end module test', &
+            & 'program my_program', &
+            & 'use my_mod', &
+            & 'implicit none', &
+            & 'end my_program'
+        close(unit)
+
+        f_source = parse_f_source(temp_file,error)
+        if (allocated(error)) then
+            return
+        end if
+
+        if (f_source%unit_type /= FPM_UNIT_PROGRAM) then
+            call test_failed(error,'Wrong unit type detected - expecting FPM_UNIT_PROGRAM')
+            return
+        end if
+
+        if (size(f_source%modules_provided) /= 1) then
+            call test_failed(error,'Unexpected modules_provided - expecting one')
+            return
+        end if
+
+        if (.not.('my_mod' .in. f_source%modules_provided)) then
+            call test_failed(error,'Missing module in modules_provided')
+            return
+        end if
+
+        if (.not.('module_one' .in. f_source%modules_used)) then
+            call test_failed(error,'Missing module in modules_used')
+            return
+        end if
+
+        if (.not.('my_mod' .in. f_source%modules_used)) then
+            call test_failed(error,'Missing module in modules_used')
+            return
+        end if
+
+    end subroutine test_program_with_module
+
+
     !> Try to parse fortran submodule for ancestry
     subroutine test_submodule(error)
 
@@ -308,7 +372,7 @@ contains
 
         open(file=temp_file, newunit=unit)
         write(unit, '(a)') &
-            & 'submodule (parent) :: child', &
+            & 'submodule (parent) child', &
             & 'use module_one', &
             & 'end submodule test'
         close(unit)
@@ -323,8 +387,8 @@ contains
             return
         end if
 
-        if (size(f_source%modules_provided) /= 0) then
-            call test_failed(error,'Unexpected modules_provided - expecting zero')
+        if (size(f_source%modules_provided) /= 1) then
+            call test_failed(error,'Unexpected modules_provided - expecting one')
             return
         end if
 
@@ -333,6 +397,11 @@ contains
             return
         end if
 
+        if (.not.('child' .in. f_source%modules_provided)) then
+            call test_failed(error,'Missing module in modules_provided')
+            return
+        end if
+
         if (.not.('module_one' .in. f_source%modules_used)) then
             call test_failed(error,'Missing module in modules_used')
             return
@@ -360,7 +429,7 @@ contains
 
         open(file=temp_file, newunit=unit)
         write(unit, '(a)') &
-            & 'submodule (ancestor:parent) :: child', &
+            & 'submodule (ancestor:parent) child', &
             & 'use module_one', &
             & 'end submodule test'
         close(unit)
@@ -375,8 +444,8 @@ contains
             return
         end if
 
-        if (size(f_source%modules_provided) /= 0) then
-            call test_failed(error,'Unexpected modules_provided - expecting zero')
+        if (size(f_source%modules_provided) /= 1) then
+            call test_failed(error,'Unexpected modules_provided - expecting one')
             return
         end if
 
@@ -385,6 +454,11 @@ contains
             return
         end if
 
+        if (.not.('child' .in. f_source%modules_provided)) then
+            call test_failed(error,'Missing module in modules_provided')
+            return
+        end if
+
         if (.not.('module_one' .in. f_source%modules_used)) then
             call test_failed(error,'Missing module in modules_used')
             return
diff --git a/test/example_packages/README.md b/test/example_packages/README.md
new file mode 100644
index 0000000..06de927
--- /dev/null
+++ b/test/example_packages/README.md
@@ -0,0 +1,18 @@
+# Example packages
+
+See the table below for a list of the example packages provided in this directory including
+the features demonstrated in each package and which versions of fpm are supported.
+
+
+| Name                | Features                                                      | Bootstrap (Haskell) fpm | fpm |
+|---------------------|---------------------------------------------------------------|:-----------------------:|:---:|
+| circular_example    | Local path dependency; circular dependency                    |            Y            |  N  |
+| circular_test       | Local path dependency; circular dependency                    |            Y            |  N  |
+| hello_complex       | Non-standard directory layout; multiple tests and executables |            Y            |  Y  |
+| hello_fpm           | App-only; local path dependency                               |            Y            |  N  |
+| hello_world         | App-only                                                      |            Y            |  Y  |
+| 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  |
+| with_c              | Compile with `c` source files                                 |            N            |  Y  |
+| with_makefile       | External build command (makefile)                             |            Y            |  N  |
\ No newline at end of file
diff --git a/test/example_packages/program_with_module/app/main.f90 b/test/example_packages/program_with_module/app/main.f90
new file mode 100644
index 0000000..59441f0
--- /dev/null
+++ b/test/example_packages/program_with_module/app/main.f90
@@ -0,0 +1,10 @@
+module greet_m
+  implicit none
+  character(*), parameter :: greeting = 'Hello, fpm!' 
+end module greet_m
+
+program program_with_module
+  use greet_m, only: greeting
+  implicit none
+  print *, greeting
+end program program_with_module
diff --git a/test/example_packages/program_with_module/fpm.toml b/test/example_packages/program_with_module/fpm.toml
new file mode 100644
index 0000000..bce6aa2
--- /dev/null
+++ b/test/example_packages/program_with_module/fpm.toml
@@ -0,0 +1 @@
+name = "Program_with_module"
diff --git a/test/example_packages/submodules/fpm.toml b/test/example_packages/submodules/fpm.toml
new file mode 100644
index 0000000..cfc3d61
--- /dev/null
+++ b/test/example_packages/submodules/fpm.toml
@@ -0,0 +1 @@
+name = "submodules"
diff --git a/test/example_packages/submodules/src/child1.f90 b/test/example_packages/submodules/src/child1.f90
new file mode 100644
index 0000000..dbd0fa5
--- /dev/null
+++ b/test/example_packages/submodules/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/test/example_packages/submodules/src/child2.f90 b/test/example_packages/submodules/src/child2.f90
new file mode 100644
index 0000000..179cc32
--- /dev/null
+++ b/test/example_packages/submodules/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/test/example_packages/submodules/src/grandchild.f90 b/test/example_packages/submodules/src/grandchild.f90
new file mode 100644
index 0000000..8c5aa17
--- /dev/null
+++ b/test/example_packages/submodules/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/test/example_packages/submodules/src/parent.f90 b/test/example_packages/submodules/src/parent.f90
new file mode 100644
index 0000000..570827c
--- /dev/null
+++ b/test/example_packages/submodules/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/test/example_packages/with_c/app/main.f90 b/test/example_packages/with_c/app/main.f90
new file mode 100644
index 0000000..4d3174b
--- /dev/null
+++ b/test/example_packages/with_c/app/main.f90
@@ -0,0 +1,10 @@
+program with_c_app
+use with_c
+implicit none
+
+write(*,*) "isdir('app') = ", system_isdir('app')
+write(*,*) "isdir('src') = ", system_isdir('src')
+write(*,*) "isdir('test') = ", system_isdir('test')
+write(*,*) "isdir('bench') = ", system_isdir('bench')
+
+end program with_c_app
\ No newline at end of file
diff --git a/test/example_packages/with_c/fpm.toml b/test/example_packages/with_c/fpm.toml
new file mode 100644
index 0000000..97e3110
--- /dev/null
+++ b/test/example_packages/with_c/fpm.toml
@@ -0,0 +1 @@
+name = "with_c"
diff --git a/test/example_packages/with_c/src/c_code.c b/test/example_packages/with_c/src/c_code.c
new file mode 100644
index 0000000..44604f0
--- /dev/null
+++ b/test/example_packages/with_c/src/c_code.c
@@ -0,0 +1,10 @@
+#include <sys/stat.h>
+/*
+ *  Decides whether a given file name is a directory.
+ *  return 1 if file exists and is a directory
+ *  Source (Public domain): https://github.com/urbanjost/M_system
+ */
+int my_isdir (const char *path) {
+   struct stat sb;
+   return stat(path, &sb) == 0 && S_ISDIR (sb.st_mode);
+}
\ No newline at end of file
diff --git a/test/example_packages/with_c/src/with_c.f90 b/test/example_packages/with_c/src/with_c.f90
new file mode 100644
index 0000000..edd839e
--- /dev/null
+++ b/test/example_packages/with_c/src/with_c.f90
@@ -0,0 +1,26 @@
+module with_c
+    use iso_c_binding, only: c_char, c_int, c_null_char
+    implicit none
+
+contains
+
+    function system_isdir(dirname)
+        ! Source (Public domain): https://github.com/urbanjost/M_system
+        !
+        implicit none
+        character(len=*),intent(in) :: dirname
+        logical                     :: system_isdir
+        
+        interface
+            function c_isdir(dirname) bind (C,name="my_isdir") result (c_ierr)
+            import c_char,c_int
+            character(kind=c_char,len=1),intent(in) :: dirname(*)
+            integer(kind=c_int)                     :: c_ierr
+            end function c_isdir
+        end interface
+        
+        system_isdir= c_isdir(trim(dirname)//c_null_char) == 1
+        
+    end function system_isdir
+
+end module with_c
\ No newline at end of file