From d49ae3c5582b85113770bbc52e104063bf960d20 Mon Sep 17 00:00:00 2001 From: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> Date: Fri, 2 Apr 2021 10:57:01 +0200 Subject: Use default to instead of master to reference the repository HEAD --- CONTRIBUTING.md | 5 ++--- manifest-reference.md | 2 +- src/fpm/cmd/new.f90 | 2 +- 3 files changed, 4 insertions(+), 5 deletions(-) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 2cc1ffa..a4a2147 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -8,8 +8,7 @@ help address your problem, evaluate changes, and guide you through your pull requests. By contributing to *fpm*, you certify that you own or are allowed to share the -content of your contribution under the -[fpm license](https://github.com/fortran-lang/fpm/blob/master/LICENSE). +content of your contribution under the [fpm license](LICENSE). * [Style](#style) * [Reporting a bug](#reporting-a-bug) @@ -35,7 +34,7 @@ Before opening a bug report: 1. Check if the issue has already been reported ([issues](https://github.com/fortran-lang/fpm/issues)). 2. Check if it is still an issue or it has been fixed? - Try to reproduce it with the latest version from the master branch. + Try to reproduce it with the latest version from the default branch. 3. Isolate the problem and create a minimal test case. A good bug report should include all information needed to reproduce the bug. diff --git a/manifest-reference.md b/manifest-reference.md index 1a33dc1..f92bd22 100644 --- a/manifest-reference.md +++ b/manifest-reference.md @@ -403,7 +403,7 @@ To use a specific upstream branch declare the *branch* name with ```toml [dependencies] -toml-f = { git = "https://github.com/toml-f/toml-f", branch = "master" } +toml-f = { git = "https://github.com/toml-f/toml-f", branch = "main" } ``` Alternatively, reference tags by using the *tag* entry diff --git a/src/fpm/cmd/new.f90 b/src/fpm/cmd/new.f90 index 5149bea..773d7a7 100644 --- a/src/fpm/cmd/new.f90 +++ b/src/fpm/cmd/new.f90 @@ -347,7 +347,7 @@ character(len=:,kind=tfc),allocatable :: littlefile(:) &' # git repository. ',& &' # ',& &' # You can be specific about which version of a dependency you would ',& - &' # like. By default the latest master master branch is used. You can ',& + &' # like. By default the latest default branch is used. You can ',& &' # optionally specify a branch, a tag or a commit value. ',& &' # ',& &' # So here are several alternates for specifying a remote dependency (you ',& -- cgit v1.2.3 From f28ac3e31cb0e5c558a4fdb4ce5f461ce1c83ea4 Mon Sep 17 00:00:00 2001 From: LKedward Date: Thu, 8 Apr 2021 15:26:29 +0100 Subject: Separate target type for c objects --- src/fpm_backend.f90 | 8 ++++++-- src/fpm_targets.f90 | 9 ++++++--- 2 files changed, 12 insertions(+), 5 deletions(-) diff --git a/src/fpm_backend.f90 b/src/fpm_backend.f90 index 74cef61..be4c4c9 100644 --- a/src/fpm_backend.f90 +++ b/src/fpm_backend.f90 @@ -30,8 +30,8 @@ module fpm_backend use fpm_environment, only: run use fpm_filesystem, only: dirname, join_path, exists, mkdir use fpm_model, only: fpm_model_t -use fpm_targets, only: build_target_t, build_target_ptr, & - FPM_TARGET_OBJECT, FPM_TARGET_ARCHIVE, FPM_TARGET_EXECUTABLE +use fpm_targets, only: build_target_t, build_target_ptr, FPM_TARGET_OBJECT, & + FPM_TARGET_C_OBJECT, FPM_TARGET_ARCHIVE, FPM_TARGET_EXECUTABLE use fpm_strings, only: string_cat @@ -241,6 +241,10 @@ subroutine build_target(model,target) call run(model%fortran_compiler//" -c " // target%source%file_name // target%compile_flags & // " -o " // target%output_file) + case (FPM_TARGET_C_OBJECT) + call run(model%c_compiler//" -c " // target%source%file_name & + // " -o " // target%output_file) + case (FPM_TARGET_EXECUTABLE) call run(model%fortran_compiler// " " // target%compile_flags & diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index 02bb600..6d4d8f0 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -35,7 +35,8 @@ implicit none private public FPM_TARGET_UNKNOWN, FPM_TARGET_EXECUTABLE, & - FPM_TARGET_ARCHIVE, FPM_TARGET_OBJECT + FPM_TARGET_ARCHIVE, FPM_TARGET_OBJECT, & + FPM_TARGET_C_OBJECT public build_target_t, build_target_ptr public targets_from_sources, resolve_module_dependencies public resolve_target_linking, add_target, add_dependency @@ -50,7 +51,8 @@ integer, parameter :: FPM_TARGET_EXECUTABLE = 1 integer, parameter :: FPM_TARGET_ARCHIVE = 2 !> Target type is compiled object integer, parameter :: FPM_TARGET_OBJECT = 3 - +!> Target type is c compiled object +integer, parameter :: FPM_TARGET_C_OBJECT = 4 !> Wrapper type for constructing arrays of `[[build_target_t]]` pointers type build_target_ptr @@ -194,7 +196,8 @@ subroutine build_target_list(targets,model) case (FPM_UNIT_MODULE,FPM_UNIT_SUBMODULE,FPM_UNIT_SUBPROGRAM,FPM_UNIT_CSOURCE) call add_target(targets,source = sources(i), & - type = FPM_TARGET_OBJECT,& + type = merge(FPM_TARGET_C_OBJECT,FPM_TARGET_OBJECT,& + sources(i)%unit_type==FPM_UNIT_CSOURCE), & output_file = get_object_name(sources(i))) if (with_lib .and. sources(i)%unit_scope == FPM_SCOPE_LIB) then -- cgit v1.2.3 From c957b27d275ebd575b5d49599c14e7252765f3ce Mon Sep 17 00:00:00 2001 From: LKedward Date: Thu, 8 Apr 2021 15:27:07 +0100 Subject: Select c compiler based on fortran compiler id --- src/fpm.f90 | 5 ++++- src/fpm_compiler.f90 | 27 +++++++++++++++++++++++++++ src/fpm_model.f90 | 3 +++ 3 files changed, 34 insertions(+), 1 deletion(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 31b68ff..653f8be 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -9,7 +9,7 @@ use fpm_filesystem, only: is_dir, join_path, number_of_rows, list_files, exists, use fpm_model, only: fpm_model_t, srcfile_t, show_model, & FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, FPM_SCOPE_DEP, & FPM_SCOPE_APP, FPM_SCOPE_EXAMPLE, FPM_SCOPE_TEST -use fpm_compiler, only: get_module_flags, is_unknown_compiler +use fpm_compiler, only: get_module_flags, is_unknown_compiler, get_default_c_compiler use fpm_sources, only: add_executable_sources, add_sources_from_dir @@ -62,6 +62,8 @@ subroutine build_model(model, settings, package, error) model%fortran_compiler = settings%compiler endif + call get_default_c_compiler(model%fortran_compiler, model%c_compiler) + if (is_unknown_compiler(model%fortran_compiler)) then write(*, '(*(a:,1x))') & "", "Unknown compiler", model%fortran_compiler, "requested!", & @@ -178,6 +180,7 @@ subroutine build_model(model, settings, package, error) if (settings%verbose) then write(*,*)' BUILD_NAME: ',settings%build_name write(*,*)' COMPILER: ',settings%compiler + write(*,*)' C COMPILER: ',model%c_compiler write(*,*)' COMPILER OPTIONS: ', model%fortran_compile_flags write(*,*)' INCLUDE DIRECTORIES: [', string_cat(model%include_dirs,','),']' end if diff --git a/src/fpm_compiler.f90 b/src/fpm_compiler.f90 index 36041bf..76aedcc 100644 --- a/src/fpm_compiler.f90 +++ b/src/fpm_compiler.f90 @@ -336,6 +336,33 @@ subroutine get_module_flags(compiler, modpath, flags) end subroutine get_module_flags +subroutine get_default_c_compiler(f_compiler, c_compiler) + character(len=*), intent(in) :: f_compiler + character(len=:), allocatable, intent(out) :: c_compiler + integer(compiler_enum) :: id + + id = get_compiler_id(f_compiler) + + select case(id) + case default + c_compiler = 'gcc' + + case(id_intel_classic) + c_compiler = 'icc' + + case(id_intel_llvm) + c_compiler = 'icx' + + case(id_flang) + c_compiler='clang' + + case(id_ibmxl) + c_compiler='xlc' + + end select + +end subroutine get_default_c_compiler + function get_compiler_id(compiler) result(id) character(len=*), intent(in) :: compiler integer(kind=compiler_enum) :: id diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index bfb0115..5c575fc 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -117,6 +117,9 @@ type :: fpm_model_t !> Command line name to invoke fortran compiler character(:), allocatable :: fortran_compiler + !> Command line name to invoke c compiler + character(:), allocatable :: c_compiler + !> Command line flags passed to fortran for compilation character(:), allocatable :: fortran_compile_flags -- cgit v1.2.3 From f85a458f7ab35ee53ab188b3679e05fae5e5819c Mon Sep 17 00:00:00 2001 From: LKedward Date: Thu, 8 Apr 2021 15:40:33 +0100 Subject: Fix include flags for c objects --- src/fpm_backend.f90 | 2 +- src/fpm_targets.f90 | 13 ++++++++----- 2 files changed, 9 insertions(+), 6 deletions(-) diff --git a/src/fpm_backend.f90 b/src/fpm_backend.f90 index be4c4c9..8c4cf40 100644 --- a/src/fpm_backend.f90 +++ b/src/fpm_backend.f90 @@ -242,7 +242,7 @@ subroutine build_target(model,target) // " -o " // target%output_file) case (FPM_TARGET_C_OBJECT) - call run(model%c_compiler//" -c " // target%source%file_name & + call run(model%c_compiler//" -c " // target%source%file_name // target%compile_flags & // " -o " // target%output_file) case (FPM_TARGET_EXECUTABLE) diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index 6d4d8f0..7a06877 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -445,7 +445,7 @@ subroutine resolve_target_linking(targets, model) integer :: i character(:), allocatable :: global_link_flags - character(:), allocatable :: global_compile_flags + character(:), allocatable :: global_include_flags if (size(targets) == 0) return @@ -455,17 +455,16 @@ subroutine resolve_target_linking(targets, model) allocate(character(0) :: global_link_flags) end if - global_compile_flags = model%fortran_compile_flags - if (allocated(model%link_libraries)) then if (size(model%link_libraries) > 0) then global_link_flags = global_link_flags // " -l" // string_cat(model%link_libraries," -l") end if end if + allocate(character(0) :: global_include_flags) if (allocated(model%include_dirs)) then if (size(model%include_dirs) > 0) then - global_compile_flags = global_compile_flags // & + global_include_flags = global_include_flags // & & " -I" // string_cat(model%include_dirs," -I") end if end if @@ -474,7 +473,11 @@ subroutine resolve_target_linking(targets, model) associate(target => targets(i)%ptr) - target%compile_flags = global_compile_flags + if (target%target_type /= FPM_TARGET_C_OBJECT) then + target%compile_flags = model%fortran_compile_flags//" "//global_include_flags + else + target%compile_flags = global_include_flags + end if allocate(target%link_objects(0)) -- cgit v1.2.3 From 836a652f85b505493673ef2b3adc4703060ef10b Mon Sep 17 00:00:00 2001 From: LKedward Date: Fri, 9 Apr 2021 14:30:46 +0100 Subject: Change fallback C compiler equal to Fortran compiler --- src/fpm_compiler.f90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/fpm_compiler.f90 b/src/fpm_compiler.f90 index 76aedcc..dcfd101 100644 --- a/src/fpm_compiler.f90 +++ b/src/fpm_compiler.f90 @@ -344,8 +344,6 @@ subroutine get_default_c_compiler(f_compiler, c_compiler) id = get_compiler_id(f_compiler) select case(id) - case default - c_compiler = 'gcc' case(id_intel_classic) c_compiler = 'icc' @@ -359,6 +357,9 @@ subroutine get_default_c_compiler(f_compiler, c_compiler) case(id_ibmxl) c_compiler='xlc' + case default + ! Fall-back to using Fortran compiler + c_compiler = f_compiler end select end subroutine get_default_c_compiler -- cgit v1.2.3 From 8c5763bdabe2374b83c83b8285bdc9c28730ae54 Mon Sep 17 00:00:00 2001 From: LKedward Date: Fri, 9 Apr 2021 14:32:57 +0100 Subject: Allow specifying C compiler with environment variable FPM_C_COMPILER --- src/fpm.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 653f8be..805132c 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -4,7 +4,7 @@ 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_dependency, only : new_dependency_tree -use fpm_environment, only: run +use fpm_environment, only: run, get_env use fpm_filesystem, only: is_dir, join_path, number_of_rows, list_files, exists, basename use fpm_model, only: fpm_model_t, srcfile_t, show_model, & FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, FPM_SCOPE_DEP, & @@ -63,6 +63,7 @@ subroutine build_model(model, settings, package, error) endif call get_default_c_compiler(model%fortran_compiler, model%c_compiler) + model%c_compiler = get_env('FPM_C_COMPILER',model%c_compiler) if (is_unknown_compiler(model%fortran_compiler)) then write(*, '(*(a:,1x))') & -- cgit v1.2.3 From 079e7da06181a6dc9cee6f8f3b1b1c4ebde9e573 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Fri, 9 Apr 2021 14:48:03 +0100 Subject: Update compiler ids from rebase. --- src/fpm_compiler.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/fpm_compiler.f90 b/src/fpm_compiler.f90 index dcfd101..75bd3be 100644 --- a/src/fpm_compiler.f90 +++ b/src/fpm_compiler.f90 @@ -345,10 +345,10 @@ subroutine get_default_c_compiler(f_compiler, c_compiler) select case(id) - case(id_intel_classic) + case(id_intel_classic_nix, id_intel_classic_mac, id_intel_classic_windows, id_intel_classic_unknown) c_compiler = 'icc' - case(id_intel_llvm) + case(id_intel_llvm_nix,id_intel_llvm_windows, id_intel_llvm_unknown) c_compiler = 'icx' case(id_flang) -- cgit v1.2.3 From a49b0177f8d7ca74b3bfaa325fd37ee614975367 Mon Sep 17 00:00:00 2001 From: LKedward Date: Mon, 12 Apr 2021 16:39:29 +0100 Subject: Add: external-modules key to build table for non-fpm modules --- src/fpm.f90 | 5 +++++ src/fpm/manifest/build.f90 | 16 ++++++++++++++-- src/fpm_model.f90 | 10 ++++++++++ src/fpm_targets.f90 | 10 ++++++++-- test/fpm_test/test_module_dependencies.f90 | 9 +++++++++ 5 files changed, 46 insertions(+), 4 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 31b68ff..a62ffe0 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -51,6 +51,7 @@ subroutine build_model(model, settings, package, error) allocate(model%include_dirs(0)) allocate(model%link_libraries(0)) + allocate(model%external_modules(0)) call new_dependency_tree(model%deps, cache=join_path("build", "cache.toml")) call model%deps%add(package, error) @@ -171,6 +172,10 @@ subroutine build_model(model, settings, package, error) if (allocated(dependency%build%link)) then model%link_libraries = [model%link_libraries, dependency%build%link] end if + + if (allocated(dependency%build%external_modules)) then + model%external_modules = [model%external_modules, dependency%build%external_modules] + end if end associate end do if (allocated(error)) return diff --git a/src/fpm/manifest/build.f90 b/src/fpm/manifest/build.f90 index d96974f..c9b3f44 100644 --- a/src/fpm/manifest/build.f90 +++ b/src/fpm/manifest/build.f90 @@ -34,6 +34,9 @@ module fpm_manifest_build !> Libraries to link against type(string_t), allocatable :: link(:) + !> External modules to use + type(string_t), allocatable :: external_modules(:) + contains !> Print information on this instance @@ -87,6 +90,9 @@ contains call get_value(table, "link", self%link, error) if (allocated(error)) return + call get_value(table, "external-modules", self%external_modules, error) + if (allocated(error)) return + end subroutine new_build_config @@ -110,7 +116,7 @@ contains do ikey = 1, size(list) select case(list(ikey)%key) - case("auto-executables", "auto-examples", "auto-tests", "link") + case("auto-executables", "auto-examples", "auto-tests", "link", "external-modules") continue case default @@ -135,7 +141,7 @@ contains !> Verbosity of the printout integer, intent(in), optional :: verbosity - integer :: pr, ilink + integer :: pr, ilink, imod character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)' if (present(verbosity)) then @@ -156,6 +162,12 @@ contains write(unit, fmt) " - " // self%link(ilink)%s end do end if + if (allocated(self%external_modules)) then + write(unit, fmt) " - external modules" + do imod = 1, size(self%external_modules) + write(unit, fmt) " - " // self%external_modules(imod)%s + end do + end if end subroutine info diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index bfb0115..ec366d6 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -129,6 +129,9 @@ type :: fpm_model_t !> Native libraries to link against type(string_t), allocatable :: link_libraries(:) + !> External modules used + type(string_t), allocatable :: external_modules(:) + !> Project dependencies type(dependency_tree_t) :: deps @@ -276,6 +279,13 @@ function info_model(model) result(s) if (i < size(model%link_libraries)) s = s // ", " end do s = s // "]" + ! type(string_t), allocatable :: external_modules(:) + s = s // ", external_modules=[" + do i = 1, size(model%external_modules) + s = s // '"' // model%external_modules(i)%s // '"' + if (i < size(model%external_modules)) s = s // ", " + end do + s = s // "]" ! type(dependency_tree_t) :: deps ! TODO: print `dependency_tree_t` properly, which should become part of the ! model, not imported from another file diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index 02bb600..671145d 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -121,7 +121,7 @@ subroutine targets_from_sources(targets,model,error) call build_target_list(targets,model) - call resolve_module_dependencies(targets,error) + call resolve_module_dependencies(targets,model%external_modules,error) if (allocated(error)) return call resolve_target_linking(targets,model) @@ -345,8 +345,9 @@ end subroutine add_dependency !> a source file in the package of the correct scope, then a __fatal error__ !> is returned by the procedure and model construction fails. !> -subroutine resolve_module_dependencies(targets,error) +subroutine resolve_module_dependencies(targets,external_modules,error) type(build_target_ptr), intent(inout), target :: targets(:) + type(string_t), intent(in) :: external_modules(:) type(error_t), allocatable, intent(out) :: error type(build_target_ptr) :: dep @@ -364,6 +365,11 @@ subroutine resolve_module_dependencies(targets,error) cycle end if + if (targets(i)%ptr%source%modules_used(j)%s .in. external_modules) then + ! Dependency satisfied in system-installed module + cycle + end if + if (any(targets(i)%ptr%source%unit_scope == & [FPM_SCOPE_APP, FPM_SCOPE_EXAMPLE, FPM_SCOPE_TEST])) then dep%ptr => & diff --git a/test/fpm_test/test_module_dependencies.f90 b/test/fpm_test/test_module_dependencies.f90 index f193646..992f227 100644 --- a/test/fpm_test/test_module_dependencies.f90 +++ b/test/fpm_test/test_module_dependencies.f90 @@ -67,6 +67,7 @@ contains type(build_target_ptr), allocatable :: targets(:) model%output_directory = '' + allocate(model%external_modules(0)) allocate(model%packages(1)) allocate(model%packages(1)%sources(2)) @@ -137,6 +138,7 @@ contains character(:), allocatable :: scope_str model%output_directory = '' + allocate(model%external_modules(0)) allocate(model%packages(1)) allocate(model%packages(1)%sources(2)) @@ -196,6 +198,7 @@ contains type(build_target_ptr), allocatable :: targets(:) model%output_directory = '' + allocate(model%external_modules(0)) allocate(model%packages(1)) allocate(model%packages(1)%sources(1)) @@ -249,6 +252,7 @@ contains character(:), allocatable :: scope_str model%output_directory = '' + allocate(model%external_modules(0)) allocate(model%packages(1)) allocate(model%packages(1)%sources(3)) @@ -308,6 +312,7 @@ contains type(build_target_ptr), allocatable :: targets(:) model%output_directory = '' + allocate(model%external_modules(0)) allocate(model%packages(1)) allocate(model%packages(1)%sources(2)) @@ -335,6 +340,7 @@ contains type(build_target_ptr), allocatable :: targets(:) model%output_directory = '' + allocate(model%external_modules(0)) allocate(model%packages(1)) allocate(model%packages(1)%sources(2)) @@ -361,6 +367,7 @@ contains type(build_target_ptr), allocatable :: targets(:) model%output_directory = '' + allocate(model%external_modules(0)) allocate(model%packages(1)) allocate(model%packages(1)%sources(2)) @@ -388,6 +395,7 @@ contains type(build_target_ptr), allocatable :: targets(:) model%output_directory = '' + allocate(model%external_modules(0)) allocate(model%packages(1)) allocate(model%packages(1)%sources(2)) @@ -507,6 +515,7 @@ contains type(build_target_ptr), allocatable :: targets(:) model%output_directory = '' + allocate(model%external_modules(0)) allocate(model%packages(1)) allocate(model%packages(1)%sources(2)) -- cgit v1.2.3 From 2c0975b729e173042bec227e10fb6bf40a1609dd Mon Sep 17 00:00:00 2001 From: LKedward Date: Mon, 12 Apr 2021 16:54:35 +0100 Subject: Update: manifest-reference with new external-modules key --- manifest-reference.md | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/manifest-reference.md b/manifest-reference.md index 1a33dc1..89bf1db 100644 --- a/manifest-reference.md +++ b/manifest-reference.md @@ -33,6 +33,8 @@ Every manifest file consists of the following sections: Toggle automatic discovery of executables - [*link*](#link-external-libraries): Link with external dependencies + - [*external-modules*](#use-system-installed-modules): + Specify modules used that are not within your fpm package - Target sections: - [*library*](#library-configuration) Configuration of the library target @@ -353,6 +355,26 @@ In this case the order of the libraries matters: link = ["blas", "lapack"] ``` +## Use system-installed modules + +To use modules that are not defined within your fpm package or its dependencies, +specify the module name using the *external-modules* key in the *build* table. + +*Example:* + +```toml +[build] +external-modules = "netcdff" +``` + +Multiple external modules can be specified as a list. + +*Example:* + +```toml +[build] +external-modules = ["netcdff","h5lt"] +``` ## Automatic target discovery -- cgit v1.2.3 From d407ee0b992dbcde8663c62c06e72f57ea0691a9 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Wed, 14 Apr 2021 17:46:34 +0100 Subject: Update manifest-reference.md Co-authored-by: Milan Curcic --- manifest-reference.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/manifest-reference.md b/manifest-reference.md index 89bf1db..e8998a9 100644 --- a/manifest-reference.md +++ b/manifest-reference.md @@ -364,7 +364,7 @@ specify the module name using the *external-modules* key in the *build* table. ```toml [build] -external-modules = "netcdff" +external-modules = "netcdf" ``` Multiple external modules can be specified as a list. -- cgit v1.2.3 From d97abb90435501bd392ff3269633a409cfea1cb0 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Wed, 14 Apr 2021 18:52:25 +0100 Subject: Update manifest-reference.md Co-authored-by: Milan Curcic --- manifest-reference.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/manifest-reference.md b/manifest-reference.md index e8998a9..7b85708 100644 --- a/manifest-reference.md +++ b/manifest-reference.md @@ -373,7 +373,7 @@ Multiple external modules can be specified as a list. ```toml [build] -external-modules = ["netcdff","h5lt"] +external-modules = ["netcdf", "h5lt"] ``` ## Automatic target discovery -- cgit v1.2.3 From 5eb1ee4c21426db55400752bffca5beda47e8c39 Mon Sep 17 00:00:00 2001 From: LKedward Date: Thu, 15 Apr 2021 14:52:35 +0100 Subject: Update: manifest reference with note about external module directories --- manifest-reference.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/manifest-reference.md b/manifest-reference.md index 89bf1db..a77c2d2 100644 --- a/manifest-reference.md +++ b/manifest-reference.md @@ -360,6 +360,10 @@ link = ["blas", "lapack"] To use modules that are not defined within your fpm package or its dependencies, specify the module name using the *external-modules* key in the *build* table. +> __Important:__ *fpm* cannot automatically locate external module files; it is the responsibility +> of the user to specify the necessary include directories using compiler flags such that +> the compiler can locate external module files during compilation. + *Example:* ```toml -- cgit v1.2.3 From a540c83d9e303acd6fece95927c49fa8d2565366 Mon Sep 17 00:00:00 2001 From: gareth-nx <82561769+gareth-nx@users.noreply.github.com> Date: Fri, 16 Apr 2021 03:30:43 +1000 Subject: Minor edits to README.md (#440) Make clear that this snippet must be run in the fpm directory to work. Otherwise it fails, because it needs to find the fpm.toml file. --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index d4e9002..290b586 100644 --- a/README.md +++ b/README.md @@ -101,7 +101,7 @@ This guide explains the process of building *fpm* on a platform for the first ti To build *fpm* without a prior *fpm* version a single source file version is available at each release. -To build manually using the single source distribution use +To build manually using the single source distribution, run the following code (from within the current directory) ``` mkdir _tmp -- cgit v1.2.3 From 0ac5f5bef94c8f12caa64f19fe6cb5026a5535c0 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Thu, 15 Apr 2021 14:59:15 -0500 Subject: feat(ar): use lib instead of ar on Windows if ar isn't available --- src/fpm.f90 | 33 +++++++++++++++++++++++++-------- src/fpm_backend.f90 | 36 ++++++++++++++++++------------------ src/fpm_model.f90 | 7 +++++-- 3 files changed, 48 insertions(+), 28 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 31b68ff..3e2b518 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -4,7 +4,7 @@ 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_dependency, only : new_dependency_tree -use fpm_environment, only: run +use fpm_environment, only: get_os_type, run, OS_UNKNOWN, OS_WINDOWS use fpm_filesystem, only: is_dir, join_path, number_of_rows, list_files, exists, basename use fpm_model, only: fpm_model_t, srcfile_t, show_model, & FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, FPM_SCOPE_DEP, & @@ -62,6 +62,23 @@ subroutine build_model(model, settings, package, error) model%fortran_compiler = settings%compiler endif + associate(os_type => get_os_type()) + if (os_type /= OS_WINDOWS .and. os_type /= OS_UNKNOWN) then + model%archiver = "ar -rs " + else + block + integer :: estat + + call execute_command_line("ar --version", exitstat=estat) + if (estat /= 0) then + model%archiver = "lib /OUT:" + else + model%archiver = "ar -rs " + end if + end block + end if + end associate + if (is_unknown_compiler(model%fortran_compiler)) then write(*, '(*(a:,1x))') & "", "Unknown compiler", model%fortran_compiler, "requested!", & @@ -147,7 +164,7 @@ subroutine build_model(model, settings, package, error) if (.not.allocated(model%packages(i)%sources)) allocate(model%packages(i)%sources(0)) if (allocated(dependency%library)) then - + if (allocated(dependency%library%source_dir)) then lib_dir = join_path(dep%proj_dir, dependency%library%source_dir) if (is_dir(lib_dir)) then @@ -165,7 +182,7 @@ subroutine build_model(model, settings, package, error) end if end do end if - + end if if (allocated(dependency%build%link)) then @@ -178,8 +195,8 @@ subroutine build_model(model, settings, package, error) if (settings%verbose) then write(*,*)' BUILD_NAME: ',settings%build_name write(*,*)' COMPILER: ',settings%compiler - write(*,*)' COMPILER OPTIONS: ', model%fortran_compile_flags - write(*,*)' INCLUDE DIRECTORIES: [', string_cat(model%include_dirs,','),']' + write(*,*)' COMPILER OPTIONS: ', model%fortran_compile_flags + write(*,*)' INCLUDE DIRECTORIES: [', string_cat(model%include_dirs,','),']' end if ! Check for duplicate modules @@ -190,7 +207,7 @@ subroutine build_model(model, settings, package, error) end subroutine build_model ! Check for duplicate modules -subroutine check_modules_for_duplicates(model, duplicates_found) +subroutine check_modules_for_duplicates(model, duplicates_found) type(fpm_model_t), intent(in) :: model integer :: maxsize integer :: i,j,k,l,m,modi @@ -370,7 +387,7 @@ subroutine cmd_run(settings,test) ! Check all names are valid ! or no name and found more than one file - toomany= size(settings%name).eq.0 .and. size(executables).gt.1 + toomany= size(settings%name).eq.0 .and. size(executables).gt.1 if ( any(.not.found) & & .or. & & ( (toomany .and. .not.test) .or. (toomany .and. settings%runner .ne. '') ) & @@ -420,7 +437,7 @@ subroutine cmd_run(settings,test) end if end do endif - contains + contains subroutine compact_list_all() integer, parameter :: LINE_WIDTH = 80 integer :: i, j, nCol diff --git a/src/fpm_backend.f90 b/src/fpm_backend.f90 index 74cef61..f84d2ea 100644 --- a/src/fpm_backend.f90 +++ b/src/fpm_backend.f90 @@ -1,28 +1,28 @@ !># Build backend -!> Uses a list of `[[build_target_ptr]]` and a valid `[[fpm_model]]` instance +!> Uses a list of `[[build_target_ptr]]` and a valid `[[fpm_model]]` instance !> to schedule and execute the compilation and linking of package targets. -!> +!> !> The package build process (`[[build_package]]`) comprises three steps: !> !> 1. __Target sorting:__ topological sort of the target dependency graph (`[[sort_target]]`) !> 2. __Target scheduling:__ group targets into schedule regions based on the sorting (`[[schedule_targets]]`) !> 3. __Target building:__ generate targets by compilation or linking -!> +!> !> @note If compiled with OpenMP, targets will be build in parallel where possible. !> !>### Incremental compilation -!> The backend process supports *incremental* compilation whereby targets are not +!> The backend process supports *incremental* compilation whereby targets are not !> re-compiled if their corresponding dependencies have not been modified. -!> +!> !> - Source-based targets (*i.e.* objects) are not re-compiled if the corresponding source !> file is unmodified AND all of the target dependencies are not marked for re-compilation !> -!> - Link targets (*i.e.* executables and libraries) are not re-compiled if the +!> - Link targets (*i.e.* executables and libraries) are not re-compiled if the !> target output file already exists AND all of the target dependencies are not marked for !> re-compilation !> !> Source file modification is determined by a file digest (hash) which is calculated during -!> the source parsing phase ([[fpm_source_parsing]]) and cached to disk after a target is +!> the source parsing phase ([[fpm_source_parsing]]) and cached to disk after a target is !> successfully generated. !> module fpm_backend @@ -32,7 +32,7 @@ use fpm_filesystem, only: dirname, join_path, exists, mkdir use fpm_model, only: fpm_model_t use fpm_targets, only: build_target_t, build_target_ptr, & FPM_TARGET_OBJECT, FPM_TARGET_ARCHIVE, FPM_TARGET_EXECUTABLE - + use fpm_strings, only: string_cat implicit none @@ -58,9 +58,9 @@ subroutine build_package(targets,model) ! Perform depth-first topological sort of targets do i=1,size(targets) - + call sort_target(targets(i)%ptr) - + end do ! Construct build schedule queue @@ -78,20 +78,20 @@ subroutine build_package(targets,model) end do end do - + end subroutine build_package -!> Topologically sort a target for scheduling by +!> Topologically sort a target for scheduling by !> recursing over its dependencies. -!> +!> !> Checks disk-cached source hashes to determine if objects are !> up-to-date. Up-to-date sources are tagged as skipped. !> -!> On completion, `target` should either be marked as +!> On completion, `target` should either be marked as !> sorted (`target%sorted=.true.`) or skipped (`target%skip=.true.`) !> -!> If `target` is marked as sorted, `target%schedule` should be an +!> If `target` is marked as sorted, `target%schedule` should be an !> integer greater than zero indicating the region for scheduling !> recursive subroutine sort_target(target) @@ -162,7 +162,7 @@ recursive subroutine sort_target(target) end if end do - + ! Mark flag as processed: either sorted or skipped target%sorted = .not.target%skip @@ -242,12 +242,12 @@ subroutine build_target(model,target) // " -o " // target%output_file) case (FPM_TARGET_EXECUTABLE) - + call run(model%fortran_compiler// " " // target%compile_flags & //" "//target%link_flags// " -o " // target%output_file) case (FPM_TARGET_ARCHIVE) - call run("ar -rs " // target%output_file // " " // string_cat(target%link_objects," ")) + call run(model%archiver // target%output_file // " " // string_cat(target%link_objects," ")) end select diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index bfb0115..84f70d4 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -1,6 +1,6 @@ !># The fpm package model !> -!> Defines the fpm model data types which encapsulate all information +!> Defines the fpm model data types which encapsulate all information !> required to correctly build a package and its dependencies. !> !> The process (see `[[build_model(subroutine)]]`) for generating a valid `[[fpm_model]]` involves @@ -117,6 +117,9 @@ type :: fpm_model_t !> Command line name to invoke fortran compiler character(:), allocatable :: fortran_compiler + !> Command line to invoke for creating static library + character(:), allocatable :: archiver + !> Command line flags passed to fortran for compilation character(:), allocatable :: fortran_compile_flags @@ -128,7 +131,7 @@ type :: fpm_model_t !> Native libraries to link against type(string_t), allocatable :: link_libraries(:) - + !> Project dependencies type(dependency_tree_t) :: deps -- cgit v1.2.3 From c58584e725b904d74743c6eb2b07e372fc539b39 Mon Sep 17 00:00:00 2001 From: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> Date: Sat, 17 Apr 2021 13:01:18 +0200 Subject: Allow usage of response files with ar --- src/fpm_backend.f90 | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/src/fpm_backend.f90 b/src/fpm_backend.f90 index 74cef61..4b19e25 100644 --- a/src/fpm_backend.f90 +++ b/src/fpm_backend.f90 @@ -33,7 +33,7 @@ use fpm_model, only: fpm_model_t use fpm_targets, only: build_target_t, build_target_ptr, & FPM_TARGET_OBJECT, FPM_TARGET_ARCHIVE, FPM_TARGET_EXECUTABLE -use fpm_strings, only: string_cat +use fpm_strings, only: string_t implicit none @@ -247,7 +247,8 @@ subroutine build_target(model,target) //" "//target%link_flags// " -o " // target%output_file) case (FPM_TARGET_ARCHIVE) - call run("ar -rs " // target%output_file // " " // string_cat(target%link_objects," ")) + call write_response_file(target%output_file//".resp" ,target%link_objects) + call run("ar -rs " // target%output_file // " @" // target%output_file//".resp") end select @@ -259,4 +260,19 @@ subroutine build_target(model,target) end subroutine build_target +!> Response files allow to read command line options from files. +!> Whitespace is used to separate the arguments, we will use newlines +!> as separator to create readable response files which can be inspected +!> in case of errors. +subroutine write_response_file(name, argv) + character(len=*), intent(in) :: name + type(string_t), intent(in) :: argv(:) + integer :: iarg, io + open(file=name, newunit=io) + do iarg = 1, size(argv) + write(io, '(a)') argv(iarg)%s + end do + close(io) +end subroutine write_response_file + end module fpm_backend -- cgit v1.2.3 From 7a8f33721974cb66d44834229aff6dd4e2031eda Mon Sep 17 00:00:00 2001 From: LKedward Date: Sat, 17 Apr 2021 12:27:09 +0100 Subject: Use response files on Windows but with unix_path --- src/fpm_backend.f90 | 20 ++++++++++++++------ 1 file changed, 14 insertions(+), 6 deletions(-) diff --git a/src/fpm_backend.f90 b/src/fpm_backend.f90 index 4b19e25..21e7983 100644 --- a/src/fpm_backend.f90 +++ b/src/fpm_backend.f90 @@ -27,13 +27,13 @@ !> module fpm_backend -use fpm_environment, only: run -use fpm_filesystem, only: dirname, join_path, exists, mkdir +use fpm_environment, only: run, get_os_type, OS_WINDOWS +use fpm_filesystem, only: dirname, join_path, exists, mkdir, unix_path use fpm_model, only: fpm_model_t use fpm_targets, only: build_target_t, build_target_ptr, & FPM_TARGET_OBJECT, FPM_TARGET_ARCHIVE, FPM_TARGET_EXECUTABLE -use fpm_strings, only: string_t +use fpm_strings, only: string_cat, string_t implicit none @@ -247,8 +247,16 @@ subroutine build_target(model,target) //" "//target%link_flags// " -o " // target%output_file) case (FPM_TARGET_ARCHIVE) - call write_response_file(target%output_file//".resp" ,target%link_objects) - call run("ar -rs " // target%output_file // " @" // target%output_file//".resp") + + select case (get_os_type()) + case (OS_WINDOWS) + call write_response_file(target%output_file//".resp" ,target%link_objects) + call run("ar -rs " // target%output_file // " @" // target%output_file//".resp") + + case default + call run("ar -rs " // target%output_file // " " // string_cat(target%link_objects," ")) + + end select end select @@ -270,7 +278,7 @@ subroutine write_response_file(name, argv) integer :: iarg, io open(file=name, newunit=io) do iarg = 1, size(argv) - write(io, '(a)') argv(iarg)%s + write(io, '(a)') unix_path(argv(iarg)%s) end do close(io) end subroutine write_response_file -- cgit v1.2.3 From 975e9cbe2506ac46e607080710e0314dabb07dd5 Mon Sep 17 00:00:00 2001 From: LKedward Date: Sat, 17 Apr 2021 12:47:50 +0100 Subject: Remove coarray flag from intel debug settings --- src/fpm_compiler.f90 | 4 ---- 1 file changed, 4 deletions(-) diff --git a/src/fpm_compiler.f90 b/src/fpm_compiler.f90 index a499bb9..d647d4b 100644 --- a/src/fpm_compiler.f90 +++ b/src/fpm_compiler.f90 @@ -239,7 +239,6 @@ subroutine get_debug_compile_flags(id, flags) & -g& & -assume byterecl& & -traceback& - & -coarray=single& &' case(id_intel_classic_mac) flags = '& @@ -260,7 +259,6 @@ subroutine get_debug_compile_flags(id, flags) & /Z7& & /assume:byterecl& & /traceback& - & /Qcoarray:single& &' case(id_intel_llvm_nix, id_intel_llvm_unknown) flags = '& @@ -271,7 +269,6 @@ subroutine get_debug_compile_flags(id, flags) & -g& & -assume byterecl& & -traceback& - & -coarray=single& &' case(id_intel_llvm_windows) flags = '& @@ -281,7 +278,6 @@ subroutine get_debug_compile_flags(id, flags) & /Od& & /Z7& & /assume:byterecl& - & /Qcoarray:single& &' case(id_nag) flags = '& -- cgit v1.2.3 From faced2359ff7bf1c003aaf3990d006fde1124186 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Mon, 19 Apr 2021 19:19:24 -0500 Subject: refactor(get_archiver): extract to it's own function --- src/fpm.f90 | 19 ++----------------- src/fpm_environment.f90 | 27 ++++++++++++++++++++++++--- 2 files changed, 26 insertions(+), 20 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 3e2b518..fa2087d 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -4,7 +4,7 @@ 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_dependency, only : new_dependency_tree -use fpm_environment, only: get_os_type, run, OS_UNKNOWN, OS_WINDOWS +use fpm_environment, only: get_archiver, run use fpm_filesystem, only: is_dir, join_path, number_of_rows, list_files, exists, basename use fpm_model, only: fpm_model_t, srcfile_t, show_model, & FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, FPM_SCOPE_DEP, & @@ -62,22 +62,7 @@ subroutine build_model(model, settings, package, error) model%fortran_compiler = settings%compiler endif - associate(os_type => get_os_type()) - if (os_type /= OS_WINDOWS .and. os_type /= OS_UNKNOWN) then - model%archiver = "ar -rs " - else - block - integer :: estat - - call execute_command_line("ar --version", exitstat=estat) - if (estat /= 0) then - model%archiver = "lib /OUT:" - else - model%archiver = "ar -rs " - end if - end block - end if - end associate + model%archiver = get_archiver() if (is_unknown_compiler(model%fortran_compiler)) then write(*, '(*(a:,1x))') & diff --git a/src/fpm_environment.f90 b/src/fpm_environment.f90 index 0408ec4..cde1780 100644 --- a/src/fpm_environment.f90 +++ b/src/fpm_environment.f90 @@ -1,5 +1,5 @@ !> This module contains procedures that interact with the programming environment. -!! +!! !! * [get_os_type] -- Determine the OS type !! * [get_env] -- return the value of an environment variable module fpm_environment @@ -9,6 +9,7 @@ module fpm_environment public :: os_is_unix public :: run public :: get_env + public :: get_archiver integer, parameter, public :: OS_UNKNOWN = 0 integer, parameter, public :: OS_LINUX = 1 @@ -110,7 +111,7 @@ contains end if end function get_os_type - !> Compare the output of [[get_os_type]] or the optional + !> Compare the output of [[get_os_type]] or the optional !! passed INTEGER value to the value for OS_WINDOWS !! and return .TRUE. if they match and .FALSE. otherwise logical function os_is_unix(os) result(unix) @@ -150,7 +151,7 @@ contains function get_env(NAME,DEFAULT) result(VALUE) implicit none !> name of environment variable to get the value of - character(len=*),intent(in) :: NAME + character(len=*),intent(in) :: NAME !> default value to return if the requested value is undefined or blank character(len=*),intent(in),optional :: DEFAULT !> the returned value @@ -182,4 +183,24 @@ contains if(VALUE.eq.''.and.present(DEFAULT))VALUE=DEFAULT end function get_env + function get_archiver() result(archiver) + character(:), allocatable :: archiver + + associate(os_type => get_os_type()) + if (os_type /= OS_WINDOWS .and. os_type /= OS_UNKNOWN) then + archiver = "ar -rs " + else + block + integer :: estat + + call execute_command_line("ar --version", exitstat=estat) + if (estat /= 0) then + archiver = "lib /OUT:" + else + archiver = "ar -rs " + end if + end block + end if + end associate + end function end module fpm_environment -- cgit v1.2.3 From bd347aab82173186c10b681d7d99399c15d9db18 Mon Sep 17 00:00:00 2001 From: Brian Callahan Date: Thu, 29 Apr 2021 15:51:27 -0400 Subject: Identify OpenBSD --- src/fpm_command_line.f90 | 3 ++- src/fpm_compiler.f90 | 3 ++- src/fpm_environment.f90 | 9 ++++++++- src/fpm_filesystem.f90 | 10 +++++----- test/new_test/new_test.f90 | 6 +++--- 5 files changed, 20 insertions(+), 11 deletions(-) diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 9e9a572..2a2ecf5 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -25,7 +25,7 @@ module fpm_command_line use fpm_environment, only : get_os_type, get_env, & OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, & - OS_CYGWIN, OS_SOLARIS, OS_FREEBSD + OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD use M_CLI2, only : set_args, lget, sget, unnamed, remaining, specified use fpm_strings, only : lower, split, fnv_1a use fpm_filesystem, only : basename, canon_path, to_fortran_name @@ -129,6 +129,7 @@ contains case (OS_CYGWIN); os_type = "OS Type: Cygwin" case (OS_SOLARIS); os_type = "OS Type: Solaris" case (OS_FREEBSD); os_type = "OS Type: FreeBSD" + case (OS_OPENBSD); os_type = "OS Type: OpenBSD" case (OS_UNKNOWN); os_type = "OS Type: Unknown" case default ; os_type = "OS Type: UNKNOWN" end select diff --git a/src/fpm_compiler.f90 b/src/fpm_compiler.f90 index ca0f4d7..ff311f7 100644 --- a/src/fpm_compiler.f90 +++ b/src/fpm_compiler.f90 @@ -35,7 +35,8 @@ use fpm_environment, only: & OS_WINDOWS, & OS_CYGWIN, & OS_SOLARIS, & - OS_FREEBSD + OS_FREEBSD, & + OS_OPENBSD implicit none public :: is_unknown_compiler public :: get_module_flags diff --git a/src/fpm_environment.f90 b/src/fpm_environment.f90 index cde1780..345f6ab 100644 --- a/src/fpm_environment.f90 +++ b/src/fpm_environment.f90 @@ -18,12 +18,13 @@ module fpm_environment integer, parameter, public :: OS_CYGWIN = 4 integer, parameter, public :: OS_SOLARIS = 5 integer, parameter, public :: OS_FREEBSD = 6 + integer, parameter, public :: OS_OPENBSD = 7 contains !> Determine the OS type integer function get_os_type() result(r) !! !! Returns one of OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, OS_CYGWIN, - !! OS_SOLARIS, OS_FREEBSD. + !! OS_SOLARIS, OS_FREEBSD, OS_OPENBSD. !! !! At first, the environment variable `OS` is checked, which is usually !! found on Windows. Then, `OSTYPE` is read in and compared with common @@ -84,6 +85,12 @@ contains r = OS_FREEBSD return end if + + ! OpenBSD + if (index(val, 'OpenBSD') > 0 .or. index(val, 'openbsd') > 0) then + r = OS_OPENBSD + return + end if end if ! Linux diff --git a/src/fpm_filesystem.f90 b/src/fpm_filesystem.f90 index 6acd383..28c3b33 100644 --- a/src/fpm_filesystem.f90 +++ b/src/fpm_filesystem.f90 @@ -4,7 +4,7 @@ module fpm_filesystem use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit use fpm_environment, only: get_os_type, & OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, & - OS_CYGWIN, OS_SOLARIS, OS_FREEBSD + OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD use fpm_strings, only: f_string, replace, string_t, split implicit none private @@ -192,7 +192,7 @@ logical function is_dir(dir) select case (get_os_type()) - case (OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD) + case (OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD) call execute_command_line("test -d " // dir , exitstat=stat) case (OS_WINDOWS) @@ -214,7 +214,7 @@ function join_path(a1,a2,a3,a4,a5) result(path) character(len=1) :: filesep select case (get_os_type()) - case (OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD) + case (OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD) filesep = '/' case (OS_WINDOWS) filesep = '\' @@ -283,7 +283,7 @@ subroutine mkdir(dir) if (is_dir(dir)) return select case (get_os_type()) - case (OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD) + case (OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD) call execute_command_line('mkdir -p ' // dir, exitstat=stat) write (*, '(" + ",2a)') 'mkdir -p ' // dir @@ -322,7 +322,7 @@ recursive subroutine list_files(dir, files, recurse) allocate (temp_file, source=get_temp_filename()) select case (get_os_type()) - case (OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD) + case (OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD) call execute_command_line('ls -A ' // dir // ' > ' // temp_file, & exitstat=stat) case (OS_WINDOWS) diff --git a/test/new_test/new_test.f90 b/test/new_test/new_test.f90 index 3c8c453..a6c859b 100644 --- a/test/new_test/new_test.f90 +++ b/test/new_test/new_test.f90 @@ -4,7 +4,7 @@ use fpm_filesystem, only : is_dir, list_files, exists, windows_path, join_path, dirname use fpm_strings, only : string_t, operator(.in.) use fpm_environment, only : run, get_os_type -use fpm_environment, only : OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_WINDOWS +use fpm_environment, only : OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD, OS_WINDOWS implicit none type(string_t), allocatable :: file_names(:) integer :: i, j, k @@ -49,7 +49,7 @@ logical :: IS_OS_WINDOWS !! o DOS versus POSIX filenames is_os_windows=.false. select case (get_os_type()) - case (OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD) + case (OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD) call execute_command_line('rm -rf fpm_scratch_*',exitstat=estat,cmdstat=cstat,cmdmsg=message) path=cmdpath case (OS_WINDOWS) @@ -145,7 +145,7 @@ logical :: IS_OS_WINDOWS ! clean up scratch files; might want an option to leave them for inspection select case (get_os_type()) - case (OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD) + case (OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD) call execute_command_line('rm -rf fpm_scratch_*',exitstat=estat,cmdstat=cstat,cmdmsg=message) case (OS_WINDOWS) call execute_command_line('rmdir fpm_scratch_* /s /q',exitstat=estat,cmdstat=cstat,cmdmsg=message) -- cgit v1.2.3 From 7b53e5a39eda2c5ecbe6c99787c4a707d163d3ef Mon Sep 17 00:00:00 2001 From: Jason Miller Date: Thu, 29 Apr 2021 23:17:33 +0200 Subject: docs: fix typo in README (#465) --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 290b586..69ae2ee 100644 --- a/README.md +++ b/README.md @@ -60,7 +60,7 @@ or from [miniconda](https://docs.conda.io/en/latest/miniconda.html). To setup *fpm* within Github actions for automated testing, you can use the [fortran-lang/setup-fpm](https://github.com/marketplace/actions/setup-fpm) action. -#### Bootstraping on other platforms +#### Bootstrapping on other platforms For other platforms and architectures have a look at the [bootstrapping instructions](#bootstrapping-instructions). -- cgit v1.2.3 From 3c9e6105c8458f6a59d2edc6fd7f2e79c18de943 Mon Sep 17 00:00:00 2001 From: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> Date: Thu, 27 May 2021 20:04:51 +0200 Subject: Allow fpm to change the working directory --- ci/run_tests.sh | 144 +++++++++++++++++++++-------------------------- src/fpm_command_line.f90 | 42 +++++++++++--- src/fpm_os.F90 | 79 ++++++++++++++++++++++++++ 3 files changed, 176 insertions(+), 89 deletions(-) create mode 100644 src/fpm_os.F90 diff --git a/ci/run_tests.sh b/ci/run_tests.sh index ffcd9c2..a31fa18 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -13,86 +13,70 @@ fi pushd example_packages/ rm -rf ./*/build -pushd hello_world -"$fpm" build -"$fpm" run --target hello_world -"$fpm" run -popd - -pushd hello_fpm -"$fpm" build -"$fpm" run --target hello_fpm -popd - -pushd circular_test -"$fpm" build -popd - -pushd circular_example -"$fpm" build -popd - -pushd hello_complex -"$fpm" build -"$fpm" test -"$fpm" run --target say_Hello -"$fpm" run --target say_goodbye -"$fpm" test --target greet_test -"$fpm" test --target farewell_test -popd - -pushd hello_complex_2 -"$fpm" build -"$fpm" run --target say_hello_world -"$fpm" run --target say_goodbye -"$fpm" test --target greet_test -"$fpm" test --target farewell_test -popd - -pushd with_examples -"$fpm" build -"$fpm" run --example --target demo-prog -"$fpm" run --target demo-prog -popd - -pushd auto_discovery_off -"$fpm" build -"$fpm" run --target auto_discovery_off -"$fpm" test --target my_test -test ! -x ./build/gfortran_*/app/unused -test ! -x ./build/gfortran_*/test/unused_test -popd - -pushd with_c -"$fpm" build -"$fpm" run --target with_c -popd - -pushd submodules -"$fpm" build -popd - -pushd program_with_module -"$fpm" build -"$fpm" run --target Program_with_module -popd - -pushd link_executable -"$fpm" build -"$fpm" run --target gomp_test -popd - -pushd fortran_includes -"$fpm" build -popd - -pushd c_includes -"$fpm" build -popd - -pushd c_header_only -"$fpm" build -popd +dir=hello_world +"$fpm" -C $dir build +"$fpm" -C $dir run --target hello_world +"$fpm" -C $dir run + +dir=hello_fpm +"$fpm" -C $dir build +"$fpm" -C $dir run --target hello_fpm + +dir=circular_test +"$fpm" -C $dir build + +dir=circular_example +"$fpm" -C $dir build + +dir=hello_complex +"$fpm" -C $dir build +"$fpm" -C $dir test +"$fpm" -C $dir run --target say_Hello +"$fpm" -C $dir run --target say_goodbye +"$fpm" -C $dir test --target greet_test +"$fpm" -C $dir test --target farewell_test + +dir=hello_complex_2 +"$fpm" -C $dir build +"$fpm" -C $dir run --target say_hello_world +"$fpm" -C $dir run --target say_goodbye +"$fpm" -C $dir test --target greet_test +"$fpm" -C $dir test --target farewell_test + +dir=with_examples +"$fpm" -C $dir build +"$fpm" -C $dir run --example --target demo-prog +"$fpm" -C $dir run --target demo-prog + +dir=auto_discovery_off +"$fpm" -C $dir build +"$fpm" -C $dir run --target auto_discovery_off +"$fpm" -C $dir test --target my_test +test ! -x $dir/build/gfortran_*/app/unused +test ! -x $dir/build/gfortran_*/test/unused_test + +dir=with_c +"$fpm" -C $dir build +"$fpm" -C $dir run --target with_c + +"$fpm" -C $dir build + +dir=program_with_module +"$fpm" -C $dir build +"$fpm" -C $dir run --target Program_with_module + +dir=link_executable +"$fpm" -C $dir build +"$fpm" -C $dir run --target gomp_test + +dir=fortran_includes +"$fpm" -C $dir build + +dir=c_includes +"$fpm" -C $dir build + +dir=c_header_only +"$fpm" -C $dir build # Cleanup rm -rf ./*/build diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 2a2ecf5..095a533 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -26,7 +26,9 @@ module fpm_command_line use fpm_environment, only : get_os_type, get_env, & OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, & OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD +use fpm_error, only : error_t use M_CLI2, only : set_args, lget, sget, unnamed, remaining, specified +use fpm_os, only : change_directory, get_current_directory use fpm_strings, only : lower, split, fnv_1a use fpm_filesystem, only : basename, canon_path, to_fortran_name use fpm_compiler, only : get_default_compile_flags @@ -119,6 +121,9 @@ contains integer :: i integer :: widest type(fpm_install_settings), allocatable :: install_settings + character(len=:), allocatable :: pwd_start, working_dir + character(len=:), allocatable :: common_args + type(error_t), allocatable :: error call set_help() ! text for --version switch, @@ -148,12 +153,16 @@ contains if(adjustl(cmdarg(1:1)) .ne. '-')exit enddo + call get_current_directory(pwd_start) + + common_args = '--directory:C " " ' + ! now set subcommand-specific help text and process commandline ! arguments. Then call subcommand routine select case(trim(cmdarg)) case('run') - call set_args('& + call set_args(common_args //'& & --target " " & & --list F & & --all F & @@ -206,7 +215,7 @@ contains & verbose=lget('verbose') ) case('build') - call set_args( '& + call set_args(common_args // '& & --profile " " & & --list F & & --show-model F & @@ -228,7 +237,7 @@ contains & verbose=lget('verbose') ) case('new') - call set_args('& + call set_args(common_args // '& & --src F & & --lib F & & --app F & @@ -298,7 +307,7 @@ contains endif case('help','manual') - call set_args('& + call set_args(common_args // '& & --verbose F & & ',help_help,version_text) if(size(unnamed).lt.2)then @@ -346,7 +355,8 @@ contains call printhelp(help_text) case('install') - call set_args('--profile " " --no-rebuild F --verbose F --prefix " " & + call set_args(common_args // '& + & --profile " " --no-rebuild F --verbose F --prefix " " & & --list F & & --compiler "'//get_env('FPM_COMPILER','gfortran')//'" & & --flag:: " "& @@ -371,7 +381,7 @@ contains call move_alloc(install_settings, cmd_settings) case('list') - call set_args('& + call set_args(common_args // '& & --list F& & --verbose F& &', help_list, version_text) @@ -380,7 +390,7 @@ contains call printhelp(help_list_dash) endif case('test') - call set_args('& + call set_args(common_args // '& & --target " " & & --list F& & --profile " "& @@ -425,7 +435,7 @@ contains & verbose=lget('verbose') ) case('update') - call set_args('--fetch-only F --verbose F --clean F', & + call set_args(common_args // ' --fetch-only F --verbose F --clean F', & help_update, version_text) if( size(unnamed) .gt. 1 )then @@ -441,7 +451,7 @@ contains case default - call set_args('& + call set_args(common_args // '& & --list F& & --verbose F& &', help_fpm, version_text) @@ -462,6 +472,18 @@ contains call printhelp(help_text) end select + + ! Change working directory if requested + working_dir = sget("directory") + if (len_trim(working_dir) > 0) then + call change_directory(working_dir, error) + if (allocated(error)) then + write(stderr, '(*(a, 1x))') "", error%message + stop 1 + end if + write(stdout, '(*(a))') "fpm: Entering directory '"//working_dir//"'" + end if + contains subroutine check_build_vals() @@ -674,6 +696,8 @@ contains ' install [--profile PROF] [--flag FFLAGS] [--no-rebuild] [--prefix PATH] [options]', & ' ', & 'SUBCOMMAND OPTIONS ', & + ' -C, --directory PATH', & + ' Change working directory to PATH before running any command', & ' --profile PROF selects the compilation profile for the build.',& ' Currently available profiles are "release" for',& ' high optimization and "debug" for full debug options.',& diff --git a/src/fpm_os.F90 b/src/fpm_os.F90 new file mode 100644 index 0000000..825df58 --- /dev/null +++ b/src/fpm_os.F90 @@ -0,0 +1,79 @@ +module fpm_os + use, intrinsic :: iso_c_binding, only : c_char, c_int, c_null_char + use fpm_error, only : error_t, fatal_error + implicit none + private + public :: change_directory, get_current_directory + +#ifndef _WIN32 + character(len=*), parameter :: pwd_env = "PWD" +#else + character(len=*), parameter :: pwd_env = "CD" +#endif + + interface + function chdir(path) result(stat) & +#ifndef _WIN32 + bind(C, name="chdir") +#else + bind(C, name="_chdir") +#endif + import :: c_char, c_int + character(kind=c_char, len=1), intent(in) :: path(*) + integer(c_int) :: stat + end function chdir + end interface + +contains + + subroutine change_directory(path, error) + character(len=*), intent(in) :: path + type(error_t), allocatable, intent(out) :: error + + character(kind=c_char, len=1), allocatable :: cpath(:) + integer :: stat + + allocate(cpath(len(path)+1)) + call f_c_character(path, cpath, len(path)+1) + + stat = chdir(cpath) + + if (stat /= 0) then + call fatal_error(error, "Failed to change directory to '"//path//"'") + end if + end subroutine change_directory + + subroutine f_c_character(rhs, lhs, len) + character(kind=c_char), intent(out) :: lhs(*) + character(len=*), intent(in) :: rhs + integer, intent(in) :: len + integer :: length + length = min(len-1, len_trim(rhs)) + + lhs(1:length) = transfer(rhs(1:length), lhs(1:length)) + lhs(length+1:length+1) = c_null_char + + end subroutine f_c_character + + subroutine get_current_directory(path) + character(len=:), allocatable, intent(out) :: path + + integer :: length, stat + + call get_environment_variable(pwd_env, length=length, status=stat) + if (stat /= 0) return + + allocate(character(len=length) :: path, stat=stat) + if (stat /= 0) return + + if (length > 0) then + call get_environment_variable(pwd_env, path, status=stat) + if (stat /= 0) then + deallocate(path) + return + end if + end if + + end subroutine get_current_directory + +end module fpm_os -- cgit v1.2.3 From 5855337167b53abcaa17452ea1c3c048acb34e09 Mon Sep 17 00:00:00 2001 From: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> Date: Thu, 27 May 2021 21:40:35 +0200 Subject: Automatically search for package manifest --- app/main.f90 | 77 ++++++++++++++++++++++++++++++++++++++++++++++++ src/fpm_command_line.f90 | 21 ++++--------- src/fpm_filesystem.f90 | 11 ++++++- src/fpm_os.F90 | 60 ++++++++++++++++++++++++++----------- 4 files changed, 135 insertions(+), 34 deletions(-) diff --git a/app/main.f90 b/app/main.f90 index 7476df6..5600f98 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -1,4 +1,5 @@ program main +use, intrinsic :: iso_fortran_env, only : error_unit, output_unit use fpm_command_line, only: & fpm_cmd_settings, & fpm_new_settings, & @@ -8,17 +9,57 @@ use fpm_command_line, only: & fpm_install_settings, & fpm_update_settings, & get_command_line_settings +use fpm_error, only: error_t +use fpm_filesystem, only: exists, parent_dir, join_path use fpm, only: cmd_build, cmd_run use fpm_cmd_install, only: cmd_install use fpm_cmd_new, only: cmd_new use fpm_cmd_update, only : cmd_update +use fpm_os, only: change_directory, get_current_directory implicit none class(fpm_cmd_settings), allocatable :: cmd_settings +type(error_t), allocatable :: error +character(len=:), allocatable :: pwd_start, pwd_working, working_dir, project_root call get_command_line_settings(cmd_settings) +call get_current_directory(pwd_start, error) +call handle_error(error) + +call get_working_dir(cmd_settings, working_dir) +if (allocated(working_dir)) then + ! Change working directory if requested + if (len_trim(working_dir) > 0) then + call change_directory(working_dir, error) + call handle_error(error) + + call get_current_directory(pwd_working, error) + call handle_error(error) + write(output_unit, '(*(a))') "fpm: Entering directory '"//pwd_working//"'" + else + pwd_working = pwd_start + end if +else + pwd_working = pwd_start +end if + +if (.not.has_manifest(pwd_working)) then + project_root = pwd_working + do while(.not.has_manifest(project_root)) + working_dir = parent_dir(project_root) + if (len(working_dir) == 0) exit + project_root = working_dir + end do + + if (has_manifest(project_root)) then + call change_directory(project_root, error) + call handle_error(error) + write(output_unit, '(*(a))') "fpm: Entering directory '"//project_root//"'" + end if +end if + select type(settings=>cmd_settings) type is (fpm_new_settings) call cmd_new(settings) @@ -34,4 +75,40 @@ type is (fpm_update_settings) call cmd_update(settings) end select +if (allocated(project_root)) then + write(output_unit, '(*(a))') "fpm: Leaving directory '"//project_root//"'" +end if + +if (pwd_start /= pwd_working) then + write(output_unit, '(*(a))') "fpm: Leaving directory '"//pwd_working//"'" +end if + +contains + + function has_manifest(dir) + character(len=*), intent(in) :: dir + logical :: has_manifest + + character(len=:), allocatable :: manifest + + has_manifest = exists(join_path(dir, "fpm.toml")) + end function has_manifest + + subroutine handle_error(error) + type(error_t), optional, intent(in) :: error + if (present(error)) then + write(error_unit, '("[Error]", 1x, a)') error%message + stop 1 + end if + end subroutine handle_error + + !> Save access to working directory in settings, in case setting have not been allocated + subroutine get_working_dir(settings, working_dir) + class(fpm_cmd_settings), optional, intent(in) :: settings + character(len=:), allocatable, intent(out) :: working_dir + if (present(settings)) then + working_dir = settings%working_dir + end if + end subroutine get_working_dir + end program main diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 095a533..f44bcd0 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -26,9 +26,7 @@ module fpm_command_line use fpm_environment, only : get_os_type, get_env, & OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, & OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD -use fpm_error, only : error_t use M_CLI2, only : set_args, lget, sget, unnamed, remaining, specified -use fpm_os, only : change_directory, get_current_directory use fpm_strings, only : lower, split, fnv_1a use fpm_filesystem, only : basename, canon_path, to_fortran_name use fpm_compiler, only : get_default_compile_flags @@ -48,6 +46,7 @@ public :: fpm_cmd_settings, & get_command_line_settings type, abstract :: fpm_cmd_settings + character(len=:), allocatable :: working_dir logical :: verbose=.true. end type @@ -121,9 +120,7 @@ contains integer :: i integer :: widest type(fpm_install_settings), allocatable :: install_settings - character(len=:), allocatable :: pwd_start, working_dir - character(len=:), allocatable :: common_args - type(error_t), allocatable :: error + character(len=:), allocatable :: common_args, working_dir call set_help() ! text for --version switch, @@ -153,8 +150,6 @@ contains if(adjustl(cmdarg(1:1)) .ne. '-')exit enddo - call get_current_directory(pwd_start) - common_args = '--directory:C " " ' ! now set subcommand-specific help text and process commandline @@ -473,15 +468,9 @@ contains end select - ! Change working directory if requested - working_dir = sget("directory") - if (len_trim(working_dir) > 0) then - call change_directory(working_dir, error) - if (allocated(error)) then - write(stderr, '(*(a, 1x))') "", error%message - stop 1 - end if - write(stdout, '(*(a))') "fpm: Entering directory '"//working_dir//"'" + if (allocated(cmd_settings)) then + working_dir = sget("directory") + call move_alloc(working_dir, cmd_settings%working_dir) end if contains diff --git a/src/fpm_filesystem.f90 b/src/fpm_filesystem.f90 index 28c3b33..c9c97dd 100644 --- a/src/fpm_filesystem.f90 +++ b/src/fpm_filesystem.f90 @@ -10,7 +10,7 @@ use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, private public :: basename, canon_path, dirname, is_dir, join_path, number_of_rows, read_lines, list_files, env_variable, & mkdir, exists, get_temp_filename, windows_path, unix_path, getline, delete_file, to_fortran_name - public :: fileopen, fileclose, filewrite, warnwrite + public :: fileopen, fileclose, filewrite, warnwrite, parent_dir integer, parameter :: LINE_BUFFER_LEN = 1000 @@ -184,6 +184,15 @@ function dirname(path) result (dir) end function dirname +!> Extract dirname from path +function parent_dir(path) result (dir) + character(*), intent(in) :: path + character(:), allocatable :: dir + + dir = path(1:scan(path,'/\',back=.true.)-1) + +end function parent_dir + !> test if a name matches an existing directory path logical function is_dir(dir) diff --git a/src/fpm_os.F90 b/src/fpm_os.F90 index 825df58..71663fe 100644 --- a/src/fpm_os.F90 +++ b/src/fpm_os.F90 @@ -1,5 +1,5 @@ module fpm_os - use, intrinsic :: iso_c_binding, only : c_char, c_int, c_null_char + use, intrinsic :: iso_c_binding, only : c_char, c_int, c_null_char, c_ptr, c_associated use fpm_error, only : error_t, fatal_error implicit none private @@ -22,6 +22,18 @@ module fpm_os character(kind=c_char, len=1), intent(in) :: path(*) integer(c_int) :: stat end function chdir + + function getcwd(buf, bufsize) result(path) & +#ifndef _WIN32 + bind(C, name="getcwd") +#else + bind(C, name="_getcwd") +#endif + import :: c_char, c_int, c_ptr + character(kind=c_char, len=1), intent(in) :: buf(*) + integer(c_int), value, intent(in) :: bufsize + type(c_ptr) :: path + end function getcwd end interface contains @@ -43,6 +55,25 @@ contains end if end subroutine change_directory + subroutine get_current_directory(path, error) + character(len=:), allocatable, intent(out) :: path + type(error_t), allocatable, intent(out) :: error + + character(kind=c_char, len=1), allocatable :: cpath(:) + integer(c_int), parameter :: buffersize = 1000_c_int + type(c_ptr) :: tmp + + allocate(cpath(buffersize)) + + tmp = getcwd(cpath, buffersize) + if (c_associated(tmp)) then + call c_f_character(cpath, path) + else + call fatal_error(error, "Failed to retrieve current directory") + end if + + end subroutine get_current_directory + subroutine f_c_character(rhs, lhs, len) character(kind=c_char), intent(out) :: lhs(*) character(len=*), intent(in) :: rhs @@ -55,25 +86,20 @@ contains end subroutine f_c_character - subroutine get_current_directory(path) - character(len=:), allocatable, intent(out) :: path + subroutine c_f_character(rhs, lhs) + character(kind=c_char), intent(in) :: rhs(*) + character(len=:), allocatable, intent(out) :: lhs - integer :: length, stat + integer :: ii - call get_environment_variable(pwd_env, length=length, status=stat) - if (stat /= 0) return - - allocate(character(len=length) :: path, stat=stat) - if (stat /= 0) return - - if (length > 0) then - call get_environment_variable(pwd_env, path, status=stat) - if (stat /= 0) then - deallocate(path) - return + do ii = 1, huge(ii) - 1 + if (rhs(ii) == c_null_char) then + exit end if - end if + end do + allocate(character(len=ii-1) :: lhs) + lhs = transfer(rhs(1:ii-1), lhs) - end subroutine get_current_directory + end subroutine c_f_character end module fpm_os -- cgit v1.2.3 From f6eed99634609851afe1af9d1c44412d966381fe Mon Sep 17 00:00:00 2001 From: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> Date: Thu, 3 Jun 2021 12:18:36 +0200 Subject: Only test changing directories for one package --- ci/run_tests.sh | 137 +++++++++++++++++++++++++++++++------------------------- 1 file changed, 76 insertions(+), 61 deletions(-) diff --git a/ci/run_tests.sh b/ci/run_tests.sh index a31fa18..9db88e8 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -16,67 +16,82 @@ rm -rf ./*/build dir=hello_world "$fpm" -C $dir build "$fpm" -C $dir run --target hello_world -"$fpm" -C $dir run - -dir=hello_fpm -"$fpm" -C $dir build -"$fpm" -C $dir run --target hello_fpm - -dir=circular_test -"$fpm" -C $dir build - -dir=circular_example -"$fpm" -C $dir build - -dir=hello_complex -"$fpm" -C $dir build -"$fpm" -C $dir test -"$fpm" -C $dir run --target say_Hello -"$fpm" -C $dir run --target say_goodbye -"$fpm" -C $dir test --target greet_test -"$fpm" -C $dir test --target farewell_test - -dir=hello_complex_2 -"$fpm" -C $dir build -"$fpm" -C $dir run --target say_hello_world -"$fpm" -C $dir run --target say_goodbye -"$fpm" -C $dir test --target greet_test -"$fpm" -C $dir test --target farewell_test - -dir=with_examples -"$fpm" -C $dir build -"$fpm" -C $dir run --example --target demo-prog -"$fpm" -C $dir run --target demo-prog - -dir=auto_discovery_off -"$fpm" -C $dir build -"$fpm" -C $dir run --target auto_discovery_off -"$fpm" -C $dir test --target my_test -test ! -x $dir/build/gfortran_*/app/unused -test ! -x $dir/build/gfortran_*/test/unused_test - -dir=with_c -"$fpm" -C $dir build -"$fpm" -C $dir run --target with_c - -"$fpm" -C $dir build - -dir=program_with_module -"$fpm" -C $dir build -"$fpm" -C $dir run --target Program_with_module - -dir=link_executable -"$fpm" -C $dir build -"$fpm" -C $dir run --target gomp_test - -dir=fortran_includes -"$fpm" -C $dir build - -dir=c_includes -"$fpm" -C $dir build - -dir=c_header_only -"$fpm" -C $dir build +"$fpm" -C $dir/app run + +pushd hello_fpm +"$fpm" build +"$fpm" run --target hello_fpm +popd + +pushd circular_test +"$fpm" build +popd + +pushd circular_example +"$fpm" build +popd + +pushd hello_complex +"$fpm" build +"$fpm" test +"$fpm" run --target say_Hello +"$fpm" run --target say_goodbye +"$fpm" test --target greet_test +"$fpm" test --target farewell_test +popd + +pushd hello_complex_2 +"$fpm" build +"$fpm" run --target say_hello_world +"$fpm" run --target say_goodbye +"$fpm" test --target greet_test +"$fpm" test --target farewell_test +popd + +pushd with_examples +"$fpm" build +"$fpm" run --example --target demo-prog +"$fpm" run --target demo-prog +popd + +pushd auto_discovery_off +"$fpm" build +"$fpm" run --target auto_discovery_off +"$fpm" test --target my_test +test ! -x ./build/gfortran_*/app/unused +test ! -x ./build/gfortran_*/test/unused_test +popd + +pushd with_c +"$fpm" build +"$fpm" run --target with_c +popd + +pushd submodules +"$fpm" build +popd + +pushd program_with_module +"$fpm" build +"$fpm" run --target Program_with_module +popd + +pushd link_executable +"$fpm" build +"$fpm" run --target gomp_test +popd + +pushd fortran_includes +"$fpm" build +popd + +pushd c_includes +"$fpm" build +popd + +pushd c_header_only +"$fpm" build +popd # Cleanup rm -rf ./*/build -- cgit v1.2.3