diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index bdc572c027..773978caea 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -35,9 +35,9 @@ jobs: mpi: openmpi - os: ubuntu-latest mpi: mpich - - os: macos-latest + - os: macos-12 mpi: openmpi - - os: macos-latest + - os: macos-12 mpi: mpich diff --git a/ci/run_tests.sh b/ci/run_tests.sh index c31f134312..a1fa02edf2 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -58,6 +58,13 @@ pushd with_examples "$fpm" run --target demo-prog popd +pushd many_examples +"$fpm" build +"$fpm" run --example --all +test -e demo1.txt +test -e demo2.txt +popd + pushd auto_discovery_off "$fpm" build "$fpm" run --target auto_discovery_off diff --git a/example_packages/many_examples/.gitignore b/example_packages/many_examples/.gitignore new file mode 100644 index 0000000000..d9b4f015d3 --- /dev/null +++ b/example_packages/many_examples/.gitignore @@ -0,0 +1 @@ +/build/* diff --git a/example_packages/many_examples/app/demo-prog.f90 b/example_packages/many_examples/app/demo-prog.f90 new file mode 100644 index 0000000000..f26e898fc8 --- /dev/null +++ b/example_packages/many_examples/app/demo-prog.f90 @@ -0,0 +1,3 @@ +program demo + write(*, '(a)') "This is a simple program" +end program demo diff --git a/example_packages/many_examples/demo1/prog.f90 b/example_packages/many_examples/demo1/prog.f90 new file mode 100644 index 0000000000..817bff0add --- /dev/null +++ b/example_packages/many_examples/demo1/prog.f90 @@ -0,0 +1,7 @@ +program demo + integer :: i + open(newunit=i,file="demo1.txt",form="formatted",action="write") + write(i, '(a)') "DEMO1" + close(i) + stop 0 +end program demo diff --git a/example_packages/many_examples/demo2/prog.f90 b/example_packages/many_examples/demo2/prog.f90 new file mode 100644 index 0000000000..951ce9b51c --- /dev/null +++ b/example_packages/many_examples/demo2/prog.f90 @@ -0,0 +1,7 @@ +program demo + integer :: i + open(newunit=i,file="demo2.txt",form="formatted",action="write") + write(i, '(a)') "DEMO2" + close(i) + stop 0 +end program demo diff --git a/example_packages/many_examples/fpm.toml b/example_packages/many_examples/fpm.toml new file mode 100644 index 0000000000..6004375307 --- /dev/null +++ b/example_packages/many_examples/fpm.toml @@ -0,0 +1,12 @@ +name = "many_examples" +build.auto-examples = false + +[[example]] +name = "demo-1" +source-dir = "demo1" +main = "prog.f90" + +[[example]] +name = "demo-2" +source-dir = "demo2" +main = "prog.f90" diff --git a/src/fpm.f90 b/src/fpm.f90 index de8bd43f4d..3f86c1a91c 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -485,7 +485,7 @@ subroutine cmd_run(settings,test) type(build_target_t), pointer :: exe_target type(srcfile_t), pointer :: exe_source integer :: run_scope,firsterror - integer, allocatable :: stat(:) + integer, allocatable :: stat(:),target_ID(:) character(len=:),allocatable :: line logical :: toomany @@ -513,48 +513,31 @@ subroutine cmd_run(settings,test) ! Enumerate executable targets to run col_width = -1 found(:) = .false. - allocate(executables(size(settings%name))) - do i=1,size(targets) - + allocate(executables(size(targets)),target_ID(size(targets))) + enumerate: do i=1,size(targets) exe_target => targets(i)%ptr - - if (exe_target%target_type == FPM_TARGET_EXECUTABLE .and. & - allocated(exe_target%dependencies)) then - + if (should_be_run(settings,run_scope,exe_target)) then + exe_source => exe_target%dependencies(1)%ptr%source - - if (exe_source%unit_scope == run_scope) then - - col_width = max(col_width,len(basename(exe_target%output_file))+2) - - if (size(settings%name) == 0) then - - exe_cmd%s = exe_target%output_file - executables = [executables, exe_cmd] - - else - - do j=1,size(settings%name) - - if (glob(trim(exe_source%exe_name),trim(settings%name(j))) .and. .not.found(j)) then - - - found(j) = .true. - exe_cmd%s = exe_target%output_file - executables(j) = exe_cmd - - end if - - end do - - end if - - end if - - end if - - end do - + + col_width = max(col_width,len(basename(exe_target%output_file))+2) + + ! Priority by name ID, or 0 if no name present (run first) + j = settings%name_ID(exe_source%exe_name) + target_ID(i) = j + if (j>0) found(j) = .true. + + exe_cmd%s = exe_target%output_file + executables(i) = exe_cmd + + else + target_ID(i) = huge(target_ID(i)) + endif + end do enumerate + + ! sort executables by ascending name ID, resize + call sort_executables(target_ID,executables) + ! Check if any apps/tests were found if (col_width < 0) then if (test) then @@ -564,8 +547,6 @@ subroutine cmd_run(settings,test) end if end if - - ! Check all names are valid ! or no name and found more than one file toomany= size(settings%name)==0 .and. size(executables)>1 @@ -736,4 +717,86 @@ subroutine cmd_clean(settings) end if end subroutine cmd_clean +!> Sort executables by namelist ID, and trim unused values +pure subroutine sort_executables(target_ID,executables) + integer, allocatable, intent(inout) :: target_ID(:) + type(string_t), allocatable, intent(inout) :: executables(:) + + integer :: i,j,n,used + + n = size(target_ID) + used = 0 + + sort: do i=1,n + do j=i+1,n + if (target_ID(j)0 .and. used Check if an executable should be run +logical function should_be_run(settings,run_scope,exe_target) + class(fpm_run_settings), intent(in) :: settings + integer, intent(in) :: run_scope + type(build_target_t), intent(in) :: exe_target + + integer :: j + + if (exe_target%target_type == FPM_TARGET_EXECUTABLE .and. & + allocated(exe_target%dependencies)) then + + associate(exe_source => exe_target%dependencies(1)%ptr%source) + + if (exe_source%unit_scope/=run_scope) then + + ! Other scope + should_be_run = .false. + + elseif (size(settings%name) == 0 .or. .not.settings%list) then + + ! No list of targets + should_be_run = .true. + + else + + ! Is found in list + should_be_run = settings%name_ID(exe_source%exe_name)>0 + + end if + + end associate + + else + + !> Invalid target + should_be_run = .false. + + endif + +end function should_be_run + end module fpm diff --git a/src/fpm/git.f90 b/src/fpm/git.f90 index 1f2891af8a..a4f0f06a4a 100644 --- a/src/fpm/git.f90 +++ b/src/fpm/git.f90 @@ -441,11 +441,12 @@ subroutine git_archive(source, destination, ref, additional_files, verbose, erro endif call run('git archive '//ref//' & - --format='//archive_format// & - add_files//' \ - -o '//destination, \ - echo=verbose, \ - exitstat=stat) + & --format='//archive_format// & + & add_files//' & + & -o '//destination, & + & echo=verbose, & + & exitstat=stat) + if (stat /= 0) then call fatal_error(error, "Error packing '"//source//"'."); return end if diff --git a/src/fpm/manifest/preprocess.f90 b/src/fpm/manifest/preprocess.f90 index 49ad24f82d..2370575d2a 100644 --- a/src/fpm/manifest/preprocess.f90 +++ b/src/fpm/manifest/preprocess.f90 @@ -58,10 +58,6 @@ module fpm_manifest_preprocess character(*), parameter, private :: class_name = 'preprocess_config_t' - interface operator(==) - module procedure preprocess_is_same - end interface - contains !> Construct a new preprocess configuration from TOML data structure @@ -208,7 +204,6 @@ logical function preprocess_is_same(this,that) integer :: istr - preprocess_is_same = .false. select type (other=>that) diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 29159ba36e..03faf05cd7 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -28,7 +28,8 @@ module fpm_command_line OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD, OS_NAME use M_CLI2, only : set_args, lget, sget, unnamed, remaining, specified use M_CLI2, only : get_subcommand, CLI_RESPONSE_FILE -use fpm_strings, only : lower, split, to_fortran_name, is_fortran_name, remove_characters_in_set, string_t +use fpm_strings, only : lower, split, to_fortran_name, is_fortran_name, remove_characters_in_set, & + string_t, glob use fpm_filesystem, only : basename, canon_path, which, run use fpm_environment, only : get_command_arguments_quoted use fpm_error, only : fpm_stop, error_t @@ -97,6 +98,7 @@ module fpm_command_line logical :: example contains procedure :: runner_command + procedure :: name_ID end type type, extends(fpm_run_settings) :: fpm_test_settings @@ -1583,5 +1585,27 @@ function runner_command(cmd) result(run_cmd) if (len_trim(cmd%runner_args)>0) run_cmd = run_cmd//' '//trim(cmd%runner_args) end function runner_command + !> Check name in list ID. return 0 if not found + integer function name_ID(cmd,name) + class(fpm_run_settings), intent(in) :: cmd + character(*), intent(in) :: name + + integer :: j + + !> Default: not found + name_ID = 0 + if (.not.allocated(cmd%name)) return + + do j=1,size(cmd%name) + + if (glob(trim(name),trim(cmd%name(j)))) then + name_ID = j + return + end if + + end do + + end function name_ID + end module fpm_command_line diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90 index 6d65154df1..a0066708d7 100644 --- a/src/fpm_filesystem.F90 +++ b/src/fpm_filesystem.F90 @@ -1011,6 +1011,8 @@ subroutine run(cmd,echo,exitstat,verbose,redirect) if (present(redirect)) then if(redirect /= '')then redirect_str = ">"//redirect//" 2>&1" + else + redirect_str = "" endif else if(verbose_local)then diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index 8663f33b6e..f3449e16d2 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -52,7 +52,7 @@ module fpm_model FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, & FPM_UNIT_CHEADER, FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, & FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_EXAMPLE, FPM_SCOPE_TEST, & - FPM_UNIT_CPPSOURCE + FPM_UNIT_CPPSOURCE, FPM_SCOPE_NAME !> Source type unknown integer, parameter :: FPM_UNIT_UNKNOWN = -1