diff options
| -rw-r--r-- | .github/workflows/CI.yml | 28 | ||||
| -rw-r--r-- | README.md | 87 | ||||
| -rw-r--r-- | bootstrap/src/Fpm.hs | 2 | ||||
| -rwxr-xr-x | ci/run_tests.bat | 28 | ||||
| -rwxr-xr-x | ci/run_tests.sh | 35 | ||||
| -rw-r--r-- | fpm/fpm.toml | 2 | ||||
| -rw-r--r-- | fpm/src/fpm.f90 | 20 | ||||
| -rw-r--r-- | fpm/src/fpm_backend.f90 | 235 | ||||
| -rw-r--r-- | fpm/src/fpm_command_line.f90 | 2 | ||||
| -rw-r--r-- | fpm/src/fpm_model.f90 | 18 | ||||
| -rw-r--r-- | fpm/src/fpm_sources.f90 | 6 | ||||
| -rw-r--r-- | fpm/src/fpm_strings.f90 | 79 | ||||
| -rw-r--r-- | fpm/src/fpm_targets.f90 | 71 | ||||
| -rw-r--r-- | fpm/test/fpm_test/main.f90 | 2 | ||||
| -rw-r--r-- | fpm/test/fpm_test/test_backend.f90 | 353 | ||||
| -rw-r--r-- | fpm/test/fpm_test/test_module_dependencies.f90 | 2 |
16 files changed, 810 insertions, 160 deletions
diff --git a/.github/workflows/CI.yml b/.github/workflows/CI.yml index 8165ded..f42d8ff 100644 --- a/.github/workflows/CI.yml +++ b/.github/workflows/CI.yml @@ -27,33 +27,39 @@ jobs: - os: ubuntu-latest STACK_CACHE: "/home/runner/.stack/" STACK_CACHE_VERSION: "" + TEST_SCRIPT: ci/run_tests.sh GET_VERSION_CMD: echo ${{ github.ref }} | cut -dv -f2 CHECK_VERSION_CMD: grep $(cat fpm_version) - RELEASE_CMD: "fpm run --flag --static --flag -g --flag -fbacktrace --flag -O3 --runner cp -- fpm-v$(cat fpm_version)-linux-x86_64" + RELEASE_CMD: "cp -- fpm-v$(cat fpm_version)-linux-x86_64" BOOTSTRAP_RELEASE_CMD: cp /home/runner/.local/bin/fpm fpm-bootstrap-v$(cat fpm_version)-linux-x86_64 HASH_CMD: ls fpm-*|xargs -i{} sh -c 'sha256sum $1 > $1.sha256' -- {} + RELEASE_FLAGS: --flag --static --flag -g --flag -fbacktrace --flag -O3 - os: macos-latest STACK_CACHE: | /Users/runner/.stack/snapshots /Users/runner/.stack/setup-exe-src STACK_CACHE_VERSION: "v2" + TEST_SCRIPT: ci/run_tests.sh GET_VERSION_CMD: echo ${{ github.ref }} | cut -dv -f2 CHECK_VERSION_CMD: grep $(cat fpm_version) - RELEASE_CMD: "fpm run --flag -g --flag -fbacktrace --flag -O3 --runner cp -- fpm-v$(cat fpm_version)-macos-x86_64" + RELEASE_CMD: "cp -- fpm-v$(cat fpm_version)-macos-x86_64" BOOTSTRAP_RELEASE_CMD: cp /Users/runner/.local/bin/fpm fpm-bootstrap-v$(cat fpm_version)-macos-x86_64 HASH_CMD: ls fpm-*|xargs -I{} sh -c 'shasum -a 256 $1 > $1.sha256' -- {} + RELEASE_FLAGS: --flag -g --flag -fbacktrace --flag -O3 - os: windows-latest STACK_CACHE: | C:\Users\runneradmin\AppData\Roaming\stack C:\Users\runneradmin\AppData\Local\Programs\stack STACK_CACHE_VERSION: "v2" + TEST_SCRIPT: ci\run_tests.bat GET_VERSION_CMD: ("${{ github.ref }}" -Split "v")[1] CHECK_VERSION_CMD: Select-String -Pattern Version | Where-Object { if ($_ -like -join("*",(Get-Content fpm_version),"*")) {echo $_} else {Throw} } - RELEASE_CMD: fpm run --flag --static --flag -g --flag -fbacktrace --flag -O3 --runner copy -- (-join("fpm-v",(Get-Content fpm_version),"-windows-x86_64.exe")) + RELEASE_CMD: copy -- (-join("fpm-v",(Get-Content fpm_version),"-windows-x86_64.exe")) BOOTSTRAP_RELEASE_CMD: copy C:\Users\runneradmin\AppData\Roaming\local\bin\fpm.exe (-join("fpm-bootstrap-v",(Get-Content fpm_version),"-windows-x86_64.exe")) HASH_CMD: Get-ChildItem -File -Filter "fpm-*" | Foreach-Object {echo (Get-FileHash -Algorithm SHA256 $PSItem | Select-Object hash | Format-Table -HideTableHeaders | Out-String) > (-join($PSItem,".sha256"))} + RELEASE_FLAGS: --flag --static --flag -g --flag -fbacktrace --flag -O3 env: FC: gfortran @@ -116,15 +122,11 @@ jobs: cd bootstrap stack test - - name: Build and run Fortran fpm (Linux / macOS) - if: contains(matrix.os, 'ubuntu') || contains(matrix.os, 'macos') - run: | - ci/run_tests.sh + - name: Build and test Fortran fpm + run: ${{ matrix.TEST_SCRIPT }} - - name: Build and run Fortran fpm (Windows) - if: contains(matrix.os, 'windows') - run: | - ci\run_tests.bat + - name: Build and test Fortran fpm (release version) + run: ${{ matrix.TEST_SCRIPT }} ${{ matrix.RELEASE_FLAGS }} # ----- Upload binaries if creating a release ----- - name: Check that fpm --version matches release tag @@ -138,7 +140,7 @@ jobs: if: github.event_name == 'release' run: | cd fpm - ${{ matrix.RELEASE_CMD }} + fpm run ${{ matrix.RELEASE_FLAGS }} --runner ${{ matrix.RELEASE_CMD }} ${{ matrix.BOOTSTRAP_RELEASE_CMD }} ${{ matrix.HASH_CMD }} @@ -150,4 +152,4 @@ jobs: file: fpm/fpm-* file_glob: true tag: ${{ github.ref }} - overwrite: true
\ No newline at end of file + overwrite: true @@ -24,45 +24,7 @@ __Note:__ On Linux and MacOS, you will need to enable executable permission befo _e.g._ `$ chmod u+x fpm-v0.1.0-linux-x86_64` -### Build from source - -#### Install Haskell - -To install **Haskell Stack**, follow these -[instructions](https://docs.haskellstack.org/en/stable/install_and_upgrade/), -users without superuser (admin) permissions should follow the -[manual installation](https://docs.haskellstack.org/en/stable/install_and_upgrade/#manual-download_2) -procedure. - -#### Download this repository - -```bash -$ git clone https://github.com/fortran-lang/fpm -$ cd fpm/ -``` - -#### Build and test fpm - -Bootstrap *fpm* using: - -```bash -$ cd bootstrap/ -$ stack build -``` - -To test: - -```bash -$ stack test -``` - -To install: - -```bash -$ stack install -``` - -On Linux, the above command installs `fpm` to `${HOME}/.local/bin/`. +For other platforms and architectures have a look at the [bootstrapping instructions](#bootstrapping-instructions). ### Creating a new project @@ -88,7 +50,52 @@ with the following contents and initialized as a git repository. The command `fpm run` can optionally accept the name of the specific executable to run, as can `fpm test`; like `fpm run specific_executable`. Command line arguments can also be passed to the executable(s) or test(s) with the option -`--args "some arguments"`. +`-- some arguments`. See additional instructions in the [Packaging guide](PACKAGING.md) or the [manifest reference](manifest-reference.md). + + +### Bootstrapping instructions + +This guide explains the process of building *fpm* on a platform for the first time. +If your platform and architecture are already supported, download the binary from the [release page](https://github.com/fortran-lang/fpm/releases) instead. + +#### Download this repository + +```bash +$ git clone https://github.com/fortran-lang/fpm +$ cd fpm/ +``` + +#### Build a bootstrap version of fpm + +You can use the install script to perform the build of the Haskell version of *fpm* with: + +```bash +$ ./install.sh +``` + +On Linux, the above command installs `fpm` to `${HOME}/.local/bin/`. + +Now you can build the Fortran *fpm* version with + +```bash +$ cd fpm/ +$ fpm build +``` + +Test that everything is working as expected + +```bash +$ fpm test +``` + +Finally, install the Fortran *fpm* version with + +```bash +$ fpm run --runner cp -- ~/.local/bin +``` + +Or choose another location if you do not want to overwrite the bootstrapping version. +From now on you can rebuild *fpm* with your Fortran *fpm* version. diff --git a/bootstrap/src/Fpm.hs b/bootstrap/src/Fpm.hs index 943393e..9fc1c91 100644 --- a/bootstrap/src/Fpm.hs +++ b/bootstrap/src/Fpm.hs @@ -639,6 +639,7 @@ defineCompilerSettings specifiedFlags compiler release , "-march=native" , "-ffast-math" , "-funroll-loops" + , "-fcoarray=single" ] else [ "-Wall" @@ -650,6 +651,7 @@ defineCompilerSettings specifiedFlags compiler release , "-fbounds-check" , "-fcheck-array-temporaries" , "-fbacktrace" + , "-fcoarray=single" ] fs -> fs in return $ CompilerSettings { compilerSettingsCompiler = compiler diff --git a/ci/run_tests.bat b/ci/run_tests.bat index 44f6e5c..533590d 100755 --- a/ci/run_tests.bat +++ b/ci/run_tests.bat @@ -3,18 +3,25 @@ cd fpm if errorlevel 1 exit 1 -fpm build +fpm build %* if errorlevel 1 exit 1 -fpm run +fpm run %* +if errorlevel 1 exit 1 + +fpm run %* -- --help +if errorlevel 1 exit 1 + +fpm run %* -- --version if errorlevel 1 exit 1 rmdir fpm_scratch_* /s /q -fpm test +fpm test %* if errorlevel 1 exit 1 rmdir fpm_scratch_* /s /q -for /f %%i in ('where /r build fpm.exe') do set fpm_path=%%i +for /f %%i in ('fpm run %* --runner echo') do set fpm_path=%%i +echo %fpm_path% %fpm_path% if errorlevel 1 exit 1 @@ -22,6 +29,7 @@ if errorlevel 1 exit 1 cd ..\example_packages\hello_world if errorlevel 1 exit 1 +del /q /f build %fpm_path% build if errorlevel 1 exit 1 @@ -32,6 +40,7 @@ if errorlevel 1 exit 1 cd ..\hello_fpm if errorlevel 1 exit 1 +del /q /f build %fpm_path% build if errorlevel 1 exit 1 @@ -42,6 +51,7 @@ if errorlevel 1 exit 1 cd ..\circular_test if errorlevel 1 exit 1 +del /q /f build %fpm_path% build if errorlevel 1 exit 1 @@ -49,6 +59,7 @@ if errorlevel 1 exit 1 cd ..\circular_example if errorlevel 1 exit 1 +del /q /f build %fpm_path% build if errorlevel 1 exit 1 @@ -56,6 +67,7 @@ if errorlevel 1 exit 1 cd ..\hello_complex if errorlevel 1 exit 1 +del /q /f build %fpm_path% build if errorlevel 1 exit 1 @@ -75,6 +87,7 @@ if errorlevel 1 exit 1 cd ..\hello_complex_2 if errorlevel 1 exit 1 +del /q /f build %fpm_path% build if errorlevel 1 exit 1 @@ -93,6 +106,7 @@ if errorlevel 1 exit 1 cd ..\auto_discovery_off if errorlevel 1 exit 1 +del /q /f build %fpm_path% build if errorlevel 1 exit 1 @@ -110,6 +124,7 @@ if exist .\build\gfortran_debug\test\unused_test exit /B 1 cd ..\with_c if errorlevel 1 exit 1 +del /q /f build %fpm_path% build if errorlevel 1 exit 1 @@ -120,6 +135,7 @@ if errorlevel 1 exit 1 cd ..\submodules if errorlevel 1 exit 1 +del /q /f build %fpm_path% build if errorlevel 1 exit 1 @@ -127,6 +143,7 @@ if errorlevel 1 exit 1 cd ..\program_with_module if errorlevel 1 exit 1 +del /q /f build %fpm_path% build if errorlevel 1 exit 1 @@ -137,8 +154,11 @@ if errorlevel 1 exit 1 cd ..\link_executable if errorlevel 1 exit 1 +del /q /f build %fpm_path% build if errorlevel 1 exit 1 .\build\gfortran_debug\app\gomp_test if errorlevel 1 exit 1 + +cd ..\..
\ No newline at end of file diff --git a/ci/run_tests.sh b/ci/run_tests.sh index 894b1f0..3588012 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -1,30 +1,26 @@ #!/bin/bash +set -ex -get_abs_filename() { - # $1 : relative filename - filename=$1 - parentdir=$(dirname "${filename}") +cd $(dirname $0)/../fpm - if [ -d "${filename}" ]; then - echo "$(cd "${filename}" && pwd)" - elif [ -d "${parentdir}" ]; then - echo "$(cd "${parentdir}" && pwd)/$(basename "${filename}")" - fi -} +fpm build $@ -set -ex +# Run fpm executable +fpm run $@ +fpm run $@ -- --version +fpm run $@ -- --help -cd fpm -fpm build -fpm run +# Run tests rm -rf fpm_scratch_*/ -fpm test +fpm test $@ rm -rf fpm_scratch_*/ -f_fpm_path="$(get_abs_filename $(find build -regex 'build/.*/app/fpm'))" -"${f_fpm_path}" +# Build example packages +f_fpm_path="$(fpm run $@ --runner echo)" +cd ../example_packages/ +rm -rf ./*/build -cd ../example_packages/hello_world +cd hello_world "${f_fpm_path}" build ./build/gfortran_debug/app/hello_world @@ -77,3 +73,6 @@ cd ../link_external cd ../link_executable "${f_fpm_path}" build ./build/gfortran_debug/app/gomp_test + +# Cleanup +rm -rf ./*/build
\ No newline at end of file diff --git a/fpm/fpm.toml b/fpm/fpm.toml index 3952514..66e5049 100644 --- a/fpm/fpm.toml +++ b/fpm/fpm.toml @@ -1,5 +1,5 @@ name = "fpm" -version = "0.1.0" +version = "0.1.1" license = "MIT" author = "fpm maintainers" maintainer = "" diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index fbd91d9..67be1cc 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -8,11 +8,13 @@ use fpm_filesystem, only: is_dir, join_path, number_of_rows, list_files, exists, use fpm_model, only: fpm_model_t, srcfile_t, build_target_t, & FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, & FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST, & - FPM_TARGET_EXECUTABLE + FPM_TARGET_EXECUTABLE, FPM_TARGET_ARCHIVE use fpm_compiler, only: add_compile_flag_defaults + use fpm_sources, only: add_executable_sources, add_sources_from_dir -use fpm_targets, only: targets_from_sources, resolve_module_dependencies +use fpm_targets, only: targets_from_sources, resolve_module_dependencies, & + resolve_target_linking use fpm_manifest, only : get_package_data, package_config_t use fpm_error, only : error_t, fatal_error use fpm_manifest_test, only : test_config_t @@ -238,8 +240,14 @@ subroutine build_model(model, settings, package, error) model%link_flags = model%link_flags // " -l" // model%link_libraries(i)%s end do + if (model%targets(1)%ptr%target_type == FPM_TARGET_ARCHIVE) then + model%library_file = model%targets(1)%ptr%output_file + end if + call resolve_module_dependencies(model%targets,error) + call resolve_target_linking(model%targets) + end subroutine build_model @@ -401,13 +409,7 @@ subroutine cmd_run(settings,test) end if - ! NB. To be replaced after incremental rebuild is implemented - if (.not.settings%list .and. & - any([(.not.exists(executables(i)%s),i=1,size(executables))])) then - - call build_package(model) - - end if + call build_package(model) do i=1,size(executables) if (settings%list) then diff --git a/fpm/src/fpm_backend.f90 b/fpm/src/fpm_backend.f90 index b455398..6b56799 100644 --- a/fpm/src/fpm_backend.f90 +++ b/fpm/src/fpm_backend.f90 @@ -1,113 +1,202 @@ +!> Implements the native fpm build backend module fpm_backend -! Implements the native fpm build backend - -use fpm_environment, only: run, get_os_type, OS_WINDOWS -use fpm_filesystem, only: basename, dirname, join_path, exists, mkdir -use fpm_model, only: fpm_model_t, srcfile_t, build_target_t, FPM_UNIT_MODULE, & - FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, & - FPM_UNIT_CSOURCE, FPM_UNIT_PROGRAM, & - FPM_SCOPE_TEST, FPM_TARGET_OBJECT, FPM_TARGET_ARCHIVE, FPM_TARGET_EXECUTABLE +use fpm_environment, only: run +use fpm_filesystem, only: dirname, join_path, exists, mkdir +use fpm_model, only: fpm_model_t, build_target_t, build_target_ptr, & + FPM_TARGET_OBJECT, FPM_TARGET_ARCHIVE, FPM_TARGET_EXECUTABLE -use fpm_strings, only: split +use fpm_strings, only: string_cat implicit none private -public :: build_package +public :: build_package, sort_target, schedule_targets contains - +!> Top-level routine to build package described by `model` subroutine build_package(model) type(fpm_model_t), intent(inout) :: model - integer :: i, ilib - character(:), allocatable :: base, linking, subdir, link_flags + integer :: i, j + type(build_target_ptr), allocatable :: queue(:) + integer, allocatable :: schedule_ptr(:) - if (.not.exists(model%output_directory)) then - call mkdir(model%output_directory) - end if + ! Need to make output directory for include (mod) files if (.not.exists(join_path(model%output_directory,model%package_name))) then call mkdir(join_path(model%output_directory,model%package_name)) end if - if (model%targets(1)%ptr%target_type == FPM_TARGET_ARCHIVE) then - linking = " "//model%targets(1)%ptr%output_file - else - linking = " " - end if - - linking = linking//" "//model%link_flags - + ! Perform depth-first topological sort of targets do i=1,size(model%targets) - call build_target(model,model%targets(i)%ptr,linking) + call sort_target(model%targets(i)%ptr) end do -end subroutine build_package + ! Construct build schedule queue + call schedule_targets(queue, schedule_ptr, model%targets) + ! Loop over parallel schedule regions + do i=1,size(schedule_ptr)-1 + ! Build targets in schedule region i + !$omp parallel do default(shared) + do j=schedule_ptr(i),(schedule_ptr(i+1)-1) + + call build_target(model,queue(j)%ptr) + + end do + + end do + +end subroutine build_package -recursive subroutine build_target(model,target,linking) - ! Compile Fortran source, called recursively on it dependents - ! - type(fpm_model_t), intent(in) :: model - type(build_target_t), intent(inout) :: target - character(:), allocatable, intent(in) :: linking - integer :: i, j, ilib +!> 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. +!> +recursive subroutine sort_target(target) + type(build_target_t), intent(inout), target :: target + + integer :: i, j, fh, stat type(build_target_t), pointer :: exe_obj - character(:), allocatable :: objs, link_flags - if (target%built) then + ! Check if target has already been processed (as a dependency) + if (target%sorted .or. target%skip) then return end if + ! Check for a circular dependency + ! (If target has been touched but not processed) if (target%touched) then write(*,*) '(!) Circular dependency found with: ',target%output_file stop else - target%touched = .true. + target%touched = .true. ! Set touched flag end if - objs = " " + ! Load cached source file digest if present + if (.not.allocated(target%digest_cached) .and. & + exists(target%output_file) .and. & + exists(target%output_file//'.digest')) then - do i=1,size(target%dependencies) + allocate(target%digest_cached) + open(newunit=fh,file=target%output_file//'.digest',status='old') + read(fh,*,iostat=stat) target%digest_cached + close(fh) - if (associated(target%dependencies(i)%ptr)) then - call build_target(model,target%dependencies(i)%ptr,linking) + if (stat /= 0) then ! Cached digest is not recognized + deallocate(target%digest_cached) end if - if (target%target_type == FPM_TARGET_ARCHIVE ) then + end if + + if (allocated(target%source)) then - ! Construct object list for archive - objs = objs//" "//target%dependencies(i)%ptr%output_file + ! Skip if target is source-based and source file is unmodified + if (allocated(target%digest_cached)) then + if (target%digest_cached == target%source%digest) target%skip = .true. + end if - else if (target%target_type == FPM_TARGET_EXECUTABLE .and. & - target%dependencies(i)%ptr%target_type == FPM_TARGET_OBJECT) then + elseif (exists(target%output_file)) then - exe_obj => target%dependencies(i)%ptr - - ! Construct object list for executable - objs = " "//exe_obj%output_file - - ! Include non-library object dependencies - do j=1,size(exe_obj%dependencies) + ! Skip if target is not source-based and already exists + target%skip = .true. - if (allocated(exe_obj%dependencies(j)%ptr%source)) then - if (exe_obj%dependencies(j)%ptr%source%unit_scope == exe_obj%source%unit_scope) then - objs = objs//" "//exe_obj%dependencies(j)%ptr%output_file - end if - end if + end if - end do + ! Loop over target dependencies + target%schedule = 1 + do i=1,size(target%dependencies) + + ! Sort dependency + call sort_target(target%dependencies(i)%ptr) + + if (.not.target%dependencies(i)%ptr%skip) then + + ! Can't skip target if any dependency is not skipped + target%skip = .false. + + ! Set target schedule after all of its dependencies + target%schedule = max(target%schedule,target%dependencies(i)%ptr%schedule+1) end if end do + ! Mark flag as processed: either sorted or skipped + target%sorted = .not.target%skip + +end subroutine sort_target + + +!> Construct a build schedule from the sorted targets. +!> +!> The schedule is broken into regions, described by `schedule_ptr`, +!> where targets in each region can be compiled in parallel. +!> +subroutine schedule_targets(queue, schedule_ptr, targets) + type(build_target_ptr), allocatable, intent(out) :: queue(:) + integer, allocatable :: schedule_ptr(:) + type(build_target_ptr), intent(in) :: targets(:) + + integer :: i, j + integer :: n_schedule, n_sorted + + n_schedule = 0 ! Number of schedule regions + n_sorted = 0 ! Total number of targets to build + do i=1,size(targets) + + if (targets(i)%ptr%sorted) then + n_sorted = n_sorted + 1 + end if + n_schedule = max(n_schedule, targets(i)%ptr%schedule) + + end do + + allocate(queue(n_sorted)) + allocate(schedule_ptr(n_schedule+1)) + + ! Construct the target queue and schedule region pointer + n_sorted = 1 + schedule_ptr(n_sorted) = 1 + do i=1,n_schedule + + do j=1,size(targets) + + if (targets(j)%ptr%sorted) then + if (targets(j)%ptr%schedule == i) then + + queue(n_sorted)%ptr => targets(j)%ptr + n_sorted = n_sorted + 1 + end if + end if + + end do + + schedule_ptr(i+1) = n_sorted + + end do + +end subroutine schedule_targets + + +!> Call compile/link command for a single target. +!> +!> If successful, also caches the source file digest to disk. +!> +subroutine build_target(model,target) + type(fpm_model_t), intent(in) :: model + type(build_target_t), intent(in), target :: target + + integer :: ilib, fh + character(:), allocatable :: link_flags + if (.not.exists(dirname(target%output_file))) then call mkdir(dirname(target%output_file)) end if @@ -119,22 +208,34 @@ recursive subroutine build_target(model,target,linking) // " -o " // target%output_file) case (FPM_TARGET_EXECUTABLE) - link_flags = linking + + link_flags = string_cat(target%link_objects," ") + + if (allocated(model%library_file)) then + link_flags = link_flags//" "//model%library_file//" "//model%link_flags + else + link_flags = link_flags//" "//model%link_flags + end if + if (allocated(target%link_libraries)) then - do ilib = 1, size(target%link_libraries) - link_flags = link_flags // " -l" // target%link_libraries(ilib)%s - end do + if (size(target%link_libraries) > 0) then + link_flags = link_flags // " -l" // string_cat(target%link_libraries," -l") + end if end if - - call run(model%fortran_compiler // objs // model%fortran_compile_flags & - //link_flags// " -o " // target%output_file) + + call run(model%fortran_compiler// " " // model%fortran_compile_flags & + //" "//link_flags// " -o " // target%output_file) case (FPM_TARGET_ARCHIVE) - call run("ar -rs " // target%output_file // objs) + call run("ar -rs " // target%output_file // " " // string_cat(target%link_objects," ")) end select - target%built = .true. + if (allocated(target%source)) then + open(newunit=fh,file=target%output_file//'.digest',status='unknown') + write(fh,*) target%source%digest + close(fh) + end if end subroutine build_target diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90 index b3a232f..d65296d 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -87,7 +87,7 @@ contains case default ; os_type = "OS Type: UNKNOWN" end select version_text = [character(len=80) :: & - & 'Version: 0.1.0, Pre-alpha', & + & 'Version: 0.1.1, alpha', & & 'Program: fpm(1)', & & 'Description: A Fortran package manager and build system', & & 'Home Page: https://github.com/fortran-lang/fpm', & diff --git a/fpm/src/fpm_model.f90 b/fpm/src/fpm_model.f90 index 20f174b..031af78 100644 --- a/fpm/src/fpm_model.f90 +++ b/fpm/src/fpm_model.f90 @@ -1,5 +1,6 @@ module fpm_model ! Definition and validation of the backend model +use iso_fortran_env, only: int64 use fpm_strings, only: string_t implicit none @@ -53,6 +54,8 @@ type srcfile_t ! Files INCLUDEd by this source file type(string_t), allocatable :: link_libraries(:) ! Native libraries to link against + integer(int64) :: digest + ! Current hash end type srcfile_t type build_target_ptr @@ -70,9 +73,20 @@ type build_target_t integer :: target_type = FPM_TARGET_UNKNOWN type(string_t), allocatable :: link_libraries(:) ! Native libraries to link against + type(string_t), allocatable :: link_objects(:) + ! Objects needed to link this target - logical :: built = .false. logical :: touched = .false. + ! Flag set when first visited to check for circular dependencies + logical :: sorted = .false. + ! Flag set if build target is sorted for building + logical :: skip = .false. + ! Flag set if build target will be skipped (not built) + + integer :: schedule = -1 + ! Targets in the same schedule group are guaranteed to be independent + integer(int64), allocatable :: digest_cached + ! Previous hash end type build_target_t @@ -89,6 +103,8 @@ type :: fpm_model_t ! Command line flags passed to fortran for compilation character(:), allocatable :: link_flags ! Command line flags pass for linking + character(:), allocatable :: library_file + ! Output file for library archive character(:), allocatable :: output_directory ! Base directory for build type(string_t), allocatable :: link_libraries(:) diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index 5e42430..5e78d6e 100644 --- a/fpm/src/fpm_sources.f90 +++ b/fpm/src/fpm_sources.f90 @@ -7,7 +7,7 @@ use fpm_model, only: srcfile_t, fpm_model_t, & FPM_SCOPE_LIB, FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST use fpm_filesystem, only: basename, canon_path, dirname, join_path, read_lines, list_files -use fpm_strings, only: lower, split, str_ends_with, string_t, operator(.in.) +use fpm_strings, only: lower, split, str_ends_with, string_t, operator(.in.), fnv_1a use fpm_manifest_executable, only: executable_config_t implicit none @@ -233,6 +233,8 @@ function parse_f_source(f_filename,error) result(f_source) file_lines = read_lines(fh) close(fh) + f_source%digest = fnv_1a(file_lines) + do pass = 1,2 n_use = 0 n_include = 0 @@ -512,6 +514,8 @@ function parse_c_source(c_filename,error) result(c_source) file_lines = read_lines(fh) close(fh) + c_source%digest = fnv_1a(file_lines) + do pass = 1,2 n_include = 0 file_loop: do i=1,size(file_lines) diff --git a/fpm/src/fpm_strings.f90 b/fpm/src/fpm_strings.f90 index a6511c9..8a569cd 100644 --- a/fpm/src/fpm_strings.f90 +++ b/fpm/src/fpm_strings.f90 @@ -1,9 +1,10 @@ module fpm_strings +use iso_fortran_env, only: int64 implicit none private public :: f_string, lower, split, str_ends_with, string_t -public :: string_array_contains, operator(.in.) +public :: string_array_contains, string_cat, operator(.in.), fnv_1a type string_t character(len=:), allocatable :: s @@ -13,6 +14,11 @@ interface operator(.in.) module procedure string_array_contains end interface +interface fnv_1a + procedure :: fnv_1a_char + procedure :: fnv_1a_string_t +end interface fnv_1a + contains logical function str_ends_with(s, e) result(r) @@ -48,6 +54,46 @@ function f_string(c_string) end function f_string +!> Hash a character(*) string of default kind +pure function fnv_1a_char(input, seed) result(hash) + character(*), intent(in) :: input + integer(int64), intent(in), optional :: seed + integer(int64) :: hash + + integer :: i + integer(int64), parameter :: FNV_OFFSET_32 = 2166136261_int64 + integer(int64), parameter :: FNV_PRIME_32 = 16777619_int64 + + if (present(seed)) then + hash = seed + else + hash = FNV_OFFSET_32 + end if + + do i=1,len(input) + hash = ieor(hash,iachar(input(i:i),int64)) * FNV_PRIME_32 + end do + +end function fnv_1a_char + + +!> Hash a string_t array of default kind +pure function fnv_1a_string_t(input, seed) result(hash) + type(string_t), intent(in) :: input(:) + integer(int64), intent(in), optional :: seed + integer(int64) :: hash + + integer :: i + + hash = fnv_1a(input(1)%s,seed) + + do i=2,size(input) + hash = fnv_1a(input(i)%s,hash) + end do + +end function fnv_1a_string_t + + elemental pure function lower(str,begin,end) result (string) ! Changes a string to lowercase over specified range ! Author: John S. Urban @@ -94,6 +140,35 @@ logical function string_array_contains(search_string,array) end function string_array_contains +!> Concatenate an array of type(string_t) into +!> a single character +function string_cat(strings,delim) result(cat) + type(string_t), intent(in) :: strings(:) + character(*), intent(in), optional :: delim + character(:), allocatable :: cat + + integer :: i,n + character(:), allocatable :: delim_str + + if (size(strings) < 1) then + cat = '' + return + end if + + if (present(delim)) then + delim_str = delim + else + delim_str = '' + end if + + cat = strings(1)%s + do i=2,size(strings) + + cat = cat//delim_str//strings(i)%s + + end do + +end function string_cat subroutine split(input_line,array,delimiters,order,nulls) ! parse string on delimiter characters and store tokens into an allocatable array" @@ -155,7 +230,7 @@ subroutine split(input_line,array,delimiters,order,nulls) select case (ilen) - case (:0) ! command was totally blank + case (0) ! command was totally blank case default ! there is at least one non-delimiter in INPUT_LINE if get here icol=1 ! initialize pointer into input line diff --git a/fpm/src/fpm_targets.f90 b/fpm/src/fpm_targets.f90 index c3a59fd..03996f7 100644 --- a/fpm/src/fpm_targets.f90 +++ b/fpm/src/fpm_targets.f90 @@ -13,9 +13,16 @@ subroutine targets_from_sources(model,sources) type(srcfile_t), intent(in) :: sources(:) integer :: i + character(:), allocatable :: xsuffix type(build_target_t), pointer :: dep logical :: with_lib + if (get_os_type() == OS_WINDOWS) then + xsuffix = '.exe' + else + xsuffix = '' + end if + with_lib = any([(sources(i)%unit_scope == FPM_SCOPE_LIB,i=1,size(sources))]) if (with_lib) call add_target(model%targets,type = FPM_TARGET_ARCHIVE,& @@ -46,11 +53,13 @@ subroutine targets_from_sources(model,sources) if (sources(i)%unit_scope == FPM_SCOPE_APP) then call add_target(model%targets,type = FPM_TARGET_EXECUTABLE,& link_libraries = sources(i)%link_libraries, & - output_file = join_path(model%output_directory,'app',sources(i)%exe_name)) + output_file = join_path(model%output_directory,'app', & + sources(i)%exe_name//xsuffix)) else call add_target(model%targets,type = FPM_TARGET_EXECUTABLE,& link_libraries = sources(i)%link_libraries, & - output_file = join_path(model%output_directory,'test',sources(i)%exe_name)) + output_file = join_path(model%output_directory,'test', & + sources(i)%exe_name//xsuffix)) end if @@ -249,4 +258,62 @@ function find_module_dependency(targets,module_name,include_dir) result(target_p end function find_module_dependency + +!> For link targets, enumerate any dependency objects required for linking +subroutine resolve_target_linking(targets) + type(build_target_ptr), intent(inout), target :: targets(:) + + integer :: i,j,k + type(string_t) :: link_object + + do i=1,size(targets) + + associate(target => targets(i)%ptr) + + allocate(target%link_objects(0)) + + do j=1,size(target%dependencies) + + if (target%target_type == FPM_TARGET_ARCHIVE ) then + + ! Construct object list for archive + link_object%s = target%dependencies(j)%ptr%output_file + target%link_objects = [target%link_objects, link_object] + + else if (target%target_type == FPM_TARGET_EXECUTABLE .and. & + target%dependencies(j)%ptr%target_type == FPM_TARGET_OBJECT) then + + associate(exe_obj => target%dependencies(j)%ptr) + + ! Construct object list for executable + link_object%s = exe_obj%output_file + target%link_objects = [target%link_objects, link_object] + + ! Include non-library object dependencies + do k=1,size(exe_obj%dependencies) + + if (allocated(exe_obj%dependencies(k)%ptr%source)) then + if (exe_obj%dependencies(k)%ptr%source%unit_scope == & + exe_obj%source%unit_scope) then + + link_object%s = exe_obj%dependencies(k)%ptr%output_file + target%link_objects = [target%link_objects, link_object] + + end if + end if + + end do + + end associate + + end if + + end do + end associate + + end do + +end subroutine resolve_target_linking + + end module fpm_targets diff --git a/fpm/test/fpm_test/main.f90 b/fpm/test/fpm_test/main.f90 index eb08a94..1ba5c6a 100644 --- a/fpm/test/fpm_test/main.f90 +++ b/fpm/test/fpm_test/main.f90 @@ -7,6 +7,7 @@ program fpm_testing use test_manifest, only : collect_manifest use test_source_parsing, only : collect_source_parsing use test_module_dependencies, only : collect_module_dependencies + use test_backend, only: collect_backend use test_versioning, only : collect_versioning implicit none integer :: stat, is @@ -21,6 +22,7 @@ program fpm_testing & new_testsuite("fpm_manifest", collect_manifest), & & new_testsuite("fpm_source_parsing", collect_source_parsing), & & new_testsuite("fpm_module_dependencies", collect_module_dependencies), & + & new_testsuite("fpm_test_backend", collect_backend), & & new_testsuite("fpm_versioning", collect_versioning) & & ] diff --git a/fpm/test/fpm_test/test_backend.f90 b/fpm/test/fpm_test/test_backend.f90 new file mode 100644 index 0000000..a7a3f0b --- /dev/null +++ b/fpm/test/fpm_test/test_backend.f90 @@ -0,0 +1,353 @@ +!> Define tests for the `fpm_backend` module (build scheduling) +module test_backend + use testsuite, only : new_unittest, unittest_t, error_t, test_failed + use test_module_dependencies, only: operator(.in.) + use fpm_filesystem, only: exists, mkdir, get_temp_filename + use fpm_model, only: build_target_t, build_target_ptr, & + FPM_TARGET_OBJECT, FPM_TARGET_ARCHIVE + use fpm_targets, only: add_target, add_dependency + use fpm_backend, only: sort_target, schedule_targets + implicit none + private + + public :: collect_backend + +contains + + + !> Collect all exported unit tests + subroutine collect_backend(testsuite) + + !> Collection of tests + type(unittest_t), allocatable, intent(out) :: testsuite(:) + + testsuite = [ & + & new_unittest("target-sort", test_target_sort), & + & new_unittest("target-sort-skip-all", test_target_sort_skip_all), & + & new_unittest("target-sort-rebuild-all", test_target_sort_rebuild_all), & + & new_unittest("schedule-targets", test_schedule_targets), & + & new_unittest("schedule-targets-empty", test_schedule_empty) & + ] + + end subroutine collect_backend + + + !> Check scheduling of objects with dependencies + subroutine test_target_sort(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(build_target_ptr), allocatable :: targets(:) + + integer :: i + + targets = new_test_package() + + ! Perform depth-first topological sort of targets + do i=1,size(targets) + + call sort_target(targets(i)%ptr) + + end do + + ! Check target states: all targets scheduled + do i=1,size(targets) + + if (.not.targets(i)%ptr%touched) then + call test_failed(error,"Target touched flag not set") + return + end if + + if (.not.targets(i)%ptr%sorted) then + call test_failed(error,"Target sort flag not set") + return + end if + + if (targets(i)%ptr%skip) then + call test_failed(error,"Target skip flag set incorrectly") + return + end if + + if (targets(i)%ptr%schedule < 0) then + call test_failed(error,"Target schedule not set") + return + end if + + end do + + ! Check all objects sheduled before library + do i=2,size(targets) + + if (targets(i)%ptr%schedule >= targets(1)%ptr%schedule) then + call test_failed(error,"Object dependency scheduled after dependent library target") + return + end if + + end do + + ! Check target 4 schedule before targets 2 & 3 + do i=2,3 + if (targets(4)%ptr%schedule >= targets(i)%ptr%schedule) then + call test_failed(error,"Object dependency scheduled after dependent object target") + return + end if + end do + + end subroutine test_target_sort + + + + !> Check incremental rebuild for existing archive + !> all object sources are unmodified: all objects should be skipped + subroutine test_target_sort_skip_all(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(build_target_ptr), allocatable :: targets(:) + + integer :: fh, i + + targets = new_test_package() + + do i=2,size(targets) + + ! Mimick unmodified sources + allocate(targets(i)%ptr%source) + targets(i)%ptr%source%digest = i + targets(i)%ptr%digest_cached = i + + end do + + ! Mimick archive already exists + open(newunit=fh,file=targets(1)%ptr%output_file,status="unknown") + close(fh) + + ! Perform depth-first topological sort of targets + do i=1,size(targets) + + call sort_target(targets(i)%ptr) + + end do + + ! Check target states: all targets skipped + do i=1,size(targets) + + if (.not.targets(i)%ptr%touched) then + call test_failed(error,"Target touched flag not set") + return + end if + + if (targets(i)%ptr%sorted) then + call test_failed(error,"Target sort flag set incorrectly") + return + end if + + if (.not.targets(i)%ptr%skip) then + call test_failed(error,"Target skip flag set incorrectly") + return + end if + + end do + + end subroutine test_target_sort_skip_all + + + !> Check incremental rebuild for existing archive + !> all but lowest source modified: all objects should be rebuilt + subroutine test_target_sort_rebuild_all(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(build_target_ptr), allocatable :: targets(:) + + integer :: fh, i + + targets = new_test_package() + + do i=2,3 + + ! Mimick unmodified sources + allocate(targets(i)%ptr%source) + targets(i)%ptr%source%digest = i + targets(i)%ptr%digest_cached = i + + end do + + ! Mimick archive already exists + open(newunit=fh,file=targets(1)%ptr%output_file,status="unknown") + close(fh) + + ! Perform depth-first topological sort of targets + do i=1,size(targets) + + call sort_target(targets(i)%ptr) + + end do + + ! Check target states: all targets scheduled + do i=1,size(targets) + + if (.not.targets(i)%ptr%sorted) then + call test_failed(error,"Target sort flag not set") + return + end if + + if (targets(i)%ptr%skip) then + call test_failed(error,"Target skip flag set incorrectly") + return + end if + + end do + + end subroutine test_target_sort_rebuild_all + + + !> Check construction of target queue and schedule + subroutine test_schedule_targets(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(build_target_ptr), allocatable :: targets(:) + + integer :: i, j + type(build_target_ptr), allocatable :: queue(:) + integer, allocatable :: schedule_ptr(:) + + targets = new_test_package() + + ! Perform depth-first topological sort of targets + do i=1,size(targets) + + call sort_target(targets(i)%ptr) + + end do + + ! Construct build schedule queue + call schedule_targets(queue, schedule_ptr, targets) + + ! Check all targets enqueued + do i=1,size(targets) + + if (.not.(targets(i)%ptr.in.queue)) then + + call test_failed(error,"Target not found in build queue") + return + + end if + + end do + + ! Check schedule structure + if (schedule_ptr(1) /= 1) then + + call test_failed(error,"schedule_ptr(1) does not point to start of the queue") + return + + end if + + if (schedule_ptr(size(schedule_ptr)) /= size(queue)+1) then + + call test_failed(error,"schedule_ptr(end) does not point to end of the queue") + return + + end if + + do i=1,size(schedule_ptr)-1 + + do j=schedule_ptr(i),(schedule_ptr(i+1)-1) + + if (queue(j)%ptr%schedule /= i) then + + call test_failed(error,"Target scheduled in the wrong region") + return + + end if + + end do + + end do + + end subroutine test_schedule_targets + + + !> Check construction of target queue and schedule + !> when there's nothing to do (all targets skipped) + subroutine test_schedule_empty(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(build_target_ptr), allocatable :: targets(:) + + integer :: i + type(build_target_ptr), allocatable :: queue(:) + integer, allocatable :: schedule_ptr(:) + + targets = new_test_package() + + do i=1,size(targets) + + targets(i)%ptr%skip = .true. + + end do + + ! Perform depth-first topological sort of targets + do i=1,size(targets) + + call sort_target(targets(i)%ptr) + + end do + + ! Construct build schedule queue + call schedule_targets(queue, schedule_ptr, targets) + + ! Check queue is empty + if (size(queue) > 0) then + + call test_failed(error,"Expecting an empty build queue, but not empty") + return + + end if + + ! Check schedule loop is not entered + do i=1,size(schedule_ptr)-1 + + call test_failed(error,"Attempted to run an empty schedule") + return + + end do + + end subroutine test_schedule_empty + + + !> Helper to generate target objects with dependencies + function new_test_package() result(targets) + + type(build_target_ptr), allocatable :: targets(:) + + call add_target(targets,FPM_TARGET_ARCHIVE,get_temp_filename()) + + call add_target(targets,FPM_TARGET_OBJECT,get_temp_filename()) + + call add_target(targets,FPM_TARGET_OBJECT,get_temp_filename()) + + call add_target(targets,FPM_TARGET_OBJECT,get_temp_filename()) + + ! Library depends on all objects + call add_dependency(targets(1)%ptr,targets(2)%ptr) + call add_dependency(targets(1)%ptr,targets(3)%ptr) + call add_dependency(targets(1)%ptr,targets(4)%ptr) + + ! Inter-object dependency + ! targets 2 & 3 depend on target 4 + call add_dependency(targets(2)%ptr,targets(4)%ptr) + call add_dependency(targets(3)%ptr,targets(4)%ptr) + + end function new_test_package + + +end module test_backend
\ No newline at end of file diff --git a/fpm/test/fpm_test/test_module_dependencies.f90 b/fpm/test/fpm_test/test_module_dependencies.f90 index c73db30..18929ac 100644 --- a/fpm/test/fpm_test/test_module_dependencies.f90 +++ b/fpm/test/fpm_test/test_module_dependencies.f90 @@ -12,7 +12,7 @@ module test_module_dependencies implicit none private - public :: collect_module_dependencies + public :: collect_module_dependencies, operator(.in.) interface operator(.in.) module procedure target_in |