From 3f6c74ff3a9f009246634b860a5805be475749e2 Mon Sep 17 00:00:00 2001 From: LKedward Date: Sun, 27 Sep 2020 11:41:36 +0100 Subject: Update: to enable local path dependencies Adds recursive source discovery for local path dependencies --- fpm/src/fpm.f90 | 107 ++++++++++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 96 insertions(+), 11 deletions(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 7c99b13..7ace32c 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -1,6 +1,5 @@ module fpm - -use fpm_strings, only: string_t, str_ends_with +use fpm_strings, only: string_t, str_ends_with, operator(.in.) 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 @@ -14,7 +13,7 @@ use fpm_sources, only: add_executable_sources, add_sources_from_dir, & resolve_module_dependencies use fpm_manifest, only : get_package_data, default_executable, & default_library, package_t -use fpm_error, only : error_t +use fpm_error, only : error_t, fatal_error use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, & & stdout=>output_unit, & & stderr=>error_unit @@ -25,6 +24,90 @@ public :: cmd_build, cmd_install, cmd_new, cmd_run, cmd_test contains + +recursive subroutine add_libsources_from_package(sources,package_list,package,package_root,error) + ! Discover library sources in a package, recursively including dependencies + ! Only supports local path dependencies currently + ! + type(srcfile_t), allocatable, intent(inout), target :: sources(:) + type(string_t), allocatable, intent(inout) :: package_list(:) + type(package_t), intent(in) :: package + character(*), intent(in) :: package_root + type(error_t), allocatable, intent(out) :: error + + integer :: i + type(string_t) :: dep_name + type(package_t) :: dependency + + ! Add package library sources + if (allocated(package%library)) then + + call add_sources_from_dir(sources, join_path(package_root,package%library%source_dir), & + FPM_SCOPE_LIB, error=error) + + if (allocated(error)) then + return + end if + + end if + + ! Add library sources from dependencies + if (allocated(package%dependency)) then + + do i=1,size(package%dependency) + + if (allocated(package%dependency(i)%git)) then + + call fatal_error(error,'Remote dependencies not implemented') + return + + end if + + if (allocated(package%dependency(i)%path)) then + + call get_package_data(dependency, & + join_path(package%dependency(i)%path,"fpm.toml"), error) + + if (allocated(error)) then + error%message = 'Error while parsing manifest for dependency package at:'//& + new_line('a')//join_path(package%dependency(i)%path,"fpm.toml")//& + new_line('a')//error%message + return + end if + + if (dependency%name .in. package_list) then + cycle + end if + + if (.not.allocated(dependency%library) .and. & + exists(join_path(package_root,package%dependency(i)%path,"src"))) then + allocate(dependency%library) + dependency%library%source_dir = "src" + end if + + + call add_libsources_from_package(sources,package_list,dependency, & + package_root=join_path(package_root,package%dependency(i)%path), error=error) + + if (allocated(error)) then + error%message = 'Error while processing sources for dependency package "'//& + new_line('a')//dependency%name//'"'//& + new_line('a')//error%message + return + end if + + dep_name%s = dependency%name + package_list = [package_list, dep_name] + + end if + + end do + + end if + +end subroutine add_libsources_from_package + + subroutine build_model(model, settings, package, error) ! Constructs a valid fpm model from command line settings and toml manifest ! @@ -33,8 +116,13 @@ subroutine build_model(model, settings, package, error) type(package_t), intent(in) :: package type(error_t), allocatable, intent(out) :: error + type(string_t), allocatable :: package_list(:) + model%package_name = package%name + allocate(package_list(1)) + package_list(1)%s = package%name + ! #TODO: Choose flags and output directory based on cli settings & manifest inputs model%fortran_compiler = 'gfortran' @@ -94,14 +182,11 @@ 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, & - FPM_SCOPE_LIB, error=error) - - if (allocated(error)) then - return - end if - + ! Add library sources, including local dependencies + call add_libsources_from_package(model%sources,package_list,package, & + package_root='.',error=error) + if (allocated(error)) then + return end if call resolve_module_dependencies(model%sources,error) -- cgit v1.2.3 From d9dc4b4fc47182d60f9e18eda36478b9ca8f75fb Mon Sep 17 00:00:00 2001 From: LKedward Date: Sun, 27 Sep 2020 11:43:10 +0100 Subject: Enable fpm CI tests for local path dependency demos --- ci/run_tests.bat | 18 ++++++++++++++++++ ci/run_tests.sh | 7 +++++++ test/example_packages/README.md | 4 ++-- 3 files changed, 27 insertions(+), 2 deletions(-) diff --git a/ci/run_tests.bat b/ci/run_tests.bat index ce79618..9c61d75 100755 --- a/ci/run_tests.bat +++ b/ci/run_tests.bat @@ -15,6 +15,7 @@ if errorlevel 1 exit 1 build\gfortran_debug\app\fpm if errorlevel 1 exit 1 + cd ..\test\example_packages\hello_world if errorlevel 1 exit 1 @@ -25,6 +26,23 @@ if errorlevel 1 exit 1 if errorlevel 1 exit 1 +cd ..\hello_fpm +if errorlevel 1 exit 1 + +..\..\..\fpm\build\gfortran_debug\app\fpm build +if errorlevel 1 exit 1 + +.\build\gfortran_debug\app\hello_fpm +if errorlevel 1 exit 1 + + +cd ..\circular_test +if errorlevel 1 exit 1 + +..\..\..\fpm\build\gfortran_debug\app\fpm build +if errorlevel 1 exit 1 + + cd ..\hello_complex if errorlevel 1 exit 1 diff --git a/ci/run_tests.sh b/ci/run_tests.sh index ee46cac..8c7339f 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -12,6 +12,13 @@ cd ../test/example_packages/hello_world ../../../fpm/build/gfortran_debug/app/fpm build ./build/gfortran_debug/app/hello_world +cd ../hello_fpm +../../../fpm/build/gfortran_debug/app/fpm build +./build/gfortran_debug/app/hello_fpm + +cd ../circular_test +../../../fpm/build/gfortran_debug/app/fpm build + cd ../hello_complex ../../../fpm/build/gfortran_debug/app/fpm build ./build/gfortran_debug/app/say_Hello diff --git a/test/example_packages/README.md b/test/example_packages/README.md index fd02f0d..95dad31 100644 --- a/test/example_packages/README.md +++ b/test/example_packages/README.md @@ -7,10 +7,10 @@ the features demonstrated in each package and which versions of fpm are supporte | Name | Features | Bootstrap (Haskell) fpm | fpm | |---------------------|---------------------------------------------------------------|:-----------------------:|:---:| | circular_example | Local path dependency; circular dependency | Y | N | -| circular_test | Local path dependency; circular dependency | Y | N | +| circular_test | Local path dependency; circular dependency | Y | Y | | 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_fpm | App-only; local path dependency | Y | Y | | 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 | -- cgit v1.2.3 From c6a96464ebed9b8363b3d5571fdc9da5c90fe9ca Mon Sep 17 00:00:00 2001 From: LKedward Date: Sun, 27 Sep 2020 12:12:27 +0100 Subject: Add: support for local dev-depenencies Currently always built. --- fpm/src/fpm.f90 | 66 ++++++++++++++++++++++++++++++++++++++++----------------- 1 file changed, 47 insertions(+), 19 deletions(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 7ace32c..4b2d515 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -17,6 +17,7 @@ use fpm_error, only : error_t, fatal_error use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, & & stdout=>output_unit, & & stderr=>error_unit +use fpm_manifest_dependency, only: dependency_t implicit none private public :: cmd_build, cmd_install, cmd_new, cmd_run, cmd_test @@ -25,7 +26,8 @@ public :: cmd_build, cmd_install, cmd_new, cmd_run, cmd_test contains -recursive subroutine add_libsources_from_package(sources,package_list,package,package_root,error) +recursive subroutine add_libsources_from_package(sources,package_list,package, & + package_root,dev_depends,error) ! Discover library sources in a package, recursively including dependencies ! Only supports local path dependencies currently ! @@ -33,12 +35,9 @@ recursive subroutine add_libsources_from_package(sources,package_list,package,pa type(string_t), allocatable, intent(inout) :: package_list(:) type(package_t), intent(in) :: package character(*), intent(in) :: package_root + logical, intent(in) :: dev_depends type(error_t), allocatable, intent(out) :: error - integer :: i - type(string_t) :: dep_name - type(package_t) :: dependency - ! Add package library sources if (allocated(package%library)) then @@ -54,40 +53,69 @@ recursive subroutine add_libsources_from_package(sources,package_list,package,pa ! Add library sources from dependencies if (allocated(package%dependency)) then - do i=1,size(package%dependency) + call add_local_dependencies(package%dependency) + + if (allocated(error)) then + return + end if + + end if + + ! Add library sources from dev-dependencies + if (dev_depends .and. allocated(package%dev_dependency)) then + + call add_local_dependencies(package%dev_dependency) + + if (allocated(error)) then + return + end if + + end if + + contains + + subroutine add_local_dependencies(dependency_list) + type(dependency_t) :: dependency_list(:) + + integer :: i + type(string_t) :: dep_name + type(package_t) :: dependency + + do i=1,size(dependency_list) - if (allocated(package%dependency(i)%git)) then + if (dependency_list(i)%name .in. package_list) then + cycle + end if + + if (allocated(dependency_list(i)%git)) then call fatal_error(error,'Remote dependencies not implemented') return end if - if (allocated(package%dependency(i)%path)) then + if (allocated(dependency_list(i)%path)) then call get_package_data(dependency, & - join_path(package%dependency(i)%path,"fpm.toml"), error) + join_path(dependency_list(i)%path,"fpm.toml"), error) if (allocated(error)) then error%message = 'Error while parsing manifest for dependency package at:'//& - new_line('a')//join_path(package%dependency(i)%path,"fpm.toml")//& + new_line('a')//join_path(dependency_list(i)%path,"fpm.toml")//& new_line('a')//error%message return end if - if (dependency%name .in. package_list) then - cycle - end if - if (.not.allocated(dependency%library) .and. & - exists(join_path(package_root,package%dependency(i)%path,"src"))) then + exists(join_path(package_root,dependency_list(i)%path,"src"))) then allocate(dependency%library) dependency%library%source_dir = "src" end if call add_libsources_from_package(sources,package_list,dependency, & - package_root=join_path(package_root,package%dependency(i)%path), error=error) + package_root=join_path(package_root,dependency_list(i)%path), & + dev_depends=dev_depends, error=error) if (allocated(error)) then error%message = 'Error while processing sources for dependency package "'//& @@ -96,14 +124,14 @@ recursive subroutine add_libsources_from_package(sources,package_list,package,pa return end if - dep_name%s = dependency%name + dep_name%s = dependency_list(i)%name package_list = [package_list, dep_name] end if end do - end if + end subroutine add_local_dependencies end subroutine add_libsources_from_package @@ -184,7 +212,7 @@ subroutine build_model(model, settings, package, error) ! Add library sources, including local dependencies call add_libsources_from_package(model%sources,package_list,package, & - package_root='.',error=error) + package_root='.',dev_depends=.true.,error=error) if (allocated(error)) then return end if -- cgit v1.2.3 From 6f8a4466edde51653439f03a34e6fab6f2ff2071 Mon Sep 17 00:00:00 2001 From: LKedward Date: Sun, 27 Sep 2020 12:14:04 +0100 Subject: Add: circular_example demo to fpm CI scripts Now supported with local dev-dependencies --- ci/run_tests.bat | 7 +++++++ ci/run_tests.sh | 3 +++ test/example_packages/README.md | 2 +- 3 files changed, 11 insertions(+), 1 deletion(-) diff --git a/ci/run_tests.bat b/ci/run_tests.bat index 9c61d75..745f14f 100755 --- a/ci/run_tests.bat +++ b/ci/run_tests.bat @@ -43,6 +43,13 @@ if errorlevel 1 exit 1 if errorlevel 1 exit 1 +cd ..\circular_example +if errorlevel 1 exit 1 + +..\..\..\fpm\build\gfortran_debug\app\fpm build +if errorlevel 1 exit 1 + + cd ..\hello_complex if errorlevel 1 exit 1 diff --git a/ci/run_tests.sh b/ci/run_tests.sh index 8c7339f..6937c6b 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -19,6 +19,9 @@ cd ../hello_fpm cd ../circular_test ../../../fpm/build/gfortran_debug/app/fpm build +cd ../circular_example +../../../fpm/build/gfortran_debug/app/fpm build + cd ../hello_complex ../../../fpm/build/gfortran_debug/app/fpm build ./build/gfortran_debug/app/say_Hello diff --git a/test/example_packages/README.md b/test/example_packages/README.md index 95dad31..ee2a908 100644 --- a/test/example_packages/README.md +++ b/test/example_packages/README.md @@ -6,7 +6,7 @@ the features demonstrated in each package and which versions of fpm are supporte | Name | Features | Bootstrap (Haskell) fpm | fpm | |---------------------|---------------------------------------------------------------|:-----------------------:|:---:| -| circular_example | Local path dependency; circular dependency | Y | N | +| circular_example | Local path dependency; circular dependency | Y | Y | | circular_test | Local path dependency; circular dependency | Y | Y | | 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 | -- cgit v1.2.3 From 72dab19de88c2d31deccad2e6f988fb85e614190 Mon Sep 17 00:00:00 2001 From: LKedward Date: Sun, 27 Sep 2020 12:22:03 +0100 Subject: Minor fix: to local dependency relative path Local dependency paths are relative to the dependent package not the building package. --- fpm/src/fpm.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 4b2d515..887ba22 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -69,7 +69,7 @@ recursive subroutine add_libsources_from_package(sources,package_list,package, & if (allocated(error)) then return end if - + end if contains @@ -97,11 +97,11 @@ recursive subroutine add_libsources_from_package(sources,package_list,package, & if (allocated(dependency_list(i)%path)) then call get_package_data(dependency, & - join_path(dependency_list(i)%path,"fpm.toml"), error) + join_path(package_root,dependency_list(i)%path,"fpm.toml"), error) if (allocated(error)) then error%message = 'Error while parsing manifest for dependency package at:'//& - new_line('a')//join_path(dependency_list(i)%path,"fpm.toml")//& + new_line('a')//join_path(package_root,dependency_list(i)%path,"fpm.toml")//& new_line('a')//error%message return end if -- cgit v1.2.3 From 64a0f72db4080c2ca18e8ba7bbad5825c02ab079 Mon Sep 17 00:00:00 2001 From: LKedward Date: Sun, 27 Sep 2020 13:07:21 +0100 Subject: Retain source file structure in object files --- fpm/src/fpm_backend.f90 | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) diff --git a/fpm/src/fpm_backend.f90 b/fpm/src/fpm_backend.f90 index 40460d7..d7005bf 100644 --- a/fpm/src/fpm_backend.f90 +++ b/fpm/src/fpm_backend.f90 @@ -3,7 +3,7 @@ module fpm_backend ! Implements the native fpm build backend use fpm_environment, only: run, get_os_type, OS_WINDOWS -use fpm_filesystem, only: basename, join_path, exists, mkdir +use fpm_filesystem, only: basename, dirname, 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, & @@ -113,6 +113,10 @@ recursive subroutine build_source(model,source_file,linking) object_file = get_object_name(model,source_file%file_name) + if (.not.exists(dirname(object_file))) then + call mkdir(dirname(object_file)) + end if + call run("gfortran -c " // source_file%file_name // model%fortran_compile_flags & // " -o " // object_file) linking = linking // " " // object_file @@ -145,13 +149,6 @@ function get_object_name(model,source_file_name) result(object_file) ! 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') -- cgit v1.2.3 From 1fb2c203652f2ce5677efda392c24a338889a202 Mon Sep 17 00:00:00 2001 From: LKedward Date: Sat, 3 Oct 2020 12:35:59 +0100 Subject: Update: hello_complex_2 to expose link bug There's a bug which causes app-local modules to be added twice if auto-discovery is on and the app is specified in the manifest. This causes the module to be compiled and linked twice. Not detected before because the module contained no symbols. This commit adds an integer symbol to an app-local module to test this bug. --- test/example_packages/hello_complex_2/app/say_hello/app_hello_mod.f90 | 2 ++ 1 file changed, 2 insertions(+) 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 index 5c426c8..c5795cb 100644 --- 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 @@ -1,4 +1,6 @@ module app_hello_mod implicit none +integer :: hello_int = 42 + end module app_hello_mod -- cgit v1.2.3 From 4ef3025845b54b81d3ac5644899f42cb84dd95c8 Mon Sep 17 00:00:00 2001 From: LKedward Date: Sat, 3 Oct 2020 12:42:50 +0100 Subject: Fix: duplication of app modules --- fpm/src/fpm_sources.f90 | 105 ++++++++++++++++++++++++++---------------------- 1 file changed, 57 insertions(+), 48 deletions(-) diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index f798276..dc9f5f9 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -6,7 +6,7 @@ use fpm_model, only: srcfile_ptr, srcfile_t, fpm_model_t, & 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_filesystem, only: basename, canon_path, dirname, join_path, 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 @@ -24,6 +24,33 @@ character(15), parameter :: INTRINSIC_MODULE_NAMES(*) = & contains +function parse_source(source_file_path,error) result(source) + character(*), intent(in) :: source_file_path + type(error_t), allocatable, intent(out) :: error + type(srcfile_t) :: source + + if (str_ends_with(lower(source_file_path), ".f90")) then + + source = parse_f_source(source_file_path, error) + + if (source%unit_type == FPM_UNIT_PROGRAM) then + source%exe_name = basename(source_file_path,suffix=.false.) + end if + + else if (str_ends_with(lower(source_file_path), ".c") .or. & + str_ends_with(lower(source_file_path), ".h")) then + + source = parse_c_source(source_file_path,error) + + end if + + if (allocated(error)) then + return + end if + +end function parse_source + + subroutine add_sources_from_dir(sources,directory,scope,with_executables,error) ! Enumerate sources in a directory ! @@ -33,7 +60,7 @@ subroutine add_sources_from_dir(sources,directory,scope,with_executables,error) logical, intent(in), optional :: with_executables type(error_t), allocatable, intent(out) :: error - integer :: i, j + integer :: i logical, allocatable :: is_source(:), exclude_source(:) type(string_t), allocatable :: file_names(:) type(string_t), allocatable :: src_file_names(:) @@ -63,26 +90,8 @@ subroutine add_sources_from_dir(sources,directory,scope,with_executables,error) do i = 1, size(src_file_names) - if (str_ends_with(lower(src_file_names(i)%s), ".f90")) then - - dir_sources(i) = parse_f_source(src_file_names(i)%s, error) - - if (allocated(error)) then - return - end if - - end if - - if (str_ends_with(lower(src_file_names(i)%s), ".c") .or. & - str_ends_with(lower(src_file_names(i)%s), ".h")) then - - dir_sources(i) = parse_c_source(src_file_names(i)%s,error) - - if (allocated(error)) then - return - end if - - end if + dir_sources(i) = parse_source(src_file_names(i)%s,error) + if (allocated(error)) return dir_sources(i)%unit_scope = scope @@ -93,7 +102,6 @@ subroutine add_sources_from_dir(sources,directory,scope,with_executables,error) if (with_executables) then exclude_source(i) = .false. - dir_sources(i)%exe_name = basename(src_file_names(i)%s,suffix=.false.) end if end if @@ -122,49 +130,50 @@ subroutine add_executable_sources(sources,executables,scope,auto_discover,error) integer :: i, j type(string_t), allocatable :: exe_dirs(:) - logical, allocatable :: include_source(:) - type(srcfile_t), allocatable :: dir_sources(:) + type(srcfile_t) :: exe_source 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, & - scope, with_executables=.true.,error=error) + call add_sources_from_dir(sources,exe_dirs(i)%s, & + scope, with_executables=auto_discover,error=error) if (allocated(error)) then return end if end do - allocate(include_source(size(dir_sources))) + exe_loop: do i=1,size(executables) - do i = 1, size(dir_sources) - - ! 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) + ! Check if executable already discovered automatically + ! and apply any overrides + do j=1,size(sources) - 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 + if (basename(sources(j)%file_name,suffix=.true.) == executables(i)%main .and.& + canon_path(dirname(sources(j)%file_name)) == & + canon_path(executables(i)%source_dir) ) then - include_source(i) = .true. - dir_sources(i)%exe_name = executables(j)%name - exit + sources(j)%exe_name = executables(i)%name + cycle exe_loop end if + end do - end do + ! Add if not already discovered (auto_discovery off) + exe_source = parse_source(join_path(executables(i)%source_dir,executables(i)%main),error) + exe_source%exe_name = executables(i)%name + exe_source%unit_scope = scope + + if (allocated(error)) return - if (.not.allocated(sources)) then - sources = pack(dir_sources,include_source) - else - sources = [sources, pack(dir_sources,include_source)] - end if + if (.not.allocated(sources)) then + sources = [exe_source] + else + sources = [sources, exe_source] + end if + + end do exe_loop end subroutine add_executable_sources -- cgit v1.2.3 From 48dd8bcc11e9fc3aaecc3088dd093664a58e40be Mon Sep 17 00:00:00 2001 From: LKedward Date: Sat, 3 Oct 2020 12:49:30 +0100 Subject: Update: source parsing test - include statement Demonstrates bug in include statement parsing - currently erroneously parsing all statements that begin with 'include'. --- fpm/test/fpm_test/test_source_parsing.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/fpm/test/fpm_test/test_source_parsing.f90 b/fpm/test/fpm_test/test_source_parsing.f90 index 0b92bef..a8bbc09 100644 --- a/fpm/test/fpm_test/test_source_parsing.f90 +++ b/fpm/test/fpm_test/test_source_parsing.f90 @@ -199,6 +199,8 @@ contains & 'program test', & & ' implicit none', & & ' include "included_file.f90"', & + & ' logical :: include_comments', & + & ' include_comments = .false.', & & ' contains ', & & ' include "second_include.f90"', & & 'end program test' -- cgit v1.2.3 From bdaac5c9739468e207bf5ffd0f7b8471b6d5975d Mon Sep 17 00:00:00 2001 From: LKedward Date: Sat, 3 Oct 2020 12:55:08 +0100 Subject: Fix: include statement parsing Include statements must have a single or double quote immediately following 'include' --- fpm/src/fpm_sources.f90 | 29 +++++++++++++++++------------ fpm/test/fpm_test/test_source_parsing.f90 | 8 ++++---- 2 files changed, 21 insertions(+), 16 deletions(-) diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index dc9f5f9..e654b03 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -300,21 +300,26 @@ function parse_f_source(f_filename,error) result(f_source) end if ! Process 'INCLUDE' statements - if (index(adjustl(lower(file_lines(i)%s)),'include') == 1) then - - n_include = n_include + 1 + ic = index(adjustl(lower(file_lines(i)%s)),'include') + if ( ic == 1 ) then + ic = index(lower(file_lines(i)%s),'include') + if (index(adjustl(file_lines(i)%s(ic+7:)),'"') == 1 .or. & + index(adjustl(file_lines(i)%s(ic+7:)),"'") == 1 ) then - if (pass == 2) then - f_source%include_dependencies(n_include)%s = & - & split_n(file_lines(i)%s,n=2,delims="'"//'"',stat=stat) - if (stat /= 0) then - call file_parse_error(error,f_filename, & - 'unable to find include file name',i, & - file_lines(i)%s) - return + + n_include = n_include + 1 + + if (pass == 2) then + f_source%include_dependencies(n_include)%s = & + & split_n(file_lines(i)%s,n=2,delims="'"//'"',stat=stat) + if (stat /= 0) then + call file_parse_error(error,f_filename, & + 'unable to find include file name',i, & + file_lines(i)%s) + return + end if end if end if - end if ! Extract name of module if is module diff --git a/fpm/test/fpm_test/test_source_parsing.f90 b/fpm/test/fpm_test/test_source_parsing.f90 index a8bbc09..d1d3e12 100644 --- a/fpm/test/fpm_test/test_source_parsing.f90 +++ b/fpm/test/fpm_test/test_source_parsing.f90 @@ -198,11 +198,11 @@ contains write(unit, '(a)') & & 'program test', & & ' implicit none', & - & ' include "included_file.f90"', & - & ' logical :: include_comments', & - & ' include_comments = .false.', & + & ' include "included_file.f90"', & + & ' character(*) :: include_comments', & + & ' include_comments = "some comments"', & & ' contains ', & - & ' include "second_include.f90"', & + & ' include"second_include.f90"', & & 'end program test' close(unit) -- cgit v1.2.3 From 22ea5a657049e927c8361cf1d26cbe03227c6c58 Mon Sep 17 00:00:00 2001 From: LKedward Date: Sat, 3 Oct 2020 13:33:14 +0100 Subject: Add: support for remote git dependencies --- fpm/src/fpm.f90 | 76 +++++++++++++++++++++++++++++------------------------ fpm/src/fpm/git.f90 | 43 ++++++++++++++++++++++++++++++ 2 files changed, 84 insertions(+), 35 deletions(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 1c5275a..55b2baa 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -53,7 +53,7 @@ recursive subroutine add_libsources_from_package(sources,package_list,package, & ! Add library sources from dependencies if (allocated(package%dependency)) then - call add_local_dependencies(package%dependency) + call add_dependencies(package%dependency) if (allocated(error)) then return @@ -64,7 +64,7 @@ recursive subroutine add_libsources_from_package(sources,package_list,package, & ! Add library sources from dev-dependencies if (dev_depends .and. allocated(package%dev_dependency)) then - call add_local_dependencies(package%dev_dependency) + call add_dependencies(package%dev_dependency) if (allocated(error)) then return @@ -74,13 +74,15 @@ recursive subroutine add_libsources_from_package(sources,package_list,package, & contains - subroutine add_local_dependencies(dependency_list) + subroutine add_dependencies(dependency_list) type(dependency_t) :: dependency_list(:) integer :: i type(string_t) :: dep_name type(package_t) :: dependency + character(:), allocatable :: dependency_path + do i=1,size(dependency_list) if (dependency_list(i)%name .in. package_list) then @@ -89,49 +91,53 @@ recursive subroutine add_libsources_from_package(sources,package_list,package, & if (allocated(dependency_list(i)%git)) then - call fatal_error(error,'Remote dependencies not implemented') - return + dependency_path = join_path('build','dependencies',dependency_list(i)%name) - end if - - if (allocated(dependency_list(i)%path)) then + if (.not.exists(join_path(dependency_path,'fpm.toml'))) then + call dependency_list(i)%git%checkout(dependency_path, error) + if (allocated(error)) return + end if - call get_package_data(dependency, & - join_path(package_root,dependency_list(i)%path,"fpm.toml"), error) + else if (allocated(dependency_list(i)%path)) then + + dependency_path = join_path(package_root,dependency_list(i)%path) - if (allocated(error)) then - error%message = 'Error while parsing manifest for dependency package at:'//& - new_line('a')//join_path(package_root,dependency_list(i)%path,"fpm.toml")//& - new_line('a')//error%message - return - end if + end if - if (.not.allocated(dependency%library) .and. & - exists(join_path(package_root,dependency_list(i)%path,"src"))) then - allocate(dependency%library) - dependency%library%source_dir = "src" - end if + call get_package_data(dependency, & + join_path(dependency_path,"fpm.toml"), error) - - call add_libsources_from_package(sources,package_list,dependency, & - package_root=join_path(package_root,dependency_list(i)%path), & - dev_depends=dev_depends, error=error) - - if (allocated(error)) then - error%message = 'Error while processing sources for dependency package "'//& - new_line('a')//dependency%name//'"'//& - new_line('a')//error%message - return - end if + if (allocated(error)) then + error%message = 'Error while parsing manifest for dependency package at:'//& + new_line('a')//join_path(dependency_path,"fpm.toml")//& + new_line('a')//error%message + return + end if - dep_name%s = dependency_list(i)%name - package_list = [package_list, dep_name] + if (.not.allocated(dependency%library) .and. & + exists(join_path(dependency_path,"src"))) then + allocate(dependency%library) + dependency%library%source_dir = "src" + end if + + call add_libsources_from_package(sources,package_list,dependency, & + package_root=dependency_path, & + dev_depends=dev_depends, error=error) + + if (allocated(error)) then + error%message = 'Error while processing sources for dependency package "'//& + new_line('a')//dependency%name//'"'//& + new_line('a')//error%message + return end if + dep_name%s = dependency_list(i)%name + package_list = [package_list, dep_name] + end do - end subroutine add_local_dependencies + end subroutine add_dependencies end subroutine add_libsources_from_package diff --git a/fpm/src/fpm/git.f90 b/fpm/src/fpm/git.f90 index 28ae867..f02d06f 100644 --- a/fpm/src/fpm/git.f90 +++ b/fpm/src/fpm/git.f90 @@ -1,5 +1,6 @@ !> Implementation for interacting with git repositories. module fpm_git + use fpm_error, only: error_t, fatal_error implicit none public :: git_target_t @@ -43,6 +44,9 @@ module fpm_git contains + !> Fetch and checkout in local directory + procedure :: checkout + !> Show information on instance procedure :: info @@ -124,6 +128,45 @@ contains end function git_target_tag + subroutine checkout(self,local_path, error) + + !> Instance of the git target + class(git_target_t), intent(in) :: self + + !> Local path to checkout in + character(*), intent(in) :: local_path + + !> Error + type(error_t), allocatable, intent(out) :: error + + !> Stat for execute_command_line + integer :: stat + + call execute_command_line("git init "//local_path, exitstat=stat) + + if (stat /= 0) then + call fatal_error(error,'Error while initiating git repository for remote dependency') + return + end if + + call execute_command_line("git -C "//local_path//" fetch "//self%url//& + " "//self%object, exitstat=stat) + + if (stat /= 0) then + call fatal_error(error,'Error while fetching git repository for remote dependency') + return + end if + + call execute_command_line("git -C "//local_path//" checkout -qf FETCH_HEAD", exitstat=stat) + + if (stat /= 0) then + call fatal_error(error,'Error while checking out git repository for remote dependency') + return + end if + + end subroutine checkout + + !> Show information on git target subroutine info(self, unit, verbosity) -- cgit v1.2.3 From b6ec6b15ffcd764c6798bb8f76f0b6282dec437d Mon Sep 17 00:00:00 2001 From: LKedward Date: Sat, 3 Oct 2020 12:42:50 +0100 Subject: Fix: duplication of app modules --- fpm/src/fpm_sources.f90 | 109 ++++++++++++++++++++++++++---------------------- 1 file changed, 59 insertions(+), 50 deletions(-) diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index f798276..1028b81 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -6,7 +6,7 @@ use fpm_model, only: srcfile_ptr, srcfile_t, fpm_model_t, & 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_filesystem, only: basename, canon_path, dirname, join_path, 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 @@ -24,6 +24,33 @@ character(15), parameter :: INTRINSIC_MODULE_NAMES(*) = & contains +function parse_source(source_file_path,error) result(source) + character(*), intent(in) :: source_file_path + type(error_t), allocatable, intent(out) :: error + type(srcfile_t) :: source + + if (str_ends_with(lower(source_file_path), ".f90")) then + + source = parse_f_source(source_file_path, error) + + if (source%unit_type == FPM_UNIT_PROGRAM) then + source%exe_name = basename(source_file_path,suffix=.false.) + end if + + else if (str_ends_with(lower(source_file_path), ".c") .or. & + str_ends_with(lower(source_file_path), ".h")) then + + source = parse_c_source(source_file_path,error) + + end if + + if (allocated(error)) then + return + end if + +end function parse_source + + subroutine add_sources_from_dir(sources,directory,scope,with_executables,error) ! Enumerate sources in a directory ! @@ -33,7 +60,7 @@ subroutine add_sources_from_dir(sources,directory,scope,with_executables,error) logical, intent(in), optional :: with_executables type(error_t), allocatable, intent(out) :: error - integer :: i, j + integer :: i logical, allocatable :: is_source(:), exclude_source(:) type(string_t), allocatable :: file_names(:) type(string_t), allocatable :: src_file_names(:) @@ -46,13 +73,13 @@ subroutine add_sources_from_dir(sources,directory,scope,with_executables,error) if (allocated(sources)) then allocate(existing_src_files(size(sources))) do i=1,size(sources) - existing_src_files(i)%s = sources(i)%file_name + existing_src_files(i)%s = canon_path(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. & + is_source = [(.not.(canon_path(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))] @@ -63,26 +90,8 @@ subroutine add_sources_from_dir(sources,directory,scope,with_executables,error) do i = 1, size(src_file_names) - if (str_ends_with(lower(src_file_names(i)%s), ".f90")) then - - dir_sources(i) = parse_f_source(src_file_names(i)%s, error) - - if (allocated(error)) then - return - end if - - end if - - if (str_ends_with(lower(src_file_names(i)%s), ".c") .or. & - str_ends_with(lower(src_file_names(i)%s), ".h")) then - - dir_sources(i) = parse_c_source(src_file_names(i)%s,error) - - if (allocated(error)) then - return - end if - - end if + dir_sources(i) = parse_source(src_file_names(i)%s,error) + if (allocated(error)) return dir_sources(i)%unit_scope = scope @@ -93,7 +102,6 @@ subroutine add_sources_from_dir(sources,directory,scope,with_executables,error) if (with_executables) then exclude_source(i) = .false. - dir_sources(i)%exe_name = basename(src_file_names(i)%s,suffix=.false.) end if end if @@ -122,49 +130,50 @@ subroutine add_executable_sources(sources,executables,scope,auto_discover,error) integer :: i, j type(string_t), allocatable :: exe_dirs(:) - logical, allocatable :: include_source(:) - type(srcfile_t), allocatable :: dir_sources(:) + type(srcfile_t) :: exe_source 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, & - scope, with_executables=.true.,error=error) + call add_sources_from_dir(sources,exe_dirs(i)%s, & + scope, with_executables=auto_discover,error=error) if (allocated(error)) then return end if end do - allocate(include_source(size(dir_sources))) + exe_loop: do i=1,size(executables) - do i = 1, size(dir_sources) - - ! 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) + ! Check if executable already discovered automatically + ! and apply any overrides + do j=1,size(sources) - 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 + if (basename(sources(j)%file_name,suffix=.true.) == executables(i)%main .and.& + canon_path(dirname(sources(j)%file_name)) == & + canon_path(executables(i)%source_dir) ) then - include_source(i) = .true. - dir_sources(i)%exe_name = executables(j)%name - exit + sources(j)%exe_name = executables(i)%name + cycle exe_loop end if + end do - end do + ! Add if not already discovered (auto_discovery off) + exe_source = parse_source(join_path(executables(i)%source_dir,executables(i)%main),error) + exe_source%exe_name = executables(i)%name + exe_source%unit_scope = scope + + if (allocated(error)) return - if (.not.allocated(sources)) then - sources = pack(dir_sources,include_source) - else - sources = [sources, pack(dir_sources,include_source)] - end if + if (.not.allocated(sources)) then + sources = [exe_source] + else + sources = [sources, exe_source] + end if + + end do exe_loop end subroutine add_executable_sources -- cgit v1.2.3 From 7ca0ba26405a074103c63f281177f3966bc0a760 Mon Sep 17 00:00:00 2001 From: LKedward Date: Sat, 3 Oct 2020 12:49:30 +0100 Subject: Update: source parsing test - include statement Demonstrates bug in include statement parsing - currently erroneously parsing all statements that begin with 'include'. --- fpm/test/fpm_test/test_source_parsing.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/fpm/test/fpm_test/test_source_parsing.f90 b/fpm/test/fpm_test/test_source_parsing.f90 index 0b92bef..a8bbc09 100644 --- a/fpm/test/fpm_test/test_source_parsing.f90 +++ b/fpm/test/fpm_test/test_source_parsing.f90 @@ -199,6 +199,8 @@ contains & 'program test', & & ' implicit none', & & ' include "included_file.f90"', & + & ' logical :: include_comments', & + & ' include_comments = .false.', & & ' contains ', & & ' include "second_include.f90"', & & 'end program test' -- cgit v1.2.3 From 10d835afd44adecf6589a2ebc0d20249880bcfc8 Mon Sep 17 00:00:00 2001 From: LKedward Date: Sat, 3 Oct 2020 12:55:08 +0100 Subject: Fix: include statement parsing Include statements must have a single or double quote immediately following 'include' --- fpm/src/fpm_sources.f90 | 29 +++++++++++++++++------------ fpm/test/fpm_test/test_source_parsing.f90 | 8 ++++---- 2 files changed, 21 insertions(+), 16 deletions(-) diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index 1028b81..393c799 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -300,21 +300,26 @@ function parse_f_source(f_filename,error) result(f_source) end if ! Process 'INCLUDE' statements - if (index(adjustl(lower(file_lines(i)%s)),'include') == 1) then - - n_include = n_include + 1 + ic = index(adjustl(lower(file_lines(i)%s)),'include') + if ( ic == 1 ) then + ic = index(lower(file_lines(i)%s),'include') + if (index(adjustl(file_lines(i)%s(ic+7:)),'"') == 1 .or. & + index(adjustl(file_lines(i)%s(ic+7:)),"'") == 1 ) then - if (pass == 2) then - f_source%include_dependencies(n_include)%s = & - & split_n(file_lines(i)%s,n=2,delims="'"//'"',stat=stat) - if (stat /= 0) then - call file_parse_error(error,f_filename, & - 'unable to find include file name',i, & - file_lines(i)%s) - return + + n_include = n_include + 1 + + if (pass == 2) then + f_source%include_dependencies(n_include)%s = & + & split_n(file_lines(i)%s,n=2,delims="'"//'"',stat=stat) + if (stat /= 0) then + call file_parse_error(error,f_filename, & + 'unable to find include file name',i, & + file_lines(i)%s) + return + end if end if end if - end if ! Extract name of module if is module diff --git a/fpm/test/fpm_test/test_source_parsing.f90 b/fpm/test/fpm_test/test_source_parsing.f90 index a8bbc09..d1d3e12 100644 --- a/fpm/test/fpm_test/test_source_parsing.f90 +++ b/fpm/test/fpm_test/test_source_parsing.f90 @@ -198,11 +198,11 @@ contains write(unit, '(a)') & & 'program test', & & ' implicit none', & - & ' include "included_file.f90"', & - & ' logical :: include_comments', & - & ' include_comments = .false.', & + & ' include "included_file.f90"', & + & ' character(*) :: include_comments', & + & ' include_comments = "some comments"', & & ' contains ', & - & ' include "second_include.f90"', & + & ' include"second_include.f90"', & & 'end program test' close(unit) -- cgit v1.2.3 From 9b790fbbb606a7de152615745543b0912efd3f33 Mon Sep 17 00:00:00 2001 From: LKedward Date: Sat, 3 Oct 2020 14:09:54 +0100 Subject: Update: use default git object = 'HEAD' for checkout --- fpm/src/fpm/git.f90 | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/fpm/src/fpm/git.f90 b/fpm/src/fpm/git.f90 index f02d06f..187b551 100644 --- a/fpm/src/fpm/git.f90 +++ b/fpm/src/fpm/git.f90 @@ -138,10 +138,19 @@ contains !> Error type(error_t), allocatable, intent(out) :: error + + !> git object ref + character(:), allocatable :: object !> Stat for execute_command_line integer :: stat + if (allocated(self%object)) then + object = self%object + else + object = 'HEAD' + end if + call execute_command_line("git init "//local_path, exitstat=stat) if (stat /= 0) then @@ -150,7 +159,7 @@ contains end if call execute_command_line("git -C "//local_path//" fetch "//self%url//& - " "//self%object, exitstat=stat) + " "//object, exitstat=stat) if (stat /= 0) then call fatal_error(error,'Error while fetching git repository for remote dependency') -- cgit v1.2.3 From 501be367dbfdd7233d343c3fc156ecfa290a6778 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sun, 4 Oct 2020 09:55:40 +0100 Subject: Update fpm/src/fpm.f90 Co-authored-by: Milan Curcic --- fpm/src/fpm.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 9d1d863..8088225 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -75,7 +75,7 @@ recursive subroutine add_libsources_from_package(sources,package_list,package, & contains subroutine add_dependencies(dependency_list) - type(dependency_t) :: dependency_list(:) + type(dependency_t), intent(in) :: dependency_list(:) integer :: i type(string_t) :: dep_name -- cgit v1.2.3 From 24b115eab49e8926f4a46c28d2ad383bc3a22b31 Mon Sep 17 00:00:00 2001 From: LKedward Date: Sun, 4 Oct 2020 10:39:17 +0100 Subject: Don't pull dev dependencies of dependencies. --- fpm/src/fpm.f90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 8088225..faa3e7e 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -29,7 +29,6 @@ contains recursive subroutine add_libsources_from_package(sources,package_list,package, & package_root,dev_depends,error) ! Discover library sources in a package, recursively including dependencies - ! Only supports local path dependencies currently ! type(srcfile_t), allocatable, intent(inout), target :: sources(:) type(string_t), allocatable, intent(inout) :: package_list(:) @@ -123,7 +122,7 @@ recursive subroutine add_libsources_from_package(sources,package_list,package, & call add_libsources_from_package(sources,package_list,dependency, & package_root=dependency_path, & - dev_depends=dev_depends, error=error) + dev_depends=.false., error=error) if (allocated(error)) then error%message = 'Error while processing sources for dependency package "'//& -- cgit v1.2.3 From f6ee1f086db8faede5071ff5ab328a3f6b0868e6 Mon Sep 17 00:00:00 2001 From: "init current directory[i]" Date: Sun, 4 Oct 2020 11:05:45 -0400 Subject: refactor fpm.f90 to separate subcommand new into fpm_new_subcommand.f90 --- fpm/app/main.f90 | 3 +- fpm/src/fpm.f90 | 164 +--------------------------------------- fpm/src/fpm_new_subcommand.f90 | 165 +++++++++++++++++++++++++++++++++++++++++ fpm/test/cli_test/cli_test.f90 | 3 +- 4 files changed, 173 insertions(+), 162 deletions(-) create mode 100644 fpm/src/fpm_new_subcommand.f90 diff --git a/fpm/app/main.f90 b/fpm/app/main.f90 index be9b805..03904fe 100644 --- a/fpm/app/main.f90 +++ b/fpm/app/main.f90 @@ -7,7 +7,8 @@ use fpm_command_line, only: & fpm_test_settings, & fpm_install_settings, & get_command_line_settings -use fpm, only: cmd_build, cmd_install, cmd_new, cmd_run, cmd_test +use fpm, only: cmd_build, cmd_install, cmd_run, cmd_test +use fpm_new_subcommand, only: cmd_new implicit none diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 4db35ba..41867b8 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -4,8 +4,8 @@ use fpm_strings, only: string_t, str_ends_with 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: is_dir, join_path, number_of_rows, list_files, exists, basename, mkdir +use fpm_environment, only: run +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 @@ -16,12 +16,10 @@ use fpm_manifest, only : get_package_data, default_executable, & default_library, package_t, default_test use fpm_error, only : error_t use fpm_manifest_test, only : test_t -use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, & - & stdout=>output_unit, & - & stderr=>error_unit +use,intrinsic :: iso_fortran_env, only : stderr=>error_unit implicit none private -public :: cmd_build, cmd_install, cmd_new, cmd_run, cmd_test +public :: cmd_build, cmd_install, cmd_run, cmd_test contains @@ -168,160 +166,6 @@ type(fpm_install_settings), intent(in) :: settings error stop 8 end subroutine cmd_install - -subroutine cmd_new(settings) ! --with-executable F --with-test F ' -type(fpm_new_settings), intent(in) :: settings -integer :: ierr -character(len=:),allocatable :: bname ! baeename of NAME -character(len=:),allocatable :: message(:) -character(len=:),allocatable :: littlefile(:) - - call mkdir(settings%name) ! make new directory - call run('cd '//settings%name) ! change to new directory as a test. New OS routines to improve this; system dependent potentially - !! NOTE: need some system routines to handle filenames like "." like realpath() or getcwd(). - bname=basename(settings%name) - - !! weird gfortran bug?? lines truncated to concatenated string length, not 80 - !! hit some weird gfortran bug when littlefile data was an argument to warnwrite(3f), ok when a variable - - call warnwrite(join_path(settings%name, '.gitignore'), ['build/*']) ! create NAME/.gitignore file - - littlefile=[character(len=80) :: '# '//bname, 'My cool new project!'] - - call warnwrite(join_path(settings%name, 'README.md'), littlefile) ! create NAME/README.md - - message=[character(len=80) :: & ! start building NAME/fpm.toml - &'name = "'//bname//'" ', & - &'version = "0.1.0" ', & - &'license = "license" ', & - &'author = "Jane Doe" ', & - &'maintainer = "jane.doe@example.com" ', & - &'copyright = "2020 Jane Doe" ', & - &' ', & - &''] - - if(settings%with_lib)then - call mkdir(join_path(settings%name,'src') ) - message=[character(len=80) :: message, & ! create next section of fpm.toml - &'[library] ', & - &'source-dir="src" ', & - &''] - littlefile=[character(len=80) :: & ! create placeholder module src/bname.f90 - &'module '//bname, & - &' implicit none', & - &' private', & - &'', & - &' public :: say_hello', & - &'contains', & - &' subroutine say_hello', & - &' print *, "Hello, '//bname//'!"', & - &' end subroutine say_hello', & - &'end module '//bname] - ! a proposed alternative default - call warnwrite(join_path(settings%name, 'src', bname//'.f90'), littlefile) ! create NAME/src/NAME.f90 - endif - - if(settings%with_test)then - call mkdir(join_path(settings%name, 'test')) ! create NAME/test or stop - message=[character(len=80) :: message, & ! create next section of fpm.toml - &'[[test]] ', & - &'name="runTests" ', & - &'source-dir="test" ', & - &'main="main.f90" ', & - &''] - - littlefile=[character(len=80) :: & - &'program main', & - &'implicit none', & - &'', & - &'print *, "Put some tests in here!"', & - &'end program main'] - ! a proposed alternative default a little more substantive - call warnwrite(join_path(settings%name, 'test/main.f90'), littlefile) ! create NAME/test/main.f90 - endif - - if(settings%with_executable)then - call mkdir(join_path(settings%name, 'app')) ! create NAME/app or stop - message=[character(len=80) :: message, & ! create next section of fpm.toml - &'[[executable]] ', & - &'name="'//bname//'" ', & - &'source-dir="app" ', & - &'main="main.f90" ', & - &''] - - littlefile=[character(len=80) :: & - &'program main', & - &' use '//bname//', only: say_hello', & - &'', & - &' implicit none', & - &'', & - &' call say_hello', & - &'end program main'] - call warnwrite(join_path(settings%name, 'app/main.f90'), littlefile) - endif - - call warnwrite(join_path(settings%name, 'fpm.toml'), message) ! now that built it write NAME/fpm.toml - - call run('cd ' // settings%name // ';git init') ! assumes these commands work on all systems and git(1) is installed -contains - -subroutine warnwrite(fname,data) -character(len=*),intent(in) :: fname -character(len=*),intent(in) :: data(:) - - if(.not.exists(fname))then - call filewrite(fname,data) - else - write(stderr,'(*(g0,1x))')'fpm::new',fname,'already exists. Not overwriting' - endif - -end subroutine warnwrite - -subroutine filewrite(filename,filedata) -use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit -! write filedata to file filename -character(len=*),intent(in) :: filename -character(len=*),intent(in) :: filedata(:) -integer :: lun, i, ios -character(len=256) :: message - - message=' ' - ios=0 - if(filename.ne.' ')then - open(file=filename, & - & newunit=lun, & - & form='formatted', & ! FORM = FORMATTED | UNFORMATTED - & access='sequential', & ! ACCESS = SEQUENTIAL | DIRECT | STREAM - & action='write', & ! ACTION = READ|WRITE | READWRITE - & position='rewind', & ! POSITION = ASIS | REWIND | APPEND - & status='new', & ! STATUS = NEW | REPLACE | OLD | SCRATCH | UNKNOWN - & iostat=ios, & - & iomsg=message) - else - lun=stdout - ios=0 - endif - if(ios.ne.0)then - write(stderr,'(*(a:,1x))')'*filewrite* error:',filename,trim(message) - error stop 1 - endif - do i=1,size(filedata) ! write file - write(lun,'(a)',iostat=ios,iomsg=message)trim(filedata(i)) - if(ios.ne.0)then - write(stderr,'(*(a:,1x))')'*filewrite* error:',filename,trim(message) - error stop 4 - endif - enddo - close(unit=lun,iostat=ios,iomsg=message) ! close file - if(ios.ne.0)then - write(stderr,'(*(a:,1x))')'*filewrite* error:',trim(message) - error stop 2 - endif -end subroutine filewrite - -end subroutine cmd_new - - subroutine cmd_run(settings) type(fpm_run_settings), intent(in) :: settings character(len=:),allocatable :: release_name, cmd, fname diff --git a/fpm/src/fpm_new_subcommand.f90 b/fpm/src/fpm_new_subcommand.f90 new file mode 100644 index 0000000..d8a4282 --- /dev/null +++ b/fpm/src/fpm_new_subcommand.f90 @@ -0,0 +1,165 @@ +module fpm_new_subcommand + +use fpm_command_line, only : fpm_new_settings +use fpm_environment, only : run, OS_LINUX, OS_MACOS, OS_WINDOWS +use fpm_filesystem, only : join_path, exists, basename, mkdir +use,intrinsic :: iso_fortran_env, only : stderr=>error_unit +implicit none +private +public :: cmd_new + +contains + +subroutine cmd_new(settings) ! --with-executable F --with-test F ' +type(fpm_new_settings), intent(in) :: settings +integer :: ierr +character(len=:),allocatable :: bname ! baeename of NAME +character(len=:),allocatable :: message(:) +character(len=:),allocatable :: littlefile(:) + + call mkdir(settings%name) ! make new directory + call run('cd '//settings%name) ! change to new directory as a test. System dependent potentially + !! NOTE: need some system routines to handle filenames like "." like realpath() or getcwd(). + bname=basename(settings%name) + + !! weird gfortran bug?? lines truncated to concatenated string length, not 80 + !! hit some weird gfortran bug when littlefile data was an argument to warnwrite(3f), ok when a variable + + call warnwrite(join_path(settings%name, '.gitignore'), ['build/*']) ! create NAME/.gitignore file + + littlefile=[character(len=80) :: '# '//bname, 'My cool new project!'] + + call warnwrite(join_path(settings%name, 'README.md'), littlefile) ! create NAME/README.md + + message=[character(len=80) :: & ! start building NAME/fpm.toml + &'name = "'//bname//'" ', & + &'version = "0.1.0" ', & + &'license = "license" ', & + &'author = "Jane Doe" ', & + &'maintainer = "jane.doe@example.com" ', & + &'copyright = "2020 Jane Doe" ', & + &' ', & + &''] + + if(settings%with_lib)then + call mkdir(join_path(settings%name,'src') ) + message=[character(len=80) :: message, & ! create next section of fpm.toml + &'[library] ', & + &'source-dir="src" ', & + &''] + littlefile=[character(len=80) :: & ! create placeholder module src/bname.f90 + &'module '//bname, & + &' implicit none', & + &' private', & + &'', & + &' public :: say_hello', & + &'contains', & + &' subroutine say_hello', & + &' print *, "Hello, '//bname//'!"', & + &' end subroutine say_hello', & + &'end module '//bname] + ! a proposed alternative default + call warnwrite(join_path(settings%name, 'src', bname//'.f90'), littlefile) ! create NAME/src/NAME.f90 + endif + + if(settings%with_test)then + call mkdir(join_path(settings%name, 'test')) ! create NAME/test or stop + message=[character(len=80) :: message, & ! create next section of fpm.toml + &'[[test]] ', & + &'name="runTests" ', & + &'source-dir="test" ', & + &'main="main.f90" ', & + &''] + + littlefile=[character(len=80) :: & + &'program main', & + &'implicit none', & + &'', & + &'print *, "Put some tests in here!"', & + &'end program main'] + ! a proposed alternative default a little more substantive + call warnwrite(join_path(settings%name, 'test/main.f90'), littlefile) ! create NAME/test/main.f90 + endif + + if(settings%with_executable)then + call mkdir(join_path(settings%name, 'app')) ! create NAME/app or stop + message=[character(len=80) :: message, & ! create next section of fpm.toml + &'[[executable]] ', & + &'name="'//bname//'" ', & + &'source-dir="app" ', & + &'main="main.f90" ', & + &''] + + littlefile=[character(len=80) :: & + &'program main', & + &' use '//bname//', only: say_hello', & + &'', & + &' implicit none', & + &'', & + &' call say_hello', & + &'end program main'] + call warnwrite(join_path(settings%name, 'app/main.f90'), littlefile) + endif + + call warnwrite(join_path(settings%name, 'fpm.toml'), message) ! now that built it write NAME/fpm.toml + + call run('cd ' // settings%name // ';git init') ! assumes these commands work on all systems and git(1) is installed +contains + +subroutine warnwrite(fname,data) +character(len=*),intent(in) :: fname +character(len=*),intent(in) :: data(:) + + if(.not.exists(fname))then + call filewrite(fname,data) + else + write(stderr,'(*(g0,1x))')'fpm::new',fname,'already exists. Not overwriting' + endif + +end subroutine warnwrite + +subroutine filewrite(filename,filedata) +use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit +! write filedata to file filename +character(len=*),intent(in) :: filename +character(len=*),intent(in) :: filedata(:) +integer :: lun, i, ios +character(len=256) :: message + + message=' ' + ios=0 + if(filename.ne.' ')then + open(file=filename, & + & newunit=lun, & + & form='formatted', & ! FORM = FORMATTED | UNFORMATTED + & access='sequential', & ! ACCESS = SEQUENTIAL | DIRECT | STREAM + & action='write', & ! ACTION = READ|WRITE | READWRITE + & position='rewind', & ! POSITION = ASIS | REWIND | APPEND + & status='new', & ! STATUS = NEW | REPLACE | OLD | SCRATCH | UNKNOWN + & iostat=ios, & + & iomsg=message) + else + lun=stdout + ios=0 + endif + if(ios.ne.0)then + write(stderr,'(*(a:,1x))')'*filewrite* error:',filename,trim(message) + error stop 1 + endif + do i=1,size(filedata) ! write file + write(lun,'(a)',iostat=ios,iomsg=message)trim(filedata(i)) + if(ios.ne.0)then + write(stderr,'(*(a:,1x))')'*filewrite* error:',filename,trim(message) + error stop 4 + endif + enddo + close(unit=lun,iostat=ios,iomsg=message) ! close file + if(ios.ne.0)then + write(stderr,'(*(a:,1x))')'*filewrite* error:',trim(message) + error stop 2 + endif +end subroutine filewrite + +end subroutine cmd_new + +end module fpm_new_subcommand diff --git a/fpm/test/cli_test/cli_test.f90 b/fpm/test/cli_test/cli_test.f90 index fac49e8..a12575f 100644 --- a/fpm/test/cli_test/cli_test.f90 +++ b/fpm/test/cli_test/cli_test.f90 @@ -193,7 +193,8 @@ use fpm_command_line, only: & fpm_test_settings, & fpm_install_settings, & get_command_line_settings -use fpm, only: cmd_build, cmd_install, cmd_new, cmd_run, cmd_test +use fpm, only: cmd_build, cmd_install, cmd_run, cmd_test +use fpm_new_subcommand, only: cmd_new class(fpm_cmd_settings), allocatable :: cmd_settings ! duplicates the calls as seen in the main program for fpm call get_command_line_settings(cmd_settings) -- cgit v1.2.3 From 7c3a079eaef81404ae2899fdf248ef764d558c1d Mon Sep 17 00:00:00 2001 From: "init current directory[i]" Date: Sun, 4 Oct 2020 13:13:27 -0400 Subject: minor rename --- fpm/app/main.f90 | 2 +- fpm/src/fpm.f90 | 4 +- fpm/src/fpm_cmd_new.f90 | 164 ++++++++++++++++++++++++++++++++++++++++ fpm/src/fpm_new_subcommand.f90 | 165 ----------------------------------------- fpm/test/cli_test/cli_test.f90 | 2 +- 5 files changed, 168 insertions(+), 169 deletions(-) create mode 100644 fpm/src/fpm_cmd_new.f90 delete mode 100644 fpm/src/fpm_new_subcommand.f90 diff --git a/fpm/app/main.f90 b/fpm/app/main.f90 index 03904fe..9982028 100644 --- a/fpm/app/main.f90 +++ b/fpm/app/main.f90 @@ -8,7 +8,7 @@ use fpm_command_line, only: & fpm_install_settings, & get_command_line_settings use fpm, only: cmd_build, cmd_install, cmd_run, cmd_test -use fpm_new_subcommand, only: cmd_new +use fpm_cmd_new, only: cmd_new implicit none diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 41867b8..4442923 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -4,8 +4,8 @@ use fpm_strings, only: string_t, str_ends_with 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 -use fpm_filesystem, only: is_dir, join_path, number_of_rows, list_files, exists, basename +use fpm_environment, only: run +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 diff --git a/fpm/src/fpm_cmd_new.f90 b/fpm/src/fpm_cmd_new.f90 new file mode 100644 index 0000000..03d9ed4 --- /dev/null +++ b/fpm/src/fpm_cmd_new.f90 @@ -0,0 +1,164 @@ +module fpm_cmd_new + +use fpm_command_line, only : fpm_new_settings +use fpm_environment, only : run, OS_LINUX, OS_MACOS, OS_WINDOWS +use fpm_filesystem, only : join_path, exists, basename, mkdir +use,intrinsic :: iso_fortran_env, only : stderr=>error_unit +implicit none +private +public :: cmd_new + +contains + +subroutine cmd_new(settings) ! --with-executable F --with-test F ' +type(fpm_new_settings), intent(in) :: settings +character(len=:),allocatable :: bname ! baeename of NAME +character(len=:),allocatable :: message(:) +character(len=:),allocatable :: littlefile(:) + + call mkdir(settings%name) ! make new directory + call run('cd '//settings%name) ! change to new directory as a test. System dependent potentially + !! NOTE: need some system routines to handle filenames like "." like realpath() or getcwd(). + bname=basename(settings%name) + + !! weird gfortran bug?? lines truncated to concatenated string length, not 80 + !! hit some weird gfortran bug when littlefile data was an argument to warnwrite(3f), ok when a variable + + call warnwrite(join_path(settings%name, '.gitignore'), ['build/*']) ! create NAME/.gitignore file + + littlefile=[character(len=80) :: '# '//bname, 'My cool new project!'] + + call warnwrite(join_path(settings%name, 'README.md'), littlefile) ! create NAME/README.md + + message=[character(len=80) :: & ! start building NAME/fpm.toml + &'name = "'//bname//'" ', & + &'version = "0.1.0" ', & + &'license = "license" ', & + &'author = "Jane Doe" ', & + &'maintainer = "jane.doe@example.com" ', & + &'copyright = "2020 Jane Doe" ', & + &' ', & + &''] + + if(settings%with_lib)then + call mkdir(join_path(settings%name,'src') ) + message=[character(len=80) :: message, & ! create next section of fpm.toml + &'[library] ', & + &'source-dir="src" ', & + &''] + littlefile=[character(len=80) :: & ! create placeholder module src/bname.f90 + &'module '//bname, & + &' implicit none', & + &' private', & + &'', & + &' public :: say_hello', & + &'contains', & + &' subroutine say_hello', & + &' print *, "Hello, '//bname//'!"', & + &' end subroutine say_hello', & + &'end module '//bname] + ! a proposed alternative default + call warnwrite(join_path(settings%name, 'src', bname//'.f90'), littlefile) ! create NAME/src/NAME.f90 + endif + + if(settings%with_test)then + call mkdir(join_path(settings%name, 'test')) ! create NAME/test or stop + message=[character(len=80) :: message, & ! create next section of fpm.toml + &'[[test]] ', & + &'name="runTests" ', & + &'source-dir="test" ', & + &'main="main.f90" ', & + &''] + + littlefile=[character(len=80) :: & + &'program main', & + &'implicit none', & + &'', & + &'print *, "Put some tests in here!"', & + &'end program main'] + ! a proposed alternative default a little more substantive + call warnwrite(join_path(settings%name, 'test/main.f90'), littlefile) ! create NAME/test/main.f90 + endif + + if(settings%with_executable)then + call mkdir(join_path(settings%name, 'app')) ! create NAME/app or stop + message=[character(len=80) :: message, & ! create next section of fpm.toml + &'[[executable]] ', & + &'name="'//bname//'" ', & + &'source-dir="app" ', & + &'main="main.f90" ', & + &''] + + littlefile=[character(len=80) :: & + &'program main', & + &' use '//bname//', only: say_hello', & + &'', & + &' implicit none', & + &'', & + &' call say_hello', & + &'end program main'] + call warnwrite(join_path(settings%name, 'app/main.f90'), littlefile) + endif + + call warnwrite(join_path(settings%name, 'fpm.toml'), message) ! now that built it write NAME/fpm.toml + + call run('cd ' // settings%name // ';git init') ! assumes these commands work on all systems and git(1) is installed +contains + +subroutine warnwrite(fname,data) +character(len=*),intent(in) :: fname +character(len=*),intent(in) :: data(:) + + if(.not.exists(fname))then + call filewrite(fname,data) + else + write(stderr,'(*(g0,1x))')'fpm::new',fname,'already exists. Not overwriting' + endif + +end subroutine warnwrite + +subroutine filewrite(filename,filedata) +use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit +! write filedata to file filename +character(len=*),intent(in) :: filename +character(len=*),intent(in) :: filedata(:) +integer :: lun, i, ios +character(len=256) :: message + + message=' ' + ios=0 + if(filename.ne.' ')then + open(file=filename, & + & newunit=lun, & + & form='formatted', & ! FORM = FORMATTED | UNFORMATTED + & access='sequential', & ! ACCESS = SEQUENTIAL | DIRECT | STREAM + & action='write', & ! ACTION = READ|WRITE | READWRITE + & position='rewind', & ! POSITION = ASIS | REWIND | APPEND + & status='new', & ! STATUS = NEW | REPLACE | OLD | SCRATCH | UNKNOWN + & iostat=ios, & + & iomsg=message) + else + lun=stdout + ios=0 + endif + if(ios.ne.0)then + write(stderr,'(*(a:,1x))')'*filewrite* error:',filename,trim(message) + error stop 1 + endif + do i=1,size(filedata) ! write file + write(lun,'(a)',iostat=ios,iomsg=message)trim(filedata(i)) + if(ios.ne.0)then + write(stderr,'(*(a:,1x))')'*filewrite* error:',filename,trim(message) + error stop 4 + endif + enddo + close(unit=lun,iostat=ios,iomsg=message) ! close file + if(ios.ne.0)then + write(stderr,'(*(a:,1x))')'*filewrite* error:',trim(message) + error stop 2 + endif +end subroutine filewrite + +end subroutine cmd_new + +end module fpm_cmd_new diff --git a/fpm/src/fpm_new_subcommand.f90 b/fpm/src/fpm_new_subcommand.f90 deleted file mode 100644 index d8a4282..0000000 --- a/fpm/src/fpm_new_subcommand.f90 +++ /dev/null @@ -1,165 +0,0 @@ -module fpm_new_subcommand - -use fpm_command_line, only : fpm_new_settings -use fpm_environment, only : run, OS_LINUX, OS_MACOS, OS_WINDOWS -use fpm_filesystem, only : join_path, exists, basename, mkdir -use,intrinsic :: iso_fortran_env, only : stderr=>error_unit -implicit none -private -public :: cmd_new - -contains - -subroutine cmd_new(settings) ! --with-executable F --with-test F ' -type(fpm_new_settings), intent(in) :: settings -integer :: ierr -character(len=:),allocatable :: bname ! baeename of NAME -character(len=:),allocatable :: message(:) -character(len=:),allocatable :: littlefile(:) - - call mkdir(settings%name) ! make new directory - call run('cd '//settings%name) ! change to new directory as a test. System dependent potentially - !! NOTE: need some system routines to handle filenames like "." like realpath() or getcwd(). - bname=basename(settings%name) - - !! weird gfortran bug?? lines truncated to concatenated string length, not 80 - !! hit some weird gfortran bug when littlefile data was an argument to warnwrite(3f), ok when a variable - - call warnwrite(join_path(settings%name, '.gitignore'), ['build/*']) ! create NAME/.gitignore file - - littlefile=[character(len=80) :: '# '//bname, 'My cool new project!'] - - call warnwrite(join_path(settings%name, 'README.md'), littlefile) ! create NAME/README.md - - message=[character(len=80) :: & ! start building NAME/fpm.toml - &'name = "'//bname//'" ', & - &'version = "0.1.0" ', & - &'license = "license" ', & - &'author = "Jane Doe" ', & - &'maintainer = "jane.doe@example.com" ', & - &'copyright = "2020 Jane Doe" ', & - &' ', & - &''] - - if(settings%with_lib)then - call mkdir(join_path(settings%name,'src') ) - message=[character(len=80) :: message, & ! create next section of fpm.toml - &'[library] ', & - &'source-dir="src" ', & - &''] - littlefile=[character(len=80) :: & ! create placeholder module src/bname.f90 - &'module '//bname, & - &' implicit none', & - &' private', & - &'', & - &' public :: say_hello', & - &'contains', & - &' subroutine say_hello', & - &' print *, "Hello, '//bname//'!"', & - &' end subroutine say_hello', & - &'end module '//bname] - ! a proposed alternative default - call warnwrite(join_path(settings%name, 'src', bname//'.f90'), littlefile) ! create NAME/src/NAME.f90 - endif - - if(settings%with_test)then - call mkdir(join_path(settings%name, 'test')) ! create NAME/test or stop - message=[character(len=80) :: message, & ! create next section of fpm.toml - &'[[test]] ', & - &'name="runTests" ', & - &'source-dir="test" ', & - &'main="main.f90" ', & - &''] - - littlefile=[character(len=80) :: & - &'program main', & - &'implicit none', & - &'', & - &'print *, "Put some tests in here!"', & - &'end program main'] - ! a proposed alternative default a little more substantive - call warnwrite(join_path(settings%name, 'test/main.f90'), littlefile) ! create NAME/test/main.f90 - endif - - if(settings%with_executable)then - call mkdir(join_path(settings%name, 'app')) ! create NAME/app or stop - message=[character(len=80) :: message, & ! create next section of fpm.toml - &'[[executable]] ', & - &'name="'//bname//'" ', & - &'source-dir="app" ', & - &'main="main.f90" ', & - &''] - - littlefile=[character(len=80) :: & - &'program main', & - &' use '//bname//', only: say_hello', & - &'', & - &' implicit none', & - &'', & - &' call say_hello', & - &'end program main'] - call warnwrite(join_path(settings%name, 'app/main.f90'), littlefile) - endif - - call warnwrite(join_path(settings%name, 'fpm.toml'), message) ! now that built it write NAME/fpm.toml - - call run('cd ' // settings%name // ';git init') ! assumes these commands work on all systems and git(1) is installed -contains - -subroutine warnwrite(fname,data) -character(len=*),intent(in) :: fname -character(len=*),intent(in) :: data(:) - - if(.not.exists(fname))then - call filewrite(fname,data) - else - write(stderr,'(*(g0,1x))')'fpm::new',fname,'already exists. Not overwriting' - endif - -end subroutine warnwrite - -subroutine filewrite(filename,filedata) -use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit -! write filedata to file filename -character(len=*),intent(in) :: filename -character(len=*),intent(in) :: filedata(:) -integer :: lun, i, ios -character(len=256) :: message - - message=' ' - ios=0 - if(filename.ne.' ')then - open(file=filename, & - & newunit=lun, & - & form='formatted', & ! FORM = FORMATTED | UNFORMATTED - & access='sequential', & ! ACCESS = SEQUENTIAL | DIRECT | STREAM - & action='write', & ! ACTION = READ|WRITE | READWRITE - & position='rewind', & ! POSITION = ASIS | REWIND | APPEND - & status='new', & ! STATUS = NEW | REPLACE | OLD | SCRATCH | UNKNOWN - & iostat=ios, & - & iomsg=message) - else - lun=stdout - ios=0 - endif - if(ios.ne.0)then - write(stderr,'(*(a:,1x))')'*filewrite* error:',filename,trim(message) - error stop 1 - endif - do i=1,size(filedata) ! write file - write(lun,'(a)',iostat=ios,iomsg=message)trim(filedata(i)) - if(ios.ne.0)then - write(stderr,'(*(a:,1x))')'*filewrite* error:',filename,trim(message) - error stop 4 - endif - enddo - close(unit=lun,iostat=ios,iomsg=message) ! close file - if(ios.ne.0)then - write(stderr,'(*(a:,1x))')'*filewrite* error:',trim(message) - error stop 2 - endif -end subroutine filewrite - -end subroutine cmd_new - -end module fpm_new_subcommand diff --git a/fpm/test/cli_test/cli_test.f90 b/fpm/test/cli_test/cli_test.f90 index a12575f..b0140e1 100644 --- a/fpm/test/cli_test/cli_test.f90 +++ b/fpm/test/cli_test/cli_test.f90 @@ -194,7 +194,7 @@ use fpm_command_line, only: & fpm_install_settings, & get_command_line_settings use fpm, only: cmd_build, cmd_install, cmd_run, cmd_test -use fpm_new_subcommand, only: cmd_new +use fpm_cmd_new, only: cmd_new class(fpm_cmd_settings), allocatable :: cmd_settings ! duplicates the calls as seen in the main program for fpm call get_command_line_settings(cmd_settings) -- cgit v1.2.3 From 86515195315a555d513a96f633885d9b7691a880 Mon Sep 17 00:00:00 2001 From: "init current directory[i]" Date: Tue, 6 Oct 2020 13:22:35 -0400 Subject: renamed again --- fpm/src/fpm/cmd/new.f90 | 164 ++++++++++++++++++++++++++++++++++++++++++++++++ fpm/src/fpm_cmd_new.f90 | 164 ------------------------------------------------ 2 files changed, 164 insertions(+), 164 deletions(-) create mode 100644 fpm/src/fpm/cmd/new.f90 delete mode 100644 fpm/src/fpm_cmd_new.f90 diff --git a/fpm/src/fpm/cmd/new.f90 b/fpm/src/fpm/cmd/new.f90 new file mode 100644 index 0000000..03d9ed4 --- /dev/null +++ b/fpm/src/fpm/cmd/new.f90 @@ -0,0 +1,164 @@ +module fpm_cmd_new + +use fpm_command_line, only : fpm_new_settings +use fpm_environment, only : run, OS_LINUX, OS_MACOS, OS_WINDOWS +use fpm_filesystem, only : join_path, exists, basename, mkdir +use,intrinsic :: iso_fortran_env, only : stderr=>error_unit +implicit none +private +public :: cmd_new + +contains + +subroutine cmd_new(settings) ! --with-executable F --with-test F ' +type(fpm_new_settings), intent(in) :: settings +character(len=:),allocatable :: bname ! baeename of NAME +character(len=:),allocatable :: message(:) +character(len=:),allocatable :: littlefile(:) + + call mkdir(settings%name) ! make new directory + call run('cd '//settings%name) ! change to new directory as a test. System dependent potentially + !! NOTE: need some system routines to handle filenames like "." like realpath() or getcwd(). + bname=basename(settings%name) + + !! weird gfortran bug?? lines truncated to concatenated string length, not 80 + !! hit some weird gfortran bug when littlefile data was an argument to warnwrite(3f), ok when a variable + + call warnwrite(join_path(settings%name, '.gitignore'), ['build/*']) ! create NAME/.gitignore file + + littlefile=[character(len=80) :: '# '//bname, 'My cool new project!'] + + call warnwrite(join_path(settings%name, 'README.md'), littlefile) ! create NAME/README.md + + message=[character(len=80) :: & ! start building NAME/fpm.toml + &'name = "'//bname//'" ', & + &'version = "0.1.0" ', & + &'license = "license" ', & + &'author = "Jane Doe" ', & + &'maintainer = "jane.doe@example.com" ', & + &'copyright = "2020 Jane Doe" ', & + &' ', & + &''] + + if(settings%with_lib)then + call mkdir(join_path(settings%name,'src') ) + message=[character(len=80) :: message, & ! create next section of fpm.toml + &'[library] ', & + &'source-dir="src" ', & + &''] + littlefile=[character(len=80) :: & ! create placeholder module src/bname.f90 + &'module '//bname, & + &' implicit none', & + &' private', & + &'', & + &' public :: say_hello', & + &'contains', & + &' subroutine say_hello', & + &' print *, "Hello, '//bname//'!"', & + &' end subroutine say_hello', & + &'end module '//bname] + ! a proposed alternative default + call warnwrite(join_path(settings%name, 'src', bname//'.f90'), littlefile) ! create NAME/src/NAME.f90 + endif + + if(settings%with_test)then + call mkdir(join_path(settings%name, 'test')) ! create NAME/test or stop + message=[character(len=80) :: message, & ! create next section of fpm.toml + &'[[test]] ', & + &'name="runTests" ', & + &'source-dir="test" ', & + &'main="main.f90" ', & + &''] + + littlefile=[character(len=80) :: & + &'program main', & + &'implicit none', & + &'', & + &'print *, "Put some tests in here!"', & + &'end program main'] + ! a proposed alternative default a little more substantive + call warnwrite(join_path(settings%name, 'test/main.f90'), littlefile) ! create NAME/test/main.f90 + endif + + if(settings%with_executable)then + call mkdir(join_path(settings%name, 'app')) ! create NAME/app or stop + message=[character(len=80) :: message, & ! create next section of fpm.toml + &'[[executable]] ', & + &'name="'//bname//'" ', & + &'source-dir="app" ', & + &'main="main.f90" ', & + &''] + + littlefile=[character(len=80) :: & + &'program main', & + &' use '//bname//', only: say_hello', & + &'', & + &' implicit none', & + &'', & + &' call say_hello', & + &'end program main'] + call warnwrite(join_path(settings%name, 'app/main.f90'), littlefile) + endif + + call warnwrite(join_path(settings%name, 'fpm.toml'), message) ! now that built it write NAME/fpm.toml + + call run('cd ' // settings%name // ';git init') ! assumes these commands work on all systems and git(1) is installed +contains + +subroutine warnwrite(fname,data) +character(len=*),intent(in) :: fname +character(len=*),intent(in) :: data(:) + + if(.not.exists(fname))then + call filewrite(fname,data) + else + write(stderr,'(*(g0,1x))')'fpm::new',fname,'already exists. Not overwriting' + endif + +end subroutine warnwrite + +subroutine filewrite(filename,filedata) +use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit +! write filedata to file filename +character(len=*),intent(in) :: filename +character(len=*),intent(in) :: filedata(:) +integer :: lun, i, ios +character(len=256) :: message + + message=' ' + ios=0 + if(filename.ne.' ')then + open(file=filename, & + & newunit=lun, & + & form='formatted', & ! FORM = FORMATTED | UNFORMATTED + & access='sequential', & ! ACCESS = SEQUENTIAL | DIRECT | STREAM + & action='write', & ! ACTION = READ|WRITE | READWRITE + & position='rewind', & ! POSITION = ASIS | REWIND | APPEND + & status='new', & ! STATUS = NEW | REPLACE | OLD | SCRATCH | UNKNOWN + & iostat=ios, & + & iomsg=message) + else + lun=stdout + ios=0 + endif + if(ios.ne.0)then + write(stderr,'(*(a:,1x))')'*filewrite* error:',filename,trim(message) + error stop 1 + endif + do i=1,size(filedata) ! write file + write(lun,'(a)',iostat=ios,iomsg=message)trim(filedata(i)) + if(ios.ne.0)then + write(stderr,'(*(a:,1x))')'*filewrite* error:',filename,trim(message) + error stop 4 + endif + enddo + close(unit=lun,iostat=ios,iomsg=message) ! close file + if(ios.ne.0)then + write(stderr,'(*(a:,1x))')'*filewrite* error:',trim(message) + error stop 2 + endif +end subroutine filewrite + +end subroutine cmd_new + +end module fpm_cmd_new diff --git a/fpm/src/fpm_cmd_new.f90 b/fpm/src/fpm_cmd_new.f90 deleted file mode 100644 index 03d9ed4..0000000 --- a/fpm/src/fpm_cmd_new.f90 +++ /dev/null @@ -1,164 +0,0 @@ -module fpm_cmd_new - -use fpm_command_line, only : fpm_new_settings -use fpm_environment, only : run, OS_LINUX, OS_MACOS, OS_WINDOWS -use fpm_filesystem, only : join_path, exists, basename, mkdir -use,intrinsic :: iso_fortran_env, only : stderr=>error_unit -implicit none -private -public :: cmd_new - -contains - -subroutine cmd_new(settings) ! --with-executable F --with-test F ' -type(fpm_new_settings), intent(in) :: settings -character(len=:),allocatable :: bname ! baeename of NAME -character(len=:),allocatable :: message(:) -character(len=:),allocatable :: littlefile(:) - - call mkdir(settings%name) ! make new directory - call run('cd '//settings%name) ! change to new directory as a test. System dependent potentially - !! NOTE: need some system routines to handle filenames like "." like realpath() or getcwd(). - bname=basename(settings%name) - - !! weird gfortran bug?? lines truncated to concatenated string length, not 80 - !! hit some weird gfortran bug when littlefile data was an argument to warnwrite(3f), ok when a variable - - call warnwrite(join_path(settings%name, '.gitignore'), ['build/*']) ! create NAME/.gitignore file - - littlefile=[character(len=80) :: '# '//bname, 'My cool new project!'] - - call warnwrite(join_path(settings%name, 'README.md'), littlefile) ! create NAME/README.md - - message=[character(len=80) :: & ! start building NAME/fpm.toml - &'name = "'//bname//'" ', & - &'version = "0.1.0" ', & - &'license = "license" ', & - &'author = "Jane Doe" ', & - &'maintainer = "jane.doe@example.com" ', & - &'copyright = "2020 Jane Doe" ', & - &' ', & - &''] - - if(settings%with_lib)then - call mkdir(join_path(settings%name,'src') ) - message=[character(len=80) :: message, & ! create next section of fpm.toml - &'[library] ', & - &'source-dir="src" ', & - &''] - littlefile=[character(len=80) :: & ! create placeholder module src/bname.f90 - &'module '//bname, & - &' implicit none', & - &' private', & - &'', & - &' public :: say_hello', & - &'contains', & - &' subroutine say_hello', & - &' print *, "Hello, '//bname//'!"', & - &' end subroutine say_hello', & - &'end module '//bname] - ! a proposed alternative default - call warnwrite(join_path(settings%name, 'src', bname//'.f90'), littlefile) ! create NAME/src/NAME.f90 - endif - - if(settings%with_test)then - call mkdir(join_path(settings%name, 'test')) ! create NAME/test or stop - message=[character(len=80) :: message, & ! create next section of fpm.toml - &'[[test]] ', & - &'name="runTests" ', & - &'source-dir="test" ', & - &'main="main.f90" ', & - &''] - - littlefile=[character(len=80) :: & - &'program main', & - &'implicit none', & - &'', & - &'print *, "Put some tests in here!"', & - &'end program main'] - ! a proposed alternative default a little more substantive - call warnwrite(join_path(settings%name, 'test/main.f90'), littlefile) ! create NAME/test/main.f90 - endif - - if(settings%with_executable)then - call mkdir(join_path(settings%name, 'app')) ! create NAME/app or stop - message=[character(len=80) :: message, & ! create next section of fpm.toml - &'[[executable]] ', & - &'name="'//bname//'" ', & - &'source-dir="app" ', & - &'main="main.f90" ', & - &''] - - littlefile=[character(len=80) :: & - &'program main', & - &' use '//bname//', only: say_hello', & - &'', & - &' implicit none', & - &'', & - &' call say_hello', & - &'end program main'] - call warnwrite(join_path(settings%name, 'app/main.f90'), littlefile) - endif - - call warnwrite(join_path(settings%name, 'fpm.toml'), message) ! now that built it write NAME/fpm.toml - - call run('cd ' // settings%name // ';git init') ! assumes these commands work on all systems and git(1) is installed -contains - -subroutine warnwrite(fname,data) -character(len=*),intent(in) :: fname -character(len=*),intent(in) :: data(:) - - if(.not.exists(fname))then - call filewrite(fname,data) - else - write(stderr,'(*(g0,1x))')'fpm::new',fname,'already exists. Not overwriting' - endif - -end subroutine warnwrite - -subroutine filewrite(filename,filedata) -use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit -! write filedata to file filename -character(len=*),intent(in) :: filename -character(len=*),intent(in) :: filedata(:) -integer :: lun, i, ios -character(len=256) :: message - - message=' ' - ios=0 - if(filename.ne.' ')then - open(file=filename, & - & newunit=lun, & - & form='formatted', & ! FORM = FORMATTED | UNFORMATTED - & access='sequential', & ! ACCESS = SEQUENTIAL | DIRECT | STREAM - & action='write', & ! ACTION = READ|WRITE | READWRITE - & position='rewind', & ! POSITION = ASIS | REWIND | APPEND - & status='new', & ! STATUS = NEW | REPLACE | OLD | SCRATCH | UNKNOWN - & iostat=ios, & - & iomsg=message) - else - lun=stdout - ios=0 - endif - if(ios.ne.0)then - write(stderr,'(*(a:,1x))')'*filewrite* error:',filename,trim(message) - error stop 1 - endif - do i=1,size(filedata) ! write file - write(lun,'(a)',iostat=ios,iomsg=message)trim(filedata(i)) - if(ios.ne.0)then - write(stderr,'(*(a:,1x))')'*filewrite* error:',filename,trim(message) - error stop 4 - endif - enddo - close(unit=lun,iostat=ios,iomsg=message) ! close file - if(ios.ne.0)then - write(stderr,'(*(a:,1x))')'*filewrite* error:',trim(message) - error stop 2 - endif -end subroutine filewrite - -end subroutine cmd_new - -end module fpm_cmd_new -- cgit v1.2.3 From 14db0715c4bc7a03f806858e990d63a95827dd5a Mon Sep 17 00:00:00 2001 From: "init current directory[i]" Date: Tue, 6 Oct 2020 13:31:07 -0400 Subject: renamed and cleaner help text --- fpm/src/fpm_command_line.f90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index 5b9d93a..1a7e4ab 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -416,8 +416,9 @@ contains ' ', & ' The "new" subcommand creates a directory and runs the command ', & ' "git init" in that directory and makes an example "fpm.toml" ', & - ' file, a src/ directory, and optionally a test/ and app/ ', & - ' directory with trivial example Fortran source files. ', & + ' file. and src/ directory and a sample module file. It ', & + ' optionally also creates a test/ and app/ directory with ', & + ' trivial example Fortran program sources. ', & ' ', & ' Remember to update the information in the sample "fpm.toml" ', & ' file with such information as your name and e-mail address. ', & -- cgit v1.2.3 From 9d16e5d7292109efb036697224c08faf28de2d2c Mon Sep 17 00:00:00 2001 From: "init current directory[i]" Date: Sun, 11 Oct 2020 05:25:45 -0400 Subject: change cd NEWNAME;git init to cd NEWNAME &&git init per @LKedward --- fpm/src/fpm/cmd/new.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/fpm/src/fpm/cmd/new.f90 b/fpm/src/fpm/cmd/new.f90 index 03d9ed4..fc4c93e 100644 --- a/fpm/src/fpm/cmd/new.f90 +++ b/fpm/src/fpm/cmd/new.f90 @@ -102,7 +102,7 @@ character(len=:),allocatable :: littlefile(:) call warnwrite(join_path(settings%name, 'fpm.toml'), message) ! now that built it write NAME/fpm.toml - call run('cd ' // settings%name // ';git init') ! assumes these commands work on all systems and git(1) is installed + call run('cd ' // settings%name // '&&git init') ! assumes these commands work on all systems and git(1) is installed contains subroutine warnwrite(fname,data) -- cgit v1.2.3