diff options
| -rwxr-xr-x | ci/run_tests.bat | 27 | ||||
| -rwxr-xr-x | ci/run_tests.sh | 13 | ||||
| -rw-r--r-- | fpm/src/fpm_sources.f90 | 70 | ||||
| -rw-r--r-- | fpm/test/test_source_parsing.f90 | 90 | ||||
| -rw-r--r-- | test/example_packages/README.md | 18 | ||||
| -rw-r--r-- | test/example_packages/program_with_module/app/main.f90 | 10 | ||||
| -rw-r--r-- | test/example_packages/program_with_module/fpm.toml | 1 | ||||
| -rw-r--r-- | test/example_packages/submodules/fpm.toml | 1 | ||||
| -rw-r--r-- | test/example_packages/submodules/src/child1.f90 | 16 | ||||
| -rw-r--r-- | test/example_packages/submodules/src/child2.f90 | 10 | ||||
| -rw-r--r-- | test/example_packages/submodules/src/grandchild.f90 | 10 | ||||
| -rw-r--r-- | test/example_packages/submodules/src/parent.f90 | 15 | ||||
| -rw-r--r-- | test/example_packages/with_c/app/main.f90 | 10 | ||||
| -rw-r--r-- | test/example_packages/with_c/fpm.toml | 1 | ||||
| -rw-r--r-- | test/example_packages/with_c/src/c_code.c | 10 | ||||
| -rw-r--r-- | test/example_packages/with_c/src/with_c.f90 | 26 |
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 |