From 61ae1109dde23300aad5023ceadc75eadd9cfa80 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 31 Aug 2025 10:03:11 +0200 Subject: [PATCH 01/12] add build-dir CLI option --- src/fpm_command_line.f90 | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 69e92d1c4a..52c222aebf 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -89,6 +89,7 @@ module fpm_command_line character(len=:),allocatable :: cflag character(len=:),allocatable :: cxxflag character(len=:),allocatable :: ldflag + character(len=:),allocatable :: build_dir end type type, extends(fpm_build_settings) :: fpm_run_settings @@ -158,7 +159,7 @@ module fpm_command_line & 'test', 'runner', 'install', 'update', 'list', 'help', 'version', 'publish' ] character(len=:), allocatable :: val_runner, val_compiler, val_flag, val_cflag, val_cxxflag, val_ldflag, & - val_profile, val_runner_args, val_dump + val_profile, val_runner_args, val_dump, val_build_dir ! '12345678901234567890123456789012345678901234567890123456789012345678901234567890',& @@ -246,7 +247,7 @@ subroutine get_command_line_settings(cmd_settings) character(len=*), parameter :: fc_env = "FC", cc_env = "CC", ar_env = "AR", & & fflags_env = "FFLAGS", cflags_env = "CFLAGS", cxxflags_env = "CXXFLAGS", ldflags_env = "LDFLAGS", & & fc_default = "gfortran", cc_default = " ", ar_default = " ", flags_default = " ", & - & cxx_env = "CXX", cxx_default = " " + & cxx_env = "CXX", cxx_default = " ", build_dir_env = "BUILD_DIR", build_dir_default = "build" type(error_t), allocatable :: error call set_help() @@ -300,7 +301,8 @@ subroutine get_command_line_settings(cmd_settings) ' --flag:: "'//get_fpm_env(fflags_env, flags_default)//'"' // & ' --c-flag:: "'//get_fpm_env(cflags_env, flags_default)//'"' // & ' --cxx-flag:: "'//get_fpm_env(cxxflags_env, flags_default)//'"' // & - ' --link-flag:: "'//get_fpm_env(ldflags_env, flags_default)//'"' + ' --link-flag:: "'//get_fpm_env(ldflags_env, flags_default)//'"' // & + ' --build-dir "'//get_fpm_env(build_dir_env, build_dir_default)//'"' ! now set subcommand-specific help text and process commandline ! arguments. Then call subcommand routine @@ -363,6 +365,7 @@ subroutine get_command_line_settings(cmd_settings) & cflag=val_cflag, & & cxxflag=val_cxxflag, & & ldflag=val_ldflag, & + & build_dir=val_build_dir, & & example=lget('example'), & & list=lget('list'),& & build_tests=.false.,& @@ -403,6 +406,7 @@ subroutine get_command_line_settings(cmd_settings) & cflag=val_cflag, & & cxxflag=val_cxxflag, & & ldflag=val_ldflag, & + & build_dir=val_build_dir, & & list=lget('list'),& & show_model=lget('show-model'),& & build_tests=lget('tests'),& @@ -568,6 +572,7 @@ subroutine get_command_line_settings(cmd_settings) cflag=val_cflag, & cxxflag=val_cxxflag, & ldflag=val_ldflag, & + build_dir=val_build_dir, & no_rebuild=lget('no-rebuild'), & verbose=lget('verbose'))) call get_char_arg(install_settings%prefix, 'prefix') @@ -639,6 +644,7 @@ subroutine get_command_line_settings(cmd_settings) & cflag=val_cflag, & & cxxflag=val_cxxflag, & & ldflag=val_ldflag, & + & build_dir=val_build_dir, & & example=.false., & & list=lget('list'), & & build_tests=.true., & @@ -820,6 +826,7 @@ subroutine check_build_vals() val_cxxflag = " " // sget('cxx-flag') val_ldflag = " " // sget('link-flag') val_profile = sget('profile') + val_build_dir = sget('build-dir') end subroutine check_build_vals From 516c54ffff6955ca20d15dd0816dc95332c9b813 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 31 Aug 2025 10:08:27 +0200 Subject: [PATCH 02/12] replace hardcoded `build` paths --- src/fpm/cmd/export.f90 | 4 ++-- src/fpm/cmd/update.f90 | 17 ++++++++++------- src/fpm/dependency.f90 | 10 ++++++++-- src/fpm_backend.F90 | 2 +- src/fpm_backend_output.f90 | 14 ++++++++++++-- src/fpm_model.f90 | 11 +++++++++++ 6 files changed, 44 insertions(+), 14 deletions(-) diff --git a/src/fpm/cmd/export.f90 b/src/fpm/cmd/export.f90 index 8d05546fbc..efeab55dad 100644 --- a/src/fpm/cmd/export.f90 +++ b/src/fpm/cmd/export.f90 @@ -44,8 +44,8 @@ subroutine cmd_export(settings) if (len_trim(settings%dump_dependencies)>0) then !> Generate dependency tree - filename = join_path("build", "cache.toml") - call new_dependency_tree(deps, cache=filename, verbosity=merge(2, 1, settings%verbose)) + filename = join_path(settings%build_dir, "cache.toml") + call new_dependency_tree(deps, cache=filename, verbosity=merge(2, 1, settings%verbose), build_dir=settings%build_dir) call deps%add(package, error) call handle_error(error) diff --git a/src/fpm/cmd/update.f90 b/src/fpm/cmd/update.f90 index a78473b3a9..adec3f232d 100644 --- a/src/fpm/cmd/update.f90 +++ b/src/fpm/cmd/update.f90 @@ -1,5 +1,5 @@ module fpm_cmd_update - use fpm_command_line, only : fpm_update_settings + use fpm_command_line, only : fpm_update_settings, get_fpm_env use fpm_dependency, only : dependency_tree_t, new_dependency_tree use fpm_error, only : error_t, fpm_stop use fpm_filesystem, only : exists, mkdir, join_path, delete_file, filewrite @@ -20,21 +20,24 @@ subroutine cmd_update(settings) type(dependency_tree_t) :: deps type(error_t), allocatable :: error integer :: ii - character(len=:), allocatable :: cache + character(len=:), allocatable :: cache, build_dir call get_package_data(package, "fpm.toml", error, apply_defaults=.true.) call handle_error(error) - if (.not. exists("build")) then - call mkdir("build") - call filewrite(join_path("build", ".gitignore"),["*"]) + ! Get build directory from environment variable or use default + build_dir = get_fpm_env("BUILD_DIR", "build") + + if (.not. exists(build_dir)) then + call mkdir(build_dir) + call filewrite(join_path(build_dir, ".gitignore"),["*"]) end if - cache = join_path("build", "cache.toml") + cache = join_path(build_dir, "cache.toml") if (settings%clean) call delete_file(cache) call new_dependency_tree(deps, cache=cache, verbosity=merge(2, 1, settings%verbose), & - & path_to_config=settings%path_to_config) + & path_to_config=settings%path_to_config, build_dir=build_dir) call deps%add(package, error) call handle_error(error) diff --git a/src/fpm/dependency.f90 b/src/fpm/dependency.f90 index a12e3d44ff..a136fb0a7a 100644 --- a/src/fpm/dependency.f90 +++ b/src/fpm/dependency.f90 @@ -205,7 +205,7 @@ module fpm_dependency contains !> Create a new dependency tree - subroutine new_dependency_tree(self, verbosity, cache, path_to_config) + subroutine new_dependency_tree(self, verbosity, cache, path_to_config, build_dir) !> Instance of the dependency tree type(dependency_tree_t), intent(out) :: self !> Verbosity of printout @@ -214,9 +214,15 @@ subroutine new_dependency_tree(self, verbosity, cache, path_to_config) character(len=*), intent(in), optional :: cache !> Path to the global config file. character(len=*), intent(in), optional :: path_to_config + !> Custom build directory + character(len=*), intent(in), optional :: build_dir call resize(self%dep) - self%dep_dir = join_path("build", "dependencies") + if (present(build_dir)) then + self%dep_dir = join_path(build_dir, "dependencies") + else + self%dep_dir = join_path("build", "dependencies") + end if if (present(verbosity)) self%verbosity = verbosity diff --git a/src/fpm_backend.F90 b/src/fpm_backend.F90 index 148742cc1a..090efbb674 100644 --- a/src/fpm_backend.F90 +++ b/src/fpm_backend.F90 @@ -115,7 +115,7 @@ subroutine build_package(targets,model,verbose,dry_run) plain_output = .true. #endif - progress = build_progress_t(queue,plain_output) + progress = build_progress_t(queue,plain_output,model%build_dir) ! Loop over parallel schedule regions do i=1,size(schedule_ptr)-1 diff --git a/src/fpm_backend_output.f90 b/src/fpm_backend_output.f90 index a9f491d980..5bad652e66 100644 --- a/src/fpm_backend_output.f90 +++ b/src/fpm_backend_output.f90 @@ -33,6 +33,8 @@ module fpm_backend_output logical :: plain_mode = .true. !> Store needed when updating previous console lines integer, allocatable :: output_lines(:) + !> Build directory + character(:), allocatable :: build_dir !> Queue of scheduled build targets type(build_target_ptr), pointer :: target_queue(:) !> The compile_commands.json table @@ -56,11 +58,13 @@ module fpm_backend_output contains !> Initialise a new build progress object - function new_build_progress(target_queue,plain_mode) result(progress) + function new_build_progress(target_queue,plain_mode,build_dir) result(progress) !> The queue of scheduled targets type(build_target_ptr), intent(in), target :: target_queue(:) !> Enable 'plain' output for progress object logical, intent(in), optional :: plain_mode + !> Build directory + character(*), intent(in), optional :: build_dir !> Progress object to initialise type(build_progress_t) :: progress @@ -71,6 +75,12 @@ function new_build_progress(target_queue,plain_mode) result(progress) progress%plain_mode = plain_mode progress%n_complete = 0 + if (present(build_dir)) then + progress%build_dir = build_dir + else + progress%build_dir = "build" + end if + allocate(progress%output_lines(progress%n_target)) end function new_build_progress @@ -191,7 +201,7 @@ subroutine output_write_compile_commands(progress,error) type(error_t), allocatable :: error ! Write compile commands - path = join_path('build','compile_commands.json') + path = join_path(progress%build_dir,'compile_commands.json') call progress%compile_commands%write(filename=path, error=error) diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index b1e6a75c81..af296cacf7 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -217,6 +217,9 @@ module fpm_model !> Base directory for build character(:), allocatable :: build_prefix + !> Build directory + character(:), allocatable :: build_dir + !> Include directories type(string_t), allocatable :: include_dirs(:) @@ -365,6 +368,7 @@ function info_model(model) result(s) s = s // ', cxx_compile_flags="' // model%cxx_compile_flags // '"' s = s // ', link_flags="' // model%link_flags // '"' s = s // ', build_prefix="' // model%build_prefix // '"' + s = s // ', build_dir="' // model%build_dir // '"' ! type(string_t), allocatable :: link_libraries(:) s = s // ", link_libraries=[" do i = 1, size(model%link_libraries) @@ -931,6 +935,10 @@ logical function model_is_same(this,that) if (allocated(this%build_prefix)) then if (.not.(this%build_prefix==other%build_prefix)) return end if + if (allocated(this%build_dir).neqv.allocated(other%build_dir)) return + if (allocated(this%build_dir)) then + if (.not.(this%build_dir==other%build_dir)) return + end if if (allocated(this%include_dirs).neqv.allocated(other%include_dirs)) return if (allocated(this%include_dirs)) then if (.not.(this%include_dirs==other%include_dirs)) return @@ -997,6 +1005,8 @@ subroutine model_dump_to_toml(self, table, error) if (allocated(error)) return call set_string(table, "build-prefix", self%build_prefix, error, 'fpm_model_t') if (allocated(error)) return + call set_string(table, "build-dir", self%build_dir, error, 'fpm_model_t') + if (allocated(error)) return call set_list(table, "include-dirs", self%include_dirs, error) if (allocated(error)) return call set_list(table, "link-libraries", self%link_libraries, error) @@ -1075,6 +1085,7 @@ subroutine model_load_from_toml(self, table, error) call get_value(table, "cxx-flags", self%cxx_compile_flags) call get_value(table, "link-flags", self%link_flags) call get_value(table, "build-prefix", self%build_prefix) + call get_value(table, "build-dir", self%build_dir) if (allocated(self%packages)) deallocate(self%packages) sub_deps: do ii = 1, size(keys) From fd52fe2f964c2b1de1a2007c61866bed9faad569 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 31 Aug 2025 10:20:09 +0200 Subject: [PATCH 03/12] run in custom build folder --- src/fpm.f90 | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index ce519dbd05..af0acf4587 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -69,7 +69,8 @@ subroutine build_model(model, settings, package, error) end if call new_compiler_flags(model,settings) - model%build_prefix = join_path("build", basename(model%compiler%fc)) + model%build_dir = settings%build_dir + model%build_prefix = join_path(settings%build_dir, basename(model%compiler%fc)) model%include_tests = settings%build_tests model%enforce_module_names = package%build%module_naming model%module_prefix = package%build%module_prefix @@ -79,8 +80,8 @@ subroutine build_model(model, settings, package, error) if (allocated(error)) return ! Create dependencies - call new_dependency_tree(model%deps, cache=join_path("build", "cache.toml"), & - & path_to_config=settings%path_to_config) + call new_dependency_tree(model%deps, cache=join_path(settings%build_dir, "cache.toml"), & + & path_to_config=settings%path_to_config, build_dir=settings%build_dir) ! Build and resolve model dependencies call model%deps%add(package, error) @@ -90,9 +91,9 @@ subroutine build_model(model, settings, package, error) call model%deps%update(error) if (allocated(error)) return - ! build/ directory should now exist - if (.not.exists("build/.gitignore")) then - call filewrite(join_path("build", ".gitignore"),["*"]) + ! build directory should now exist + if (.not.exists(join_path(settings%build_dir, ".gitignore"))) then + call filewrite(join_path(settings%build_dir, ".gitignore"),["*"]) end if allocate(model%packages(model%deps%ndep)) From 2662742685f066fd5242ac5c5ef9d03365dc2619 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 31 Aug 2025 10:22:55 +0200 Subject: [PATCH 04/12] add CLI help --- src/fpm_command_line.f90 | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 52c222aebf..2ac43be936 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -169,7 +169,9 @@ module fpm_command_line ' high optimization and "debug" for full debug options. ',& ' If --flag is not specified the "debug" flags are the ',& ' default. ',& - ' --no-prune Disable tree-shaking/pruning of unused module dependencies '& + ' --no-prune Disable tree-shaking/pruning of unused module dependencies ',& + ' --build-dir DIR Specify the build directory. Default is "build" unless set ',& + ' by the environment variable FPM_BUILD_DIR. '& ] ! '12345678901234567890123456789012345678901234567890123456789012345678901234567890',& character(len=80), parameter :: help_text_compiler(*) = [character(len=80) :: & @@ -226,7 +228,10 @@ module fpm_command_line ' will be overwritten by --archiver command line option', & '', & ' FPM_LDFLAGS sets additional link arguments for creating executables', & - ' will be overwritten by --link-flag command line option' & + ' will be overwritten by --link-flag command line option', & + '', & + ' FPM_BUILD_DIR sets the build directory for compilation output', & + ' will be overwritten by --build-dir command line option' & ] contains @@ -1194,7 +1199,8 @@ subroutine set_help() ' ', & 'SYNOPSIS ', & ' fpm build [--profile PROF] [--flag FFLAGS] [--compiler COMPILER_NAME] ', & - ' [--list] [--tests] [--config-file PATH] [--dump [FILENAME]] ', & + ' [--build-dir DIR] [--list] [--tests] [--config-file PATH] ', & + ' [--dump [FILENAME]] ', & ' ', & ' fpm build --help|--version ', & ' ', & @@ -1210,7 +1216,7 @@ subroutine set_help() ' o test/ main program(s) and support files for project tests ', & ' o example/ main program(s) for example programs ', & ' Changed or new files found are rebuilt. The results are placed in ', & - ' the build/ directory. ', & + ' the build directory (default: build/). ', & ' ', & ' Non-default pathnames and remote dependencies are used if ', & ' specified in the "fpm.toml" file. ', & @@ -1221,7 +1227,7 @@ subroutine set_help() help_text_flag, & ' --list list candidates instead of building or running them. ', & ' all dependencies are downloaded, and the build sequence ', & - ' is saved to `build/compile_commands.json`. ', & + ' is saved to `/compile_commands.json`. ', & ' --tests build all tests (otherwise only if needed) ', & ' --show-model show the model and exit (do not build) ', & ' --dump [FILENAME] save model representation to file. use JSON format ', & @@ -1238,6 +1244,7 @@ subroutine set_help() ' ', & ' fpm build # build with debug options ', & ' fpm build --profile release # build with high optimization ', & + ' fpm build --build-dir /tmp/my_build # build to custom directory ', & '' ] help_help=[character(len=80) :: & From 93e943fba229453d62dbbd17b88517083dbe264e Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 31 Aug 2025 10:36:30 +0200 Subject: [PATCH 05/12] ensure build_dir does not overlap with reserved keywords --- src/fpm_command_line.f90 | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 2ac43be936..786ea482c2 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -833,8 +833,42 @@ subroutine check_build_vals() val_profile = sget('profile') val_build_dir = sget('build-dir') + call validate_build_dir(val_build_dir) + end subroutine check_build_vals + !> Validate that build directory is not a reserved source directory name + subroutine validate_build_dir(build_dir) + use fpm_error, only: fpm_stop + use fpm_filesystem, only: canon_path + character(len=*), intent(in) :: build_dir + character(len=*), parameter :: reserved_names(*) = [ & + "src ", "app ", "test ", "tests ", & + "example ", "examples", "include "] + character(len=:), allocatable :: normalized_build_dir, normalized_reserved + integer :: i + + ! Skip validation if build_dir is empty (will use default) + if (len_trim(build_dir) == 0) return + + ! Normalize the build directory path + normalized_build_dir = canon_path(build_dir) + + ! Check against reserved directory names + do i = 1, size(reserved_names) + normalized_reserved = canon_path(trim(reserved_names(i))) + if (normalized_build_dir == normalized_reserved) then + call fpm_stop(1, 'Error: Build directory "'//trim(build_dir)//'" conflicts with source directory "'//trim(reserved_names(i))//'".') + end if + end do + + ! Additional checks for problematic cases + if (trim(build_dir) == "." .or. trim(build_dir) == "..") then + call fpm_stop(1, 'Error: Build directory cannot be "'//trim(build_dir)//'" as it would overwrite the current or parent directory.') + end if + + end subroutine validate_build_dir + !> Print help text and stop subroutine printhelp(lines) character(len=:),intent(in),allocatable :: lines(:) From 41caee7b10d274e833f1a5b8503a38704dd54888 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 31 Aug 2025 10:50:22 +0200 Subject: [PATCH 06/12] introduce CI test --- ci/run_tests.sh | 3 ++ ci/test_custom_build_dir.sh | 105 ++++++++++++++++++++++++++++++++++++ 2 files changed, 108 insertions(+) create mode 100755 ci/test_custom_build_dir.sh diff --git a/ci/run_tests.sh b/ci/run_tests.sh index 0260743f16..ec22320658 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -344,5 +344,8 @@ pushd static_app_only test $EXIT_CODE -eq 0 popd +# Test custom build directory functionality +./test_custom_build_dir.sh "$fpm" hello_world + # Cleanup rm -rf ./*/build diff --git a/ci/test_custom_build_dir.sh b/ci/test_custom_build_dir.sh new file mode 100755 index 0000000000..fa9a073bbb --- /dev/null +++ b/ci/test_custom_build_dir.sh @@ -0,0 +1,105 @@ +#!/usr/bin/env bash +set -ex + +# Test script for custom build directory functionality +# Usage: ./test_custom_build_dir.sh [fpm_executable] [example_package_dir] + +cd "$(dirname $0)/.." + +if [ "$1" ]; then + fpm="$1" +else + fpm=fpm +fi + +if [ "$2" ]; then + test_package="$2" +else + test_package="hello_world" +fi + +echo "Testing custom build directory functionality with package: $test_package" + +# Go to example packages directory +pushd example_packages/ + +# Test 1: Custom build directory with CLI option +pushd "$test_package" +echo "Test 1: CLI option --build-dir" +rm -rf ./build custom_build_test +"$fpm" build --build-dir custom_build_test +test -d custom_build_test +test -f custom_build_test/.gitignore +"$fpm" run --build-dir custom_build_test --target "$test_package" +# Verify standard build directory was not created +test ! -d build +echo "✓ CLI option --build-dir works" + +# Test 2: Environment variable +echo "Test 2: Environment variable FPM_BUILD_DIR" +rm -rf custom_build_test env_build_test +FPM_BUILD_DIR=env_build_test "$fpm" build +test -d env_build_test +test -f env_build_test/.gitignore +FPM_BUILD_DIR=env_build_test "$fpm" run --target "$test_package" +echo "✓ Environment variable FPM_BUILD_DIR works" + +# Test 3: CLI option overrides environment variable +echo "Test 3: CLI option overrides environment variable" +rm -rf env_build_test cli_override_test +FPM_BUILD_DIR=env_build_test "$fpm" build --build-dir cli_override_test +test -d cli_override_test +test ! -d env_build_test +echo "✓ CLI option correctly overrides environment variable" + +# Test 4: Build directory validation - reserved names +echo "Test 4: Build directory validation" +# These should fail with specific error messages +if "$fpm" build --build-dir src 2>&1 | grep -q "conflicts with source directory"; then + echo "✓ Correctly rejected 'src'" +else + echo "ERROR: Should reject 'src'" && exit 1 +fi + +if "$fpm" build --build-dir app 2>&1 | grep -q "conflicts with source directory"; then + echo "✓ Correctly rejected 'app'" +else + echo "ERROR: Should reject 'app'" && exit 1 +fi + +if "$fpm" build --build-dir test 2>&1 | grep -q "conflicts with source directory"; then + echo "✓ Correctly rejected 'test'" +else + echo "ERROR: Should reject 'test'" && exit 1 +fi + +if "$fpm" build --build-dir . 2>&1 | grep -q "would overwrite the current"; then + echo "✓ Correctly rejected '.'" +else + echo "ERROR: Should reject '.'" && exit 1 +fi + +# Test 5: Path normalization +echo "Test 5: Path normalization" +if "$fpm" build --build-dir ./src 2>&1 | grep -q "conflicts with source directory"; then + echo "✓ Correctly rejected './src' (path normalization works)" +else + echo "ERROR: Should reject './src'" && exit 1 +fi + +# Test 6: Different commands with custom build directory +echo "Test 6: Different commands with custom build directory" +rm -rf test_build_all +"$fpm" build --build-dir test_build_all +"$fpm" run --build-dir test_build_all --target "$test_package" +# Some packages may not have tests, so this might fail but that's expected +"$fpm" test --build-dir test_build_all 2>/dev/null || echo "No tests in $test_package (expected)" +echo "✓ All commands work with custom build directory" + +# Cleanup test directories +rm -rf custom_build_test env_build_test cli_override_test test_build_all +popd + +popd + +echo "All custom build directory tests passed!" \ No newline at end of file From 4056e177052300b12acf59475ffe2bd7ae1f8f2f Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 31 Aug 2025 10:55:53 +0200 Subject: [PATCH 07/12] shorter line lengths --- src/fpm_command_line.f90 | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 786ea482c2..1cd62ce3f0 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -858,13 +858,16 @@ subroutine validate_build_dir(build_dir) do i = 1, size(reserved_names) normalized_reserved = canon_path(trim(reserved_names(i))) if (normalized_build_dir == normalized_reserved) then - call fpm_stop(1, 'Error: Build directory "'//trim(build_dir)//'" conflicts with source directory "'//trim(reserved_names(i))//'".') + call fpm_stop(1, 'Error: Build directory "'//trim(build_dir) & + //'" conflicts with source directory "' & + //trim(reserved_names(i))//'".') end if end do ! Additional checks for problematic cases if (trim(build_dir) == "." .or. trim(build_dir) == "..") then - call fpm_stop(1, 'Error: Build directory cannot be "'//trim(build_dir)//'" as it would overwrite the current or parent directory.') + call fpm_stop(1, 'Error: Build directory cannot be "'//trim(build_dir)// & + '" as it would overwrite the current or parent directory.') end if end subroutine validate_build_dir From 7064eff99dca89dd18e458d5a8be995899d30592 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 31 Aug 2025 11:05:13 +0200 Subject: [PATCH 08/12] fix call site --- ci/run_tests.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ci/run_tests.sh b/ci/run_tests.sh index ec22320658..c87234d42b 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -345,7 +345,7 @@ test $EXIT_CODE -eq 0 popd # Test custom build directory functionality -./test_custom_build_dir.sh "$fpm" hello_world +"$(dirname "$0")/test_custom_build_dir.sh" "$fpm" hello_world # Cleanup rm -rf ./*/build From f646a9947b19a68e21722d91bf8e0acc33cb185c Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 31 Aug 2025 11:14:06 +0200 Subject: [PATCH 09/12] fix folder --- ci/run_tests.sh | 5 +++-- ci/test_custom_build_dir.sh | 6 ++++-- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/ci/run_tests.sh b/ci/run_tests.sh index c87234d42b..caa879a9c4 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -344,8 +344,9 @@ pushd static_app_only test $EXIT_CODE -eq 0 popd -# Test custom build directory functionality -"$(dirname "$0")/test_custom_build_dir.sh" "$fpm" hello_world +# Test custom build directory functionality +script_dir="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)" +bash "$script_dir/test_custom_build_dir.sh" "$fpm" hello_world # Cleanup rm -rf ./*/build diff --git a/ci/test_custom_build_dir.sh b/ci/test_custom_build_dir.sh index fa9a073bbb..b57d40e1b9 100755 --- a/ci/test_custom_build_dir.sh +++ b/ci/test_custom_build_dir.sh @@ -4,7 +4,9 @@ set -ex # Test script for custom build directory functionality # Usage: ./test_custom_build_dir.sh [fpm_executable] [example_package_dir] -cd "$(dirname $0)/.." +# Move to repo root (works from or /ci) +this_dir="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)" +cd "$this_dir/.." if [ "$1" ]; then fpm="$1" @@ -102,4 +104,4 @@ popd popd -echo "All custom build directory tests passed!" \ No newline at end of file +echo "All custom build directory tests passed!" From 231ad9c2a5f9e15ec965b46113e363f7dfed4777 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 31 Aug 2025 11:24:03 +0200 Subject: [PATCH 10/12] fix folder 2 --- ci/run_tests.sh | 3 +-- ci/test_custom_build_dir.sh | 9 --------- 2 files changed, 1 insertion(+), 11 deletions(-) diff --git a/ci/run_tests.sh b/ci/run_tests.sh index caa879a9c4..625714af85 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -345,8 +345,7 @@ test $EXIT_CODE -eq 0 popd # Test custom build directory functionality -script_dir="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)" -bash "$script_dir/test_custom_build_dir.sh" "$fpm" hello_world +bash "../ci/test_custom_build_dir.sh" "$fpm" hello_world # Cleanup rm -rf ./*/build diff --git a/ci/test_custom_build_dir.sh b/ci/test_custom_build_dir.sh index b57d40e1b9..e6d2254d9a 100755 --- a/ci/test_custom_build_dir.sh +++ b/ci/test_custom_build_dir.sh @@ -4,10 +4,6 @@ set -ex # Test script for custom build directory functionality # Usage: ./test_custom_build_dir.sh [fpm_executable] [example_package_dir] -# Move to repo root (works from or /ci) -this_dir="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)" -cd "$this_dir/.." - if [ "$1" ]; then fpm="$1" else @@ -22,9 +18,6 @@ fi echo "Testing custom build directory functionality with package: $test_package" -# Go to example packages directory -pushd example_packages/ - # Test 1: Custom build directory with CLI option pushd "$test_package" echo "Test 1: CLI option --build-dir" @@ -102,6 +95,4 @@ echo "✓ All commands work with custom build directory" rm -rf custom_build_test env_build_test cli_override_test test_build_all popd -popd - echo "All custom build directory tests passed!" From d50e8a04c2c56aea272c8ed87287b1c1ec330957 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sat, 6 Sep 2025 09:34:03 +0200 Subject: [PATCH 11/12] restore `validate_build_dir` --- src/fpm_command_line.f90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 3c8c2ca346..dd1a74979e 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -1620,12 +1620,15 @@ subroutine build_settings(self, list, show_model, build_tests, config_file) cxxflags = ' ' // sget('cxx-flag') ldflags = ' ' // sget('link-flag') prof = sget('profile') + + ! Set and validate build directory dir = sget('build-dir') + call validate_build_dir(dir) ccomp = sget('c-compiler') cxcomp = sget('cxx-compiler') arch = sget('archiver') - + ! Handle --dump default (empty value means use 'fpm_model.toml') if (specified('dump')) then dump = sget('dump') From db4b2e4bf883313ce42eb652be7705476d325462 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sat, 6 Sep 2025 09:38:30 +0200 Subject: [PATCH 12/12] move routines out (non-trampoline) --- src/fpm_command_line.f90 | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index dd1a74979e..f871ccd232 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -38,7 +38,6 @@ module fpm_command_line use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, & & stdout=>output_unit, & & stderr=>error_unit - implicit none private @@ -757,12 +756,10 @@ subroutine get_command_line_settings(cmd_settings) call move_alloc(working_dir, cmd_settings%working_dir) end if - contains + end subroutine get_command_line_settings !> Validate that build directory is not a reserved source directory name subroutine validate_build_dir(build_dir) - use fpm_error, only: fpm_stop - use fpm_filesystem, only: canon_path character(len=*), intent(in) :: build_dir character(len=*), parameter :: reserved_names(*) = [ & "src ", "app ", "test ", "tests ", & @@ -809,8 +806,6 @@ subroutine printhelp(lines) stop end subroutine printhelp - end subroutine get_command_line_settings - subroutine set_help() help_list_nodash=[character(len=80) :: & 'USAGE: fpm [ SUBCOMMAND [SUBCOMMAND_OPTIONS] ]|[--list|--help|--version]', &