diff options
30 files changed, 1053 insertions, 58 deletions
diff --git a/ci/run_tests.bat b/ci/run_tests.bat index 92b3cd6..76e5349 100755 --- a/ci/run_tests.bat +++ b/ci/run_tests.bat @@ -44,6 +44,41 @@ if errorlevel 1 exit 1 if errorlevel 1 exit 1 +cd ..\hello_complex_2 +if errorlevel 1 exit 1 + +..\..\..\fpm\build\gfortran_debug\app\fpm build +if errorlevel 1 exit 1 + +.\build\gfortran_debug\app\say_hello_world +if errorlevel 1 exit 1 + +.\build\gfortran_debug\app\say_goodbye +if errorlevel 1 exit 1 + +.\build\gfortran_debug\test\greet_test +if errorlevel 1 exit 1 + +.\build\gfortran_debug\test\farewell_test + + +cd ..\auto_discovery_off +if errorlevel 1 exit 1 + +..\..\..\fpm\build\gfortran_debug\app\fpm build +if errorlevel 1 exit 1 + +.\build\gfortran_debug\app\auto_discovery_off +if errorlevel 1 exit 1 + +.\build\gfortran_debug\test\my_test +if errorlevel 1 exit 1 + +if exist .\build\gfortran_debug\app\unused exit /B 1 + +if exist .\build\gfortran_debug\test\unused_test exit /B 1 + + cd ..\with_c if errorlevel 1 exit 1 diff --git a/ci/run_tests.sh b/ci/run_tests.sh index 418fcf2..adff2b3 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -19,6 +19,20 @@ cd ../hello_complex ./build/gfortran_debug/test/greet_test ./build/gfortran_debug/test/farewell_test +cd ../hello_complex_2 +../../../fpm/build/gfortran_debug/app/fpm build +./build/gfortran_debug/app/say_hello_world +./build/gfortran_debug/app/say_goodbye +./build/gfortran_debug/test/greet_test +./build/gfortran_debug/test/farewell_test + +cd ../auto_discovery_off +../../../fpm/build/gfortran_debug/app/fpm build +./build/gfortran_debug/app/auto_discovery_off +./build/gfortran_debug/test/my_test +test ! -x ./build/gfortran_debug/app/unused +test ! -x ./build/gfortran_debug/test/unused_test + cd ../with_c ../../../fpm/build/gfortran_debug/app/fpm build ./build/gfortran_debug/app/with_c @@ -28,4 +42,4 @@ cd ../submodules cd ../program_with_module ../../../fpm/build/gfortran_debug/app/fpm build -./build/gfortran_debug/app/Program_with_module
\ No newline at end of file +./build/gfortran_debug/app/Program_with_module diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 1975d28..bd93b2a 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -5,8 +5,11 @@ use fpm_backend, only: build_package use fpm_command_line, only: fpm_build_settings, fpm_new_settings, & fpm_run_settings, fpm_install_settings, fpm_test_settings use fpm_environment, only: run, get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS -use fpm_filesystem, only: join_path, number_of_rows, list_files, exists, basename -use fpm_model, only: srcfile_ptr, srcfile_t, fpm_model_t +use fpm_filesystem, only: is_dir, join_path, number_of_rows, list_files, exists, basename +use fpm_model, only: srcfile_ptr, srcfile_t, fpm_model_t, & + FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, & + FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST + use fpm_sources, only: add_executable_sources, add_sources_from_dir, & resolve_module_dependencies use fpm_manifest, only : get_package_data, default_executable, & @@ -54,20 +57,38 @@ subroutine build_model(model, settings, package, error) model%link_flags = '' ! Add sources from executable directories - if (allocated(package%executable)) then + if (is_dir('app') .and. package%build_config%auto_executables) then + call add_sources_from_dir(model%sources,'app', FPM_SCOPE_APP, & + with_executables=.true., error=error) + + if (allocated(error)) then + return + end if - call add_executable_sources(model%sources, package%executable, & - is_test=.false., error=error) + end if + if (is_dir('test') .and. package%build_config%auto_tests) then + call add_sources_from_dir(model%sources,'test', FPM_SCOPE_TEST, & + with_executables=.true., error=error) if (allocated(error)) then return end if end if - if (allocated(package%test)) then + if (allocated(package%executable)) then + call add_executable_sources(model%sources, package%executable, FPM_SCOPE_APP, & + auto_discover=package%build_config%auto_executables, & + error=error) + + if (allocated(error)) then + return + end if - call add_executable_sources(model%sources, package%test, & - is_test=.true., error=error) + end if + if (allocated(package%test)) then + call add_executable_sources(model%sources, package%test, FPM_SCOPE_TEST, & + auto_discover=package%build_config%auto_tests, & + error=error) if (allocated(error)) then return @@ -76,9 +97,8 @@ subroutine build_model(model, settings, package, error) end if if (allocated(package%library)) then - - call add_sources_from_dir(model%sources,package%library%source_dir, & - error=error) + call add_sources_from_dir(model%sources, package%library%source_dir, & + FPM_SCOPE_LIB, error=error) if (allocated(error)) then return @@ -86,7 +106,7 @@ subroutine build_model(model, settings, package, error) end if - call resolve_module_dependencies(model%sources) + call resolve_module_dependencies(model%sources,error) end subroutine build_model @@ -107,8 +127,9 @@ if (.not.allocated(package%library) .and. exists("src")) then call default_library(package%library) end if -! Populate executable in case we find the default app directory -if (.not.allocated(package%executable) .and. exists("app")) then +! Populate executable in case we find the default app +if (.not.allocated(package%executable) .and. & + exists(join_path('app',"main.f90"))) then allocate(package%executable(1)) call default_executable(package%executable(1), package%name) end if diff --git a/fpm/src/fpm/manifest.f90 b/fpm/src/fpm/manifest.f90 index af4e0fa..0098890 100644 --- a/fpm/src/fpm/manifest.f90 +++ b/fpm/src/fpm/manifest.f90 @@ -7,6 +7,7 @@ ! Additionally, the required data types for users of this module are reexported ! to hide the actual implementation details. module fpm_manifest + use fpm_manifest_build_config, only: build_config_t use fpm_manifest_executable, only : executable_t use fpm_manifest_library, only : library_t use fpm_manifest_package, only : package_t, new_package diff --git a/fpm/src/fpm/manifest/build_config.f90 b/fpm/src/fpm/manifest/build_config.f90 new file mode 100644 index 0000000..069c3e0 --- /dev/null +++ b/fpm/src/fpm/manifest/build_config.f90 @@ -0,0 +1,140 @@ +!> Implementation of the build configuration data. +! +! A build table can currently have the following fields +! +! ```toml +! [build] +! auto-executables = <bool> +! auto-tests = <bool> +! ``` +module fpm_manifest_build_config + use fpm_error, only : error_t, syntax_error, fatal_error + use fpm_toml, only : toml_table, toml_key, toml_stat, get_value + implicit none + private + + public :: build_config_t, new_build_config + + + !> Configuration data for build + type :: build_config_t + + !> Automatic discovery of executables + logical :: auto_executables + + !> Automatic discovery of tests + logical :: auto_tests + + contains + + !> Print information on this instance + procedure :: info + + end type build_config_t + + +contains + + + !> Construct a new build configuration from a TOML data structure + subroutine new_build_config(self, table, error) + + !> Instance of the build configuration + type(build_config_t), intent(out) :: self + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + !> Status + integer :: stat + + call check(table, error) + if (allocated(error)) return + + call get_value(table, "auto-executables", self%auto_executables, .true., stat=stat) + + if (stat /= toml_stat%success) then + call fatal_error(error,"Error while reading value for 'auto-executables' in fpm.toml, expecting logical") + return + end if + + call get_value(table, "auto-tests", self%auto_tests, .true., stat=stat) + + if (stat /= toml_stat%success) then + call fatal_error(error,"Error while reading value for 'auto-tests' in fpm.toml, expecting logical") + return + end if + + end subroutine new_build_config + + + !> Check local schema for allowed entries + subroutine check(table, error) + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_key), allocatable :: list(:) + integer :: ikey + + call table%get_keys(list) + + ! table can be empty + if (size(list) < 1) return + + do ikey = 1, size(list) + select case(list(ikey)%key) + + case("auto-executables", "auto-tests") + continue + + case default + call syntax_error(error, "Key "//list(ikey)%key//" is not allowed in [build]") + exit + + end select + end do + + end subroutine check + + + !> Write information on build configuration instance + subroutine info(self, unit, verbosity) + + !> Instance of the build configuration + class(build_config_t), intent(in) :: self + + !> Unit for IO + integer, intent(in) :: unit + + !> Verbosity of the printout + integer, intent(in), optional :: verbosity + + integer :: pr + character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)' + + if (present(verbosity)) then + pr = verbosity + else + pr = 1 + end if + + if (pr < 1) return + + write(unit, fmt) "Build configuration" + ! if (allocated(self%auto_executables)) then + write(unit, fmt) " - auto-discovery (apps) ", merge("enabled ", "disabled", self%auto_executables) + ! end if + ! if (allocated(self%auto_tests)) then + write(unit, fmt) " - auto-discovery (tests) ", merge("enabled ", "disabled", self%auto_tests) + ! end if + + end subroutine info + +end module fpm_manifest_build_config diff --git a/fpm/src/fpm/manifest/package.f90 b/fpm/src/fpm/manifest/package.f90 index 039aa78..fc04aa8 100644 --- a/fpm/src/fpm/manifest/package.f90 +++ b/fpm/src/fpm/manifest/package.f90 @@ -28,6 +28,7 @@ ! [[test]] ! ``` module fpm_manifest_package + use fpm_manifest_build_config, only: build_config_t, new_build_config use fpm_manifest_dependency, only : dependency_t, new_dependencies use fpm_manifest_executable, only : executable_t, new_executable use fpm_manifest_library, only : library_t, new_library @@ -48,6 +49,9 @@ module fpm_manifest_package !> Name of the package character(len=:), allocatable :: name + !> Build configuration data + type(build_config_t) :: build_config + !> Package version type(version_t) :: version @@ -103,8 +107,18 @@ contains return end if + call get_value(table, "build", child, requested=.true., stat=stat) + if (stat /= toml_stat%success) then + call fatal_error(error, "Type mismatch for build entry, must be a table") + return + end if + call new_build_config(self%build_config, child, error) + + if (allocated(error)) return + call get_value(table, "version", version, "0") call new_version(self%version, version, error) + if (allocated(error)) return call get_value(table, "dependencies", child, requested=.false.) @@ -193,7 +207,7 @@ contains name_present = .true. case("version", "license", "author", "maintainer", "copyright", & - & "description", "keywords", "categories", "homepage", & + & "description", "keywords", "categories", "homepage", "build", & & "dependencies", "dev-dependencies", "test", "executable", & & "library") continue @@ -238,6 +252,8 @@ contains write(unit, fmt) "- name", self%name end if + call self%build_config%info(unit, pr - 1) + if (allocated(self%library)) then write(unit, fmt) "- target", "archive" call self%library%info(unit, pr - 1) diff --git a/fpm/src/fpm_backend.f90 b/fpm/src/fpm_backend.f90 index 65d6dae..40460d7 100644 --- a/fpm/src/fpm_backend.f90 +++ b/fpm/src/fpm_backend.f90 @@ -6,7 +6,9 @@ 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, & - FPM_UNIT_CSOURCE, FPM_UNIT_PROGRAM + FPM_UNIT_CSOURCE, FPM_UNIT_PROGRAM, & + FPM_SCOPE_TEST + use fpm_strings, only: split implicit none @@ -59,7 +61,7 @@ subroutine build_package(model) base = basename(model%sources(i)%file_name,suffix=.false.) - if (model%sources(i)%is_test) then + if (model%sources(i)%unit_scope == FPM_SCOPE_TEST) then subdir = 'test' else subdir = 'app' diff --git a/fpm/src/fpm_filesystem.f90 b/fpm/src/fpm_filesystem.f90 index 488a202..2aa9f8b 100644 --- a/fpm/src/fpm_filesystem.f90 +++ b/fpm/src/fpm_filesystem.f90 @@ -5,8 +5,8 @@ module fpm_filesystem use fpm_strings, only: f_string, string_t, split implicit none private - public :: basename, join_path, number_of_rows, read_lines, list_files, & - mkdir, exists, get_temp_filename, windows_path + public :: basename, canon_path, dirname, is_dir, join_path, number_of_rows, read_lines, list_files,& + mkdir, exists, get_temp_filename, windows_path integer, parameter :: LINE_BUFFER_LEN = 1000 @@ -40,6 +40,89 @@ function basename(path,suffix) result (base) end function basename +function canon_path(path) result(canon) + ! Canonicalize path for comparison + ! Handles path string redundancies + ! Does not test existence of path + ! + ! To be replaced by realpath/_fullname in stdlib_os + ! + character(*), intent(in) :: path + character(:), allocatable :: canon + + integer :: i, j + integer :: iback + character(len(path)) :: nixpath + character(len(path)) :: temp + + nixpath = unix_path(path) + + j = 1 + do i=1,len(nixpath) + + ! Skip back to last directory for '/../' + if (i > 4) then + + if (nixpath(i-3:i) == '/../') then + + iback = scan(nixpath(1:i-4),'/',back=.true.) + if (iback > 0) then + j = iback + 1 + cycle + end if + + end if + + end if + + if (i > 1 .and. j > 1) then + + ! Ignore current directory reference + if (nixpath(i-1:i) == './') then + + j = j - 1 + cycle + + end if + + ! Ignore repeated separators + if (nixpath(i-1:i) == '//') then + + cycle + + end if + + ! Do NOT include trailing slash + if (i == len(nixpath) .and. nixpath(i:i) == '/') then + cycle + end if + + end if + + + temp(j:j) = nixpath(i:i) + j = j + 1 + + end do + + canon = temp(1:j-1) + +end function canon_path + + +function dirname(path) result (dir) + ! Extract dirname from path + ! + character(*), intent(in) :: path + character(:), allocatable :: dir + + character(:), allocatable :: file_parts(:) + + dir = path(1:scan(path,'/\',back=.true.)) + +end function dirname + + logical function is_dir(dir) character(*), intent(in) :: dir integer :: stat @@ -274,4 +357,23 @@ function windows_path(path) result(winpath) end function windows_path + +function unix_path(path) result(nixpath) + ! Replace file system separators for unix + ! + character(*), intent(in) :: path + character(:), allocatable :: nixpath + + integer :: idx + + nixpath = path + + idx = index(nixpath,'\') + do while(idx > 0) + nixpath(idx:idx) = '/' + idx = index(nixpath,'\') + end do + +end function unix_path + end module fpm_filesystem diff --git a/fpm/src/fpm_model.f90 b/fpm/src/fpm_model.f90 index 702ba6f..36086df 100644 --- a/fpm/src/fpm_model.f90 +++ b/fpm/src/fpm_model.f90 @@ -8,7 +8,8 @@ public :: srcfile_ptr, srcfile_t, fpm_model_t public :: FPM_UNIT_UNKNOWN, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, & - FPM_UNIT_CHEADER + FPM_UNIT_CHEADER, FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, & + FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST integer, parameter :: FPM_UNIT_UNKNOWN = -1 integer, parameter :: FPM_UNIT_PROGRAM = 1 @@ -18,6 +19,12 @@ integer, parameter :: FPM_UNIT_SUBPROGRAM = 4 integer, parameter :: FPM_UNIT_CSOURCE = 5 integer, parameter :: FPM_UNIT_CHEADER = 6 +integer, parameter :: FPM_SCOPE_UNKNOWN = -1 +integer, parameter :: FPM_SCOPE_LIB = 1 +integer, parameter :: FPM_SCOPE_DEP = 2 +integer, parameter :: FPM_SCOPE_APP = 3 +integer, parameter :: FPM_SCOPE_TEST = 4 + type srcfile_ptr ! For constructing arrays of src_file pointers type(srcfile_t), pointer :: ptr => null() @@ -30,6 +37,8 @@ type srcfile_t ! File path relative to cwd character(:), allocatable :: exe_name ! Name of executable for FPM_UNIT_PROGRAM + integer :: unit_scope = FPM_SCOPE_UNKNOWN + ! app/test/lib/dependency logical :: is_test = .false. ! Is executable a test? type(string_t), allocatable :: modules_provided(:) diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index ead4ed3..f798276 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -1,10 +1,12 @@ module fpm_sources -use fpm_error, only: error_t, file_parse_error +use fpm_error, only: error_t, file_parse_error, fatal_error use fpm_model, only: srcfile_ptr, srcfile_t, fpm_model_t, & FPM_UNIT_UNKNOWN, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, & - FPM_UNIT_CSOURCE, FPM_UNIT_CHEADER -use fpm_filesystem, only: basename, read_lines, list_files + FPM_UNIT_CSOURCE, FPM_UNIT_CHEADER, FPM_SCOPE_UNKNOWN, & + FPM_SCOPE_LIB, FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST + +use fpm_filesystem, only: basename, canon_path, dirname, read_lines, list_files use fpm_strings, only: lower, split, str_ends_with, string_t, operator(.in.) use fpm_manifest_executable, only: executable_t implicit none @@ -22,11 +24,12 @@ character(15), parameter :: INTRINSIC_MODULE_NAMES(*) = & contains -subroutine add_sources_from_dir(sources,directory,with_executables,error) +subroutine add_sources_from_dir(sources,directory,scope,with_executables,error) ! Enumerate sources in a directory ! type(srcfile_t), allocatable, intent(inout), target :: sources(:) character(*), intent(in) :: directory + integer, intent(in) :: scope logical, intent(in), optional :: with_executables type(error_t), allocatable, intent(out) :: error @@ -34,14 +37,25 @@ subroutine add_sources_from_dir(sources,directory,with_executables,error) logical, allocatable :: is_source(:), exclude_source(:) type(string_t), allocatable :: file_names(:) type(string_t), allocatable :: src_file_names(:) + type(string_t), allocatable :: existing_src_files(:) type(srcfile_t), allocatable :: dir_sources(:) ! Scan directory for sources 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. & - str_ends_with(lower(file_names(i)%s), ".h"),i=1,size(file_names))] + if (allocated(sources)) then + allocate(existing_src_files(size(sources))) + do i=1,size(sources) + existing_src_files(i)%s = sources(i)%file_name + end do + else + allocate(existing_src_files(0)) + end if + + is_source = [(.not.(file_names(i)%s .in. existing_src_files) .and. & + (str_ends_with(lower(file_names(i)%s), ".f90") .or. & + str_ends_with(lower(file_names(i)%s), ".c") .or. & + str_ends_with(lower(file_names(i)%s), ".h") ),i=1,size(file_names))] src_file_names = pack(file_names,is_source) allocate(dir_sources(size(src_file_names))) @@ -70,6 +84,8 @@ subroutine add_sources_from_dir(sources,directory,with_executables,error) end if + dir_sources(i)%unit_scope = scope + ! Exclude executables unless specified otherwise exclude_source(i) = (dir_sources(i)%unit_type == FPM_UNIT_PROGRAM) if (dir_sources(i)%unit_type == FPM_UNIT_PROGRAM .and. & @@ -93,57 +109,61 @@ subroutine add_sources_from_dir(sources,directory,with_executables,error) end subroutine add_sources_from_dir -subroutine add_executable_sources(sources,executables,is_test,error) - ! Add sources from executable directories specified in manifest - ! Only allow executables that are explicitly specified in manifest - ! +subroutine add_executable_sources(sources,executables,scope,auto_discover,error) + ! Include sources from any directories specified + ! in [[executable]] entries and apply any customisations + ! type(srcfile_t), allocatable, intent(inout), target :: sources(:) class(executable_t), intent(in) :: executables(:) - logical, intent(in) :: is_test + integer, intent(in) :: scope + logical, intent(in) :: auto_discover type(error_t), allocatable, intent(out) :: error integer :: i, j type(string_t), allocatable :: exe_dirs(:) - logical, allocatable :: exclude_source(:) + logical, allocatable :: include_source(:) type(srcfile_t), allocatable :: dir_sources(:) call get_executable_source_dirs(exe_dirs,executables) do i=1,size(exe_dirs) - call add_sources_from_dir(dir_sources,exe_dirs(i)%s, & - with_executables=.true.,error=error) + scope, with_executables=.true.,error=error) if (allocated(error)) then return end if - end do - allocate(exclude_source(size(dir_sources))) + allocate(include_source(size(dir_sources))) do i = 1, size(dir_sources) - - ! Only allow executables in 'executables' list - exclude_source(i) = (dir_sources(i)%unit_type == FPM_UNIT_PROGRAM) + ! Include source by default if not a program or if auto_discover is enabled + include_source(i) = (dir_sources(i)%unit_type /= FPM_UNIT_PROGRAM) .or. & + auto_discover + + ! Always include sources specified in fpm.toml do j=1,size(executables) - if (basename(dir_sources(i)%file_name,suffix=.true.) == & - executables(j)%main) then - exclude_source(i) = .false. + + if (basename(dir_sources(i)%file_name,suffix=.true.) == executables(j)%main .and.& + canon_path(dirname(dir_sources(i)%file_name)) == & + canon_path(executables(j)%source_dir) ) then + + include_source(i) = .true. dir_sources(i)%exe_name = executables(j)%name - dir_sources(i)%is_test = is_test exit + end if end do end do if (.not.allocated(sources)) then - sources = pack(dir_sources,.not.exclude_source) + sources = pack(dir_sources,include_source) else - sources = [sources, pack(dir_sources,.not.exclude_source)] + sources = [sources, pack(dir_sources,include_source)] end if end subroutine add_executable_sources @@ -549,11 +569,12 @@ function split_n(string,delims,n,stat) result(substring) end function split_n -subroutine resolve_module_dependencies(sources) +subroutine resolve_module_dependencies(sources,error) ! After enumerating all source files: resolve file dependencies ! by searching on module names ! type(srcfile_t), intent(inout), target :: sources(:) + type(error_t), allocatable, intent(out) :: error type(srcfile_ptr) :: dep @@ -571,14 +592,23 @@ subroutine resolve_module_dependencies(sources) ! Dependency satisfied in same file, skip cycle end if - - dep%ptr => find_module_dependency(sources,sources(i)%modules_used(j)%s) + + if (sources(i)%unit_scope == FPM_SCOPE_APP .OR. & + sources(i)%unit_scope == FPM_SCOPE_TEST ) then + dep%ptr => & + find_module_dependency(sources,sources(i)%modules_used(j)%s, & + include_dir = dirname(sources(i)%file_name)) + else + dep%ptr => & + find_module_dependency(sources,sources(i)%modules_used(j)%s) + end if 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 + call fatal_error(error, & + 'Unable to find source for module dependency: "' // & + sources(i)%modules_used(j)%s // & + '" used by "'//sources(i)%file_name//'"') + return end if n_depend = n_depend + 1 @@ -599,9 +629,15 @@ subroutine resolve_module_dependencies(sources) end subroutine resolve_module_dependencies -function find_module_dependency(sources,module_name) result(src_ptr) +function find_module_dependency(sources,module_name,include_dir) result(src_ptr) + ! Find a module dependency in the library or a dependency library + ! + ! 'include_dir' specifies an allowable non-library search directory + ! (Used for executable dependencies) + ! type(srcfile_t), intent(in), target :: sources(:) character(*), intent(in) :: module_name + character(*), intent(in), optional :: include_dir type(srcfile_t), pointer :: src_ptr integer :: k, l @@ -613,8 +649,18 @@ function find_module_dependency(sources,module_name) result(src_ptr) do l=1,size(sources(k)%modules_provided) if (module_name == sources(k)%modules_provided(l)%s) then - src_ptr => sources(k) - exit + select case(sources(k)%unit_scope) + case (FPM_SCOPE_LIB, FPM_SCOPE_DEP) + src_ptr => sources(k) + exit + case default + if (present(include_dir)) then + if (dirname(sources(k)%file_name) == include_dir) then + src_ptr => sources(k) + exit + end if + end if + end select end if end do diff --git a/fpm/test/fpm_test/main.f90 b/fpm/test/fpm_test/main.f90 index 6f20a3f..eb08a94 100644 --- a/fpm/test/fpm_test/main.f90 +++ b/fpm/test/fpm_test/main.f90 @@ -6,6 +6,7 @@ program fpm_testing use test_toml, only : collect_toml use test_manifest, only : collect_manifest use test_source_parsing, only : collect_source_parsing + use test_module_dependencies, only : collect_module_dependencies use test_versioning, only : collect_versioning implicit none integer :: stat, is @@ -19,6 +20,7 @@ program fpm_testing & new_testsuite("fpm_toml", collect_toml), & & new_testsuite("fpm_manifest", collect_manifest), & & new_testsuite("fpm_source_parsing", collect_source_parsing), & + & new_testsuite("fpm_module_dependencies", collect_module_dependencies), & & new_testsuite("fpm_versioning", collect_versioning) & & ] diff --git a/fpm/test/fpm_test/test_manifest.f90 b/fpm/test/fpm_test/test_manifest.f90 index d2dc891..575f255 100644 --- a/fpm/test/fpm_test/test_manifest.f90 +++ b/fpm/test/fpm_test/test_manifest.f90 @@ -1,5 +1,6 @@ !> Define tests for the `fpm_manifest` modules module test_manifest + use fpm_filesystem, only: get_temp_filename use testsuite, only : new_unittest, unittest_t, error_t, test_failed, & & check_string use fpm_manifest @@ -17,7 +18,7 @@ contains !> Collection of tests type(unittest_t), allocatable, intent(out) :: testsuite(:) - + testsuite = [ & & new_unittest("valid-manifest", test_valid_manifest), & & new_unittest("invalid-manifest", test_invalid_manifest, should_fail=.true.), & @@ -35,6 +36,9 @@ contains & new_unittest("executable-typeerror", test_executable_typeerror, should_fail=.true.), & & new_unittest("executable-noname", test_executable_noname, should_fail=.true.), & & new_unittest("executable-wrongkey", test_executable_wrongkey, should_fail=.true.), & + & new_unittest("build-config-valid", test_build_config_valid), & + & new_unittest("build-config-empty", test_build_config_empty), & + & new_unittest("build-config-invalid-values", test_build_config_invalid_values, should_fail=.true.), & & new_unittest("library-empty", test_library_empty), & & new_unittest("library-wrongkey", test_library_wrongkey, should_fail=.true.), & & new_unittest("package-simple", test_package_simple), & @@ -65,6 +69,9 @@ contains open(file=manifest, newunit=unit) write(unit, '(a)') & & 'name = "example"', & + & '[build]', & + & 'auto-executables = false', & + & 'auto-tests = false', & & '[dependencies.fpm]', & & 'git = "https://github.com/fortran-lang/fpm"', & & '[[executable]]', & @@ -446,6 +453,103 @@ contains end subroutine test_executable_wrongkey + !> Try to read values from the [build] table + subroutine test_build_config_valid(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_t) :: package + character(:), allocatable :: temp_file + integer :: unit + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'name = "example"', & + & '[build]', & + & 'auto-executables = false', & + & 'auto-tests = false' + close(unit) + + call get_package_data(package, temp_file, error) + + if (allocated(error)) return + + if (package%build_config%auto_executables) then + call test_failed(error, "Wong value of 'auto-executables' read, expecting .false.") + return + end if + + if (package%build_config%auto_tests) then + call test_failed(error, "Wong value of 'auto-tests' read, expecting .false.") + return + end if + + end subroutine test_build_config_valid + + + !> Try to read values from an empty [build] table + subroutine test_build_config_empty(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_t) :: package + character(:), allocatable :: temp_file + integer :: unit + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'name = "example"', & + & '[build]', & + & '[library]' + close(unit) + + call get_package_data(package, temp_file, error) + + if (allocated(error)) return + + if (.not.package%build_config%auto_executables) then + call test_failed(error, "Wong default value of 'auto-executables' read, expecting .true.") + return + end if + + if (.not.package%build_config%auto_tests) then + call test_failed(error, "Wong default value of 'auto-tests' read, expecting .true.") + return + end if + + end subroutine test_build_config_empty + + + !> Try to read values from a [build] table with invalid values + subroutine test_build_config_invalid_values(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(package_t) :: package + character(:), allocatable :: temp_file + integer :: unit + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'name = "example"', & + & '[build]', & + & 'auto-executables = "false"' + close(unit) + + call get_package_data(package, temp_file, error) + + end subroutine test_build_config_invalid_values + + !> Libraries can be created from empty tables subroutine test_library_empty(error) use fpm_manifest_library diff --git a/fpm/test/fpm_test/test_module_dependencies.f90 b/fpm/test/fpm_test/test_module_dependencies.f90 new file mode 100644 index 0000000..481dfb3 --- /dev/null +++ b/fpm/test/fpm_test/test_module_dependencies.f90 @@ -0,0 +1,363 @@ +!> Define tests for the `fpm_sources` module (module dependency checking) +module test_module_dependencies + use testsuite, only : new_unittest, unittest_t, error_t, test_failed + use fpm_sources, only: resolve_module_dependencies + use fpm_model, only: srcfile_t, srcfile_ptr, & + FPM_UNIT_UNKNOWN, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & + FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, & + FPM_UNIT_CHEADER, FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, & + FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST + use fpm_strings, only: string_t + implicit none + private + + public :: collect_module_dependencies + + interface operator(.in.) + module procedure srcfile_in + end interface + +contains + + + !> Collect all exported unit tests + subroutine collect_module_dependencies(testsuite) + + !> Collection of tests + type(unittest_t), allocatable, intent(out) :: testsuite(:) + + testsuite = [ & + & new_unittest("library-module-use", test_library_module_use), & + & new_unittest("program-module-use", test_program_module_use), & + & new_unittest("program-with-module", test_program_with_module), & + & new_unittest("program-own-module-use", test_program_own_module_use), & + & new_unittest("missing-library-use", & + test_missing_library_use, should_fail=.true.), & + & new_unittest("missing-program-use", & + test_missing_program_use, should_fail=.true.), & + & new_unittest("invalid-library-use", & + test_invalid_library_use, should_fail=.true.), & + & new_unittest("invalid-own-module-use", & + test_invalid_own_module_use, should_fail=.true.) & + ] + + end subroutine collect_module_dependencies + + + !> Check library module using another library module + subroutine test_library_module_use(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(srcfile_t) :: sources(2) + + sources(1) = new_test_module(file_name="src/my_mod_1.f90", & + scope = FPM_SCOPE_LIB, & + provides=[string_t('my_mod_1')]) + + sources(2) = new_test_module(file_name="src/my_mod_2.f90", & + scope = FPM_SCOPE_LIB, & + provides=[string_t('my_mod_2')], & + uses=[string_t('my_mod_1')]) + + call resolve_module_dependencies(sources,error) + + if (allocated(error)) then + return + end if + + if (size(sources(1)%file_dependencies)>0) then + call test_failed(error,'Incorrect number of file_dependencies - expecting zero') + return + end if + + if (size(sources(2)%file_dependencies) /= 1) then + call test_failed(error,'Incorrect number of file_dependencies - expecting one') + return + end if + + if (.not.(sources(1) .in. sources(2)%file_dependencies)) then + call test_failed(error,'Missing file in file_dependencies') + return + end if + + end subroutine test_library_module_use + + + !> Check program using a library module + subroutine test_program_module_use(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: i + type(srcfile_t) :: sources(3) + + sources(1) = new_test_module(file_name="src/my_mod_1.f90", & + scope = FPM_SCOPE_LIB, & + provides=[string_t('my_mod_1')]) + + sources(2) = new_test_program(file_name="app/my_program.f90", & + scope=FPM_SCOPE_APP, & + uses=[string_t('my_mod_1')]) + + sources(3) = new_test_program(file_name="test/my_test.f90", & + scope=FPM_SCOPE_TEST, & + uses=[string_t('my_mod_1')]) + + call resolve_module_dependencies(sources,error) + + if (allocated(error)) then + return + end if + + if (size(sources(1)%file_dependencies)>0) then + call test_failed(error,'Incorrect number of file_dependencies - expecting zero') + return + end if + + do i=2,3 + + if (size(sources(i)%file_dependencies) /= 1) then + call test_failed(error,'Incorrect number of file_dependencies - expecting one') + return + end if + + if (.not.(sources(1) .in. sources(i)%file_dependencies)) then + call test_failed(error,'Missing file in file_dependencies') + return + end if + + end do + + end subroutine test_program_module_use + + + !> Check program with module in single source file + !> (Resulting source object should not include itself as a file dependency) + subroutine test_program_with_module(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: i + type(srcfile_t) :: sources(1) + + sources(1) = new_test_module(file_name="app/my_program.f90", & + scope = FPM_SCOPE_APP, & + provides=[string_t('app_mod')], & + uses=[string_t('app_mod')]) + + call resolve_module_dependencies(sources,error) + + if (allocated(error)) then + return + end if + + if (size(sources(1)%file_dependencies)>0) then + call test_failed(error,'Incorrect number of file_dependencies - expecting zero') + return + end if + + end subroutine test_program_with_module + + + !> Check program using a module in same directory + subroutine test_program_own_module_use(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(srcfile_t) :: sources(2) + + sources(1) = new_test_module(file_name="app/app_mod.f90", & + scope = FPM_SCOPE_APP, & + provides=[string_t('app_mod')]) + + sources(2) = new_test_program(file_name="app/my_program.f90", & + scope=FPM_SCOPE_APP, & + uses=[string_t('app_mod')]) + + call resolve_module_dependencies(sources,error) + + if (allocated(error)) then + return + end if + + if (size(sources(1)%file_dependencies)>0) then + call test_failed(error,'Incorrect number of file_dependencies - expecting zero') + return + end if + + if (size(sources(2)%file_dependencies) /= 1) then + call test_failed(error,'Incorrect number of file_dependencies - expecting one') + return + end if + + if (.not.(sources(1) .in. sources(2)%file_dependencies)) then + call test_failed(error,'Missing file in file_dependencies') + return + end if + + end subroutine test_program_own_module_use + + + !> Check missing library module dependency + subroutine test_missing_library_use(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(srcfile_t) :: sources(2) + + sources(1) = new_test_module(file_name="src/my_mod_1.f90", & + scope = FPM_SCOPE_LIB, & + provides=[string_t('my_mod_1')]) + + sources(2) = new_test_module(file_name="src/my_mod_2.f90", & + scope = FPM_SCOPE_LIB, & + provides=[string_t('my_mod_2')], & + uses=[string_t('my_mod_3')]) + + call resolve_module_dependencies(sources,error) + + end subroutine test_missing_library_use + + + !> Check missing program module dependency + subroutine test_missing_program_use(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(srcfile_t) :: sources(2) + + sources(1) = new_test_module(file_name="src/my_mod_1.f90", & + scope = FPM_SCOPE_LIB, & + provides=[string_t('my_mod_1')]) + + sources(2) = new_test_program(file_name="app/my_program.f90", & + scope=FPM_SCOPE_APP, & + uses=[string_t('my_mod_2')]) + + call resolve_module_dependencies(sources,error) + + end subroutine test_missing_program_use + + + !> Check library module using a non-library module + subroutine test_invalid_library_use(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(srcfile_t) :: sources(2) + + sources(1) = new_test_module(file_name="app/app_mod.f90", & + scope = FPM_SCOPE_APP, & + provides=[string_t('app_mod')]) + + sources(2) = new_test_module(file_name="src/my_mod.f90", & + scope = FPM_SCOPE_LIB, & + provides=[string_t('my_mod')], & + uses=[string_t('app_mod')]) + + call resolve_module_dependencies(sources,error) + + end subroutine test_invalid_library_use + + + !> Check program using a non-library module in a different directory + subroutine test_invalid_own_module_use(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(srcfile_t) :: sources(2) + + sources(1) = new_test_module(file_name="app/subdir/app_mod.f90", & + scope = FPM_SCOPE_APP, & + provides=[string_t('app_mod')]) + + sources(2) = new_test_program(file_name="app/my_program.f90", & + scope=FPM_SCOPE_APP, & + uses=[string_t('app_mod')]) + + call resolve_module_dependencies(sources,error) + + end subroutine test_invalid_own_module_use + + + !> Helper to create a new srcfile_t for a module + function new_test_module(file_name, scope, uses, provides) result(src) + character(*), intent(in) :: file_name + integer, intent(in) :: scope + type(string_t), intent(in), optional :: uses(:) + type(string_t), intent(in), optional :: provides(:) + type(srcfile_t) :: src + + src%file_name = file_name + src%unit_scope = scope + src%unit_type = FPM_UNIT_MODULE + + if (present(provides)) then + src%modules_provided = provides + else + allocate(src%modules_provided(0)) + end if + + if (present(uses)) then + src%modules_used = uses + else + allocate(src%modules_used(0)) + end if + + allocate(src%include_dependencies(0)) + + end function new_test_module + + + !> Helper to create a new srcfile_t for a program + function new_test_program(file_name, scope, uses) result(src) + character(*), intent(in) :: file_name + integer, intent(in) :: scope + type(string_t), intent(in), optional :: uses(:) + type(srcfile_t) :: src + + src%file_name = file_name + src%unit_scope = scope + src%unit_type = FPM_UNIT_PROGRAM + + if (present(uses)) then + src%modules_used = uses + else + allocate(src%modules_used(0)) + end if + + allocate(src%modules_provided(0)) + allocate(src%include_dependencies(0)) + + end function new_test_program + + + !> Helper to check if a srcfile is in a list of srcfile_ptr + logical function srcfile_in(needle,haystack) + type(srcfile_t), intent(in), target :: needle + type(srcfile_ptr), intent(in) :: haystack(:) + + integer :: i + + srcfile_in = .false. + do i=1,size(haystack) + + if (associated(haystack(i)%ptr,needle)) then + srcfile_in = .true. + return + end if + + end do + + end function srcfile_in + +end module test_module_dependencies diff --git a/test/example_packages/README.md b/test/example_packages/README.md index 06de927..79fadb1 100644 --- a/test/example_packages/README.md +++ b/test/example_packages/README.md @@ -6,9 +6,11 @@ the features demonstrated in each package and which versions of fpm are supporte | Name | Features | Bootstrap (Haskell) fpm | fpm | |---------------------|---------------------------------------------------------------|:-----------------------:|:---:| +| auto_discovery_off | Default layout with auto-discovery disabled | N | Y | | 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_complex_2 | Auto-discovery of tests and executables with modules | N | 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 | diff --git a/test/example_packages/auto_discovery_off/app/main.f90 b/test/example_packages/auto_discovery_off/app/main.f90 new file mode 100644 index 0000000..8902dc6 --- /dev/null +++ b/test/example_packages/auto_discovery_off/app/main.f90 @@ -0,0 +1,6 @@ +program main +implicit none + +print *, "This program should run." + +end program main diff --git a/test/example_packages/auto_discovery_off/app/unused.f90 b/test/example_packages/auto_discovery_off/app/unused.f90 new file mode 100644 index 0000000..57d8153 --- /dev/null +++ b/test/example_packages/auto_discovery_off/app/unused.f90 @@ -0,0 +1,6 @@ +program unused +implicit none + +print *, "This program should NOT run." + +end program unused diff --git a/test/example_packages/auto_discovery_off/fpm.toml b/test/example_packages/auto_discovery_off/fpm.toml new file mode 100644 index 0000000..9a852df --- /dev/null +++ b/test/example_packages/auto_discovery_off/fpm.toml @@ -0,0 +1,12 @@ +name = "auto_discovery_off" + +[build] +auto-executables = false +auto-tests = false + + +[[test]] +name = "my_test" +source-dir="test" +main="my_test.f90" + diff --git a/test/example_packages/auto_discovery_off/test/my_test.f90 b/test/example_packages/auto_discovery_off/test/my_test.f90 new file mode 100644 index 0000000..fd59f9f --- /dev/null +++ b/test/example_packages/auto_discovery_off/test/my_test.f90 @@ -0,0 +1,6 @@ +program my_test +implicit none + +print *, "Test passed! That was easy!" + +end program my_test diff --git a/test/example_packages/auto_discovery_off/test/unused_test.f90 b/test/example_packages/auto_discovery_off/test/unused_test.f90 new file mode 100644 index 0000000..5c42611 --- /dev/null +++ b/test/example_packages/auto_discovery_off/test/unused_test.f90 @@ -0,0 +1,7 @@ +program unused_test +implicit none + +print *, "This program should NOT run." + +end program unused_test + diff --git a/test/example_packages/hello_complex_2/.gitignore b/test/example_packages/hello_complex_2/.gitignore new file mode 100644 index 0000000..a007fea --- /dev/null +++ b/test/example_packages/hello_complex_2/.gitignore @@ -0,0 +1 @@ +build/* diff --git a/test/example_packages/hello_complex_2/app/app_mod.f90 b/test/example_packages/hello_complex_2/app/app_mod.f90 new file mode 100644 index 0000000..d69a228 --- /dev/null +++ b/test/example_packages/hello_complex_2/app/app_mod.f90 @@ -0,0 +1,5 @@ +module app_mod +implicit none + + +end module app_mod diff --git a/test/example_packages/hello_complex_2/app/say_goodbye.f90 b/test/example_packages/hello_complex_2/app/say_goodbye.f90 new file mode 100644 index 0000000..db12cbf --- /dev/null +++ b/test/example_packages/hello_complex_2/app/say_goodbye.f90 @@ -0,0 +1,8 @@ +program say_goodbye + use farewell_m, only: make_farewell + use app_mod + + implicit none + + print *, make_farewell("World") +end program say_goodbye diff --git a/test/example_packages/hello_complex_2/app/say_hello/app_hello_mod.f90 b/test/example_packages/hello_complex_2/app/say_hello/app_hello_mod.f90 new file mode 100644 index 0000000..5c426c8 --- /dev/null +++ b/test/example_packages/hello_complex_2/app/say_hello/app_hello_mod.f90 @@ -0,0 +1,4 @@ +module app_hello_mod +implicit none + +end module app_hello_mod diff --git a/test/example_packages/hello_complex_2/app/say_hello/say_Hello.f90 b/test/example_packages/hello_complex_2/app/say_hello/say_Hello.f90 new file mode 100644 index 0000000..3b69ba7 --- /dev/null +++ b/test/example_packages/hello_complex_2/app/say_hello/say_Hello.f90 @@ -0,0 +1,8 @@ +program say_Hello + use greet_m, only: make_greeting + use app_hello_mod + + implicit none + + print *, make_greeting("World") +end program say_Hello diff --git a/test/example_packages/hello_complex_2/fpm.toml b/test/example_packages/hello_complex_2/fpm.toml new file mode 100644 index 0000000..28c91d8 --- /dev/null +++ b/test/example_packages/hello_complex_2/fpm.toml @@ -0,0 +1,6 @@ +name = "hello_complex" + +[[executable]] +name="say_hello_world" +source-dir="app/say_hello" +main="say_Hello.f90" diff --git a/test/example_packages/hello_complex_2/src/farewell_m.f90 b/test/example_packages/hello_complex_2/src/farewell_m.f90 new file mode 100644 index 0000000..9fc75b9 --- /dev/null +++ b/test/example_packages/hello_complex_2/src/farewell_m.f90 @@ -0,0 +1,13 @@ +module farewell_m + implicit none + private + + public :: make_farewell +contains + function make_farewell(name) result(greeting) + character(len=*), intent(in) :: name + character(len=:), allocatable :: greeting + + greeting = "Goodbye, " // name // "!" + end function make_farewell +end module farewell_m diff --git a/test/example_packages/hello_complex_2/src/greet_m.f90 b/test/example_packages/hello_complex_2/src/greet_m.f90 new file mode 100644 index 0000000..2372f9a --- /dev/null +++ b/test/example_packages/hello_complex_2/src/greet_m.f90 @@ -0,0 +1,13 @@ +module greet_m + implicit none + private + + public :: make_greeting +contains + function make_greeting(name) result(greeting) + character(len=*), intent(in) :: name + character(len=:), allocatable :: greeting + + greeting = "Hello, " // name // "!" + end function make_greeting +end module greet_m diff --git a/test/example_packages/hello_complex_2/test/farewell_test.f90 b/test/example_packages/hello_complex_2/test/farewell_test.f90 new file mode 100644 index 0000000..dbe98d6 --- /dev/null +++ b/test/example_packages/hello_complex_2/test/farewell_test.f90 @@ -0,0 +1,19 @@ +program farewell_test + use farewell_m, only: make_farewell + use test_mod + use iso_fortran_env, only: error_unit, output_unit + + implicit none + + character(len=:), allocatable :: farewell + + allocate(character(len=0) :: farewell) + farewell = make_farewell("World") + + if (farewell == "Goodbye, World!") then + write(output_unit, *) "Passed" + else + write(error_unit, *) "Failed" + call exit(1) + end if +end program farewell_test diff --git a/test/example_packages/hello_complex_2/test/greet_test.f90 b/test/example_packages/hello_complex_2/test/greet_test.f90 new file mode 100644 index 0000000..38e9be0 --- /dev/null +++ b/test/example_packages/hello_complex_2/test/greet_test.f90 @@ -0,0 +1,19 @@ +program greet_test + use greet_m, only: make_greeting + use test_mod + 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/test/example_packages/hello_complex_2/test/test_mod.f90 b/test/example_packages/hello_complex_2/test/test_mod.f90 new file mode 100644 index 0000000..edb2626 --- /dev/null +++ b/test/example_packages/hello_complex_2/test/test_mod.f90 @@ -0,0 +1,5 @@ +module test_mod +implicit none + + +end module test_mod |