From 09e7c7d9c255e2cda5eaf59fb0c5e1706cdfc69b Mon Sep 17 00:00:00 2001 From: LKedward Date: Sat, 21 Nov 2020 13:06:28 +0000 Subject: Add: simple string hashing functions --- fpm/src/fpm_strings.f90 | 48 +++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 47 insertions(+), 1 deletion(-) diff --git a/fpm/src/fpm_strings.f90 b/fpm/src/fpm_strings.f90 index a6511c9..3c64a08 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, 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 -- cgit v1.2.3 From d90e4c318f527d3b26f66e91df5fc34ea5c1d35d Mon Sep 17 00:00:00 2001 From: LKedward Date: Sat, 21 Nov 2020 13:09:11 +0000 Subject: Update: source processing with file hashes --- fpm/src/fpm_model.f90 | 3 +++ fpm/src/fpm_sources.f90 | 6 +++++- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/fpm/src/fpm_model.f90 b/fpm/src/fpm_model.f90 index 20f174b..94dde91 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 diff --git a/fpm/src/fpm_sources.f90 b/fpm/src/fpm_sources.f90 index fa5c6e7..7428662 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_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) -- cgit v1.2.3 From b26b2730f5828d4991f98391dfc3aaa9ae4629b5 Mon Sep 17 00:00:00 2001 From: LKedward Date: Sat, 21 Nov 2020 13:09:49 +0000 Subject: Refactor: backend for incremental rebuilding --- fpm/src/fpm_backend.f90 | 105 +++++++++++++++++++++++++++++++++++++++--------- fpm/src/fpm_model.f90 | 7 +++- 2 files changed, 92 insertions(+), 20 deletions(-) diff --git a/fpm/src/fpm_backend.f90 b/fpm/src/fpm_backend.f90 index 3cb95d7..aa087ea 100644 --- a/fpm/src/fpm_backend.f90 +++ b/fpm/src/fpm_backend.f90 @@ -4,8 +4,8 @@ module fpm_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, & +use fpm_model, only: fpm_model_t, srcfile_t, build_target_t, build_target_ptr, & + 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 @@ -24,6 +24,9 @@ subroutine build_package(model) integer :: i, ilib character(:), allocatable :: base, linking, subdir, link_flags + type(build_target_ptr), allocatable :: queue(:) + + allocate(queue(0)) if (.not.exists(model%output_directory)) then call mkdir(model%output_directory) @@ -42,26 +45,32 @@ subroutine build_package(model) do i=1,size(model%targets) - call build_target(model,model%targets(i)%ptr,linking) + call schedule_target(queue,model%targets(i)%ptr) end do + do i=1,size(queue) + + call build_target(model,queue(i)%ptr,linking) + + end do + end subroutine build_package -recursive subroutine build_target(model,target,linking) +recursive subroutine schedule_target(queue,target) ! 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 + type(build_target_ptr), intent(inout), allocatable :: queue(:) + type(build_target_t), intent(inout), target :: target - integer :: i, j, ilib + integer :: i, j, fh, stat type(build_target_t), pointer :: exe_obj - character(:), allocatable :: objs, link_flags + type(build_target_ptr) :: q_ptr + character(:), allocatable :: link_flags - if (target%built) then + if (target%enqueued .or. target%skip) then return end if @@ -72,18 +81,47 @@ recursive subroutine build_target(model,target,linking) target%touched = .true. end if - objs = " " + if (.not.allocated(target%digest_cached) .and. & + exists(target%output_file) .and. & + exists(target%output_file//'.digest')) then + + allocate(target%digest_cached) + open(newunit=fh,file=target%output_file//'.digest',status='old') + read(fh,*,iostat=stat) target%digest_cached + close(fh) + + if (stat /= 0) then + write(*,*) 'Internal error: unable to read cached source hash' + write(*,*) target%output_file//'.digest',' stat = ', stat + error stop + end if + + end if + + if (allocated(target%source)) then + if (allocated(target%digest_cached)) then + if (target%digest_cached == target%source%digest) target%skip = .true. + end if + else + target%skip = .true. + end if + + target%link_objects = " " do i=1,size(target%dependencies) - if (associated(target%dependencies(i)%ptr)) then - call build_target(model,target%dependencies(i)%ptr,linking) + call schedule_target(queue,target%dependencies(i)%ptr) + + if (.not.target%dependencies(i)%ptr%skip) then + + target%skip = .false. + end if if (target%target_type == FPM_TARGET_ARCHIVE ) then ! Construct object list for archive - objs = objs//" "//target%dependencies(i)%ptr%output_file + target%link_objects = target%link_objects//" "//target%dependencies(i)%ptr%output_file else if (target%target_type == FPM_TARGET_EXECUTABLE .and. & target%dependencies(i)%ptr%target_type == FPM_TARGET_OBJECT) then @@ -91,14 +129,14 @@ recursive subroutine build_target(model,target,linking) exe_obj => target%dependencies(i)%ptr ! Construct object list for executable - objs = " "//exe_obj%output_file + target%link_objects = " "//exe_obj%output_file ! Include non-library object dependencies do j=1,size(exe_obj%dependencies) 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 + target%link_objects = target%link_objects//" "//exe_obj%dependencies(j)%ptr%output_file end if end if @@ -108,6 +146,31 @@ recursive subroutine build_target(model,target,linking) end do + if ( target%skip ) then + + return + + end if + + q_ptr%ptr => target + queue = [queue, q_ptr] + target%enqueued = .true. + + ! target%built = .true. + +end subroutine schedule_target + + + + +subroutine build_target(model,target,linking) + type(fpm_model_t), intent(in) :: model + type(build_target_t), intent(inout), target :: target + character(*), intent(in) :: linking + + integer :: ilib, fh + character(:), allocatable :: link_flags + if (.not.exists(dirname(target%output_file))) then call mkdir(dirname(target%output_file)) end if @@ -126,15 +189,19 @@ recursive subroutine build_target(model,target,linking) end do end if - call run("gfortran " // objs // model%fortran_compile_flags & + call run("gfortran " // target%link_objects // 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 // 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_model.f90 b/fpm/src/fpm_model.f90 index 94dde91..2b8f312 100644 --- a/fpm/src/fpm_model.f90 +++ b/fpm/src/fpm_model.f90 @@ -74,8 +74,13 @@ type build_target_t type(string_t), allocatable :: link_libraries(:) ! Native libraries to link against - logical :: built = .false. + character(:), allocatable :: link_objects logical :: touched = .false. + logical :: enqueued = .false. + logical :: skip = .false. + + integer(int64), allocatable :: digest_cached + ! Previous hash end type build_target_t -- cgit v1.2.3 From 993fbd43742b141d972de2256617f48fd756cd52 Mon Sep 17 00:00:00 2001 From: LKedward Date: Sat, 21 Nov 2020 14:08:23 +0000 Subject: Update: run command for incremental rebuilds --- fpm/src/fpm.f90 | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index daa4d98..95327b7 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -439,13 +439,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 -- cgit v1.2.3 From 0d387fc7077070bb7ccbc54658a27d9db361688c Mon Sep 17 00:00:00 2001 From: LKedward Date: Sat, 21 Nov 2020 16:14:12 +0000 Subject: Refactor: backend build scheduling Separate build targets into schedule regions for parallel builds. --- fpm/src/fpm.f90 | 6 ++- fpm/src/fpm_backend.f90 | 114 +++++++++++++++++++++++++++++++----------------- fpm/src/fpm_model.f90 | 10 ++++- 3 files changed, 88 insertions(+), 42 deletions(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 95327b7..c822571 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -11,7 +11,7 @@ use fpm_model, only: fpm_model_t, srcfile_t, build_target_t, & FPM_TARGET_EXECUTABLE 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, FPM_TARGET_ARCHIVE use fpm_manifest, only : get_package_data, default_executable, & default_library, package_t, default_test use fpm_error, only : error_t, fatal_error @@ -241,6 +241,10 @@ 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) end subroutine build_model diff --git a/fpm/src/fpm_backend.f90 b/fpm/src/fpm_backend.f90 index aa087ea..08ea899 100644 --- a/fpm/src/fpm_backend.f90 +++ b/fpm/src/fpm_backend.f90 @@ -22,11 +22,9 @@ contains 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(:) - - allocate(queue(0)) + integer, allocatable :: region_ptr(:) if (.not.exists(model%output_directory)) then call mkdir(model%output_directory) @@ -35,45 +33,47 @@ subroutine build_package(model) 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 - do i=1,size(model%targets) - call schedule_target(queue,model%targets(i)%ptr) + call schedule_target(model%targets(i)%ptr) end do - do i=1,size(queue) + call get_build_queue(queue, region_ptr, model%targets) - call build_target(model,queue(i)%ptr,linking) + do i=1,size(region_ptr)-1 + + !$OMP PARALLEL DO DEFAULT(SHARED) + do j=region_ptr(i),(region_ptr(i+1)-1) + + call build_target(model,queue(j)%ptr) + + end do + !$OMP END PARALLEL DO end do + end subroutine build_package -recursive subroutine schedule_target(queue,target) - ! Compile Fortran source, called recursively on it dependents +recursive subroutine schedule_target(target) + ! ! - type(build_target_ptr), intent(inout), allocatable :: queue(:) type(build_target_t), intent(inout), target :: target integer :: i, j, fh, stat type(build_target_t), pointer :: exe_obj - type(build_target_ptr) :: q_ptr - character(:), allocatable :: link_flags - if (target%enqueued .or. target%skip) then + if (target%scheduled .or. target%skip) then return end if + if (.not.exists(dirname(target%output_file))) then + call mkdir(dirname(target%output_file)) + end if + if (target%touched) then write(*,*) '(!) Circular dependency found with: ',target%output_file stop @@ -102,19 +102,20 @@ recursive subroutine schedule_target(queue,target) if (allocated(target%digest_cached)) then if (target%digest_cached == target%source%digest) target%skip = .true. end if - else + elseif (exists(target%output_file)) then target%skip = .true. end if target%link_objects = " " - + target%region = 1 do i=1,size(target%dependencies) - call schedule_target(queue,target%dependencies(i)%ptr) + call schedule_target(target%dependencies(i)%ptr) if (.not.target%dependencies(i)%ptr%skip) then target%skip = .false. + target%region = max(target%region,target%dependencies(i)%ptr%region+1) end if @@ -146,35 +147,63 @@ recursive subroutine schedule_target(queue,target) end do - if ( target%skip ) then + target%scheduled = .not.target%skip - return +end subroutine schedule_target - end if - q_ptr%ptr => target - queue = [queue, q_ptr] - target%enqueued = .true. +subroutine get_build_queue(queue, region_ptr, targets) + type(build_target_ptr), allocatable, intent(out) :: queue(:) + integer, allocatable :: region_ptr(:) + type(build_target_ptr), intent(in) :: targets(:) - ! target%built = .true. + integer :: i, j + integer :: nRegion, n_scheduled -end subroutine schedule_target + nRegion = 0 + n_scheduled = 0 + do i=1,size(targets) + if (targets(i)%ptr%scheduled) then + n_scheduled = n_scheduled + 1 + end if + nRegion = max(nRegion, targets(i)%ptr%region) + + end do + + allocate(queue(n_scheduled)) + allocate(region_ptr(nRegion+1)) + + n_scheduled = 1 + region_ptr(n_scheduled) = 1 + do i=1,nRegion + + do j=1,size(targets) + + if (targets(j)%ptr%scheduled) then + if (targets(j)%ptr%region == i) then + + queue(n_scheduled)%ptr => targets(j)%ptr + n_scheduled = n_scheduled + 1 + end if + end if + + end do + region_ptr(i+1) = n_scheduled + + end do + +end subroutine get_build_queue -subroutine build_target(model,target,linking) +subroutine build_target(model,target) type(fpm_model_t), intent(in) :: model - type(build_target_t), intent(inout), target :: target - character(*), intent(in) :: linking + 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 - select case(target%target_type) case (FPM_TARGET_OBJECT) @@ -182,7 +211,12 @@ subroutine build_target(model,target,linking) // " -o " // target%output_file) case (FPM_TARGET_EXECUTABLE) - link_flags = linking + if (allocated(model%library_file)) then + link_flags = " "//model%library_file//" "//model%link_flags + else + 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 diff --git a/fpm/src/fpm_model.f90 b/fpm/src/fpm_model.f90 index 2b8f312..3a879ad 100644 --- a/fpm/src/fpm_model.f90 +++ b/fpm/src/fpm_model.f90 @@ -75,10 +75,16 @@ type build_target_t ! Native libraries to link against character(:), allocatable :: link_objects + ! Objects needed to link this target logical :: touched = .false. - logical :: enqueued = .false. + ! Flag set when first visited to check for circular dependencies + logical :: scheduled = .false. + ! Flag set if build target is scheduled for building logical :: skip = .false. + ! Flag set if build target will be skipped (not built) + integer :: region + ! Targets in the same region are guaranteed independent integer(int64), allocatable :: digest_cached ! Previous hash @@ -97,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(:) -- cgit v1.2.3 From 9c342f496ade0fd6355566ee13a70192902d1f87 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sun, 22 Nov 2020 14:25:42 +0000 Subject: Minor fix: explicitly specify .exe suffix in windows. --- fpm/src/fpm_targets.f90 | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/fpm/src/fpm_targets.f90 b/fpm/src/fpm_targets.f90 index c3a59fd..364e9d8 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 -- cgit v1.2.3 From 0a5440e413cd55ba72e200178a72c5544b618a31 Mon Sep 17 00:00:00 2001 From: LKedward Date: Mon, 23 Nov 2020 15:40:04 +0000 Subject: Cleanup and refactor for PR Move enumeration of link target object dependencies out of backend and into fpm_targets module. Add string_cat function for concatenating arrays of string_t. Add comments and procedure descriptions. --- fpm/src/fpm.f90 | 7 +- fpm/src/fpm_backend.f90 | 176 ++++++++++++++++++++++++------------------------ fpm/src/fpm_model.f90 | 12 ++-- fpm/src/fpm_strings.f90 | 28 +++++++- fpm/src/fpm_targets.f90 | 58 ++++++++++++++++ 5 files changed, 183 insertions(+), 98 deletions(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index c822571..9c9e5db 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -8,10 +8,11 @@ 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_sources, only: add_executable_sources, add_sources_from_dir -use fpm_targets, only: targets_from_sources, resolve_module_dependencies, FPM_TARGET_ARCHIVE +use fpm_targets, only: targets_from_sources, resolve_module_dependencies, & + resolve_target_linking use fpm_manifest, only : get_package_data, default_executable, & default_library, package_t, default_test use fpm_error, only : error_t, fatal_error @@ -247,6 +248,8 @@ subroutine build_model(model, settings, package, error) call resolve_module_dependencies(model%targets,error) + call resolve_target_linking(model%targets) + end subroutine build_model !> Apply package defaults diff --git a/fpm/src/fpm_backend.f90 b/fpm/src/fpm_backend.f90 index 08ea899..9e45c86 100644 --- a/fpm/src/fpm_backend.f90 +++ b/fpm/src/fpm_backend.f90 @@ -1,50 +1,49 @@ +!> 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, build_target_ptr, & - 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, j type(build_target_ptr), allocatable :: queue(:) - integer, allocatable :: region_ptr(:) + 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 + ! Perform depth-first topological sort of targets do i=1,size(model%targets) - call schedule_target(model%targets(i)%ptr) + call sort_target(model%targets(i)%ptr) end do - call get_build_queue(queue, region_ptr, model%targets) + ! Construct build schedule queue + call schedule_targets(queue, schedule_ptr, model%targets) - do i=1,size(region_ptr)-1 + ! 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=region_ptr(i),(region_ptr(i+1)-1) + do j=schedule_ptr(i),(schedule_ptr(i+1)-1) call build_target(model,queue(j)%ptr) @@ -52,35 +51,37 @@ subroutine build_package(model) !$OMP END PARALLEL DO end do - end subroutine build_package - -recursive subroutine schedule_target(target) - ! - ! +!> Topologically sort a target for scheduling by +!> recursing over it's 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 - if (target%scheduled .or. target%skip) then + ! Check if target has already been processed (as a dependency) + if (target%sorted .or. target%skip) then return end if - if (.not.exists(dirname(target%output_file))) then - call mkdir(dirname(target%output_file)) - 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 + ! 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 @@ -90,113 +91,106 @@ recursive subroutine schedule_target(target) read(fh,*,iostat=stat) target%digest_cached close(fh) - if (stat /= 0) then - write(*,*) 'Internal error: unable to read cached source hash' - write(*,*) target%output_file//'.digest',' stat = ', stat - error stop + if (stat /= 0) then ! Cached digest is not recognized + deallocate(target%digest_cached) end if end if if (allocated(target%source)) then + + ! 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 + elseif (exists(target%output_file)) then + + ! Skip if target is not source-based and already exists target%skip = .true. + end if - target%link_objects = " " - target%region = 1 + ! Loop over target dependencies + target%schedule = 1 do i=1,size(target%dependencies) - call schedule_target(target%dependencies(i)%ptr) + ! 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. - target%region = max(target%region,target%dependencies(i)%ptr%region+1) - end if - - if (target%target_type == FPM_TARGET_ARCHIVE ) then - - ! Construct object list for archive - target%link_objects = target%link_objects//" "//target%dependencies(i)%ptr%output_file - - else if (target%target_type == FPM_TARGET_EXECUTABLE .and. & - target%dependencies(i)%ptr%target_type == FPM_TARGET_OBJECT) then - - exe_obj => target%dependencies(i)%ptr - - ! Construct object list for executable - target%link_objects = " "//exe_obj%output_file - - ! Include non-library object dependencies - do j=1,size(exe_obj%dependencies) - - if (allocated(exe_obj%dependencies(j)%ptr%source)) then - if (exe_obj%dependencies(j)%ptr%source%unit_scope == exe_obj%source%unit_scope) then - target%link_objects = target%link_objects//" "//exe_obj%dependencies(j)%ptr%output_file - end if - end if - - end do + ! Set target schedule after all of its dependencies + target%schedule = max(target%schedule,target%dependencies(i)%ptr%schedule+1) end if end do - target%scheduled = .not.target%skip + ! Mark flag as processed: either sorted or skipped + target%sorted = .not.target%skip -end subroutine schedule_target +end subroutine sort_target -subroutine get_build_queue(queue, region_ptr, targets) +!> 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 :: region_ptr(:) + integer, allocatable :: schedule_ptr(:) type(build_target_ptr), intent(in) :: targets(:) integer :: i, j - integer :: nRegion, n_scheduled + integer :: n_schedule, n_sorted - nRegion = 0 - n_scheduled = 0 + 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%scheduled) then - n_scheduled = n_scheduled + 1 + if (targets(i)%ptr%sorted) then + n_sorted = n_sorted + 1 end if - nRegion = max(nRegion, targets(i)%ptr%region) + n_schedule = max(n_schedule, targets(i)%ptr%schedule) end do - allocate(queue(n_scheduled)) - allocate(region_ptr(nRegion+1)) + allocate(queue(n_sorted)) + allocate(schedule_ptr(n_schedule+1)) - n_scheduled = 1 - region_ptr(n_scheduled) = 1 - do i=1,nRegion + ! 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%scheduled) then - if (targets(j)%ptr%region == i) then + if (targets(j)%ptr%sorted) then + if (targets(j)%ptr%schedule == i) then - queue(n_scheduled)%ptr => targets(j)%ptr - n_scheduled = n_scheduled + 1 + queue(n_sorted)%ptr => targets(j)%ptr + n_sorted = n_sorted + 1 end if end if end do - region_ptr(i+1) = n_scheduled + schedule_ptr(i+1) = n_sorted end do -end subroutine get_build_queue +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 @@ -204,6 +198,10 @@ subroutine build_target(model,target) integer :: ilib, fh character(:), allocatable :: link_flags + if (.not.exists(dirname(target%output_file))) then + call mkdir(dirname(target%output_file)) + end if + select case(target%target_type) case (FPM_TARGET_OBJECT) @@ -218,16 +216,16 @@ subroutine build_target(model,target) 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("gfortran " // target%link_objects // model%fortran_compile_flags & + call run("gfortran " // string_cat(target%link_objects," ") // model%fortran_compile_flags & //link_flags// " -o " // target%output_file) case (FPM_TARGET_ARCHIVE) - call run("ar -rs " // target%output_file // target%link_objects) + call run("ar -rs " // target%output_file // " " // string_cat(target%link_objects," ")) end select diff --git a/fpm/src/fpm_model.f90 b/fpm/src/fpm_model.f90 index 3a879ad..e38f58a 100644 --- a/fpm/src/fpm_model.f90 +++ b/fpm/src/fpm_model.f90 @@ -73,18 +73,18 @@ type build_target_t integer :: target_type = FPM_TARGET_UNKNOWN type(string_t), allocatable :: link_libraries(:) ! Native libraries to link against - - character(:), allocatable :: link_objects + type(string_t), allocatable :: link_objects(:) ! Objects needed to link this target + logical :: touched = .false. ! Flag set when first visited to check for circular dependencies - logical :: scheduled = .false. - ! Flag set if build target is scheduled for building + 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 :: region - ! Targets in the same region are guaranteed independent + integer :: schedule + ! Targets in the same schedule group are guaranteed to be independent integer(int64), allocatable :: digest_cached ! Previous hash diff --git a/fpm/src/fpm_strings.f90 b/fpm/src/fpm_strings.f90 index 3c64a08..2d1cb72 100644 --- a/fpm/src/fpm_strings.f90 +++ b/fpm/src/fpm_strings.f90 @@ -4,7 +4,7 @@ implicit none private public :: f_string, lower, split, str_ends_with, string_t -public :: string_array_contains, operator(.in.), fnv_1a +public :: string_array_contains, string_cat, operator(.in.), fnv_1a type string_t character(len=:), allocatable :: s @@ -140,6 +140,32 @@ 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) return + + 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" diff --git a/fpm/src/fpm_targets.f90 b/fpm/src/fpm_targets.f90 index 364e9d8..03996f7 100644 --- a/fpm/src/fpm_targets.f90 +++ b/fpm/src/fpm_targets.f90 @@ -258,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 -- cgit v1.2.3 From 71c7b9422a4da58ad92f72f00e83ec91e76e0cd0 Mon Sep 17 00:00:00 2001 From: LKedward Date: Mon, 23 Nov 2020 17:55:07 +0000 Subject: Minor fix: for link flag concatenation --- fpm/src/fpm_backend.f90 | 13 ++++++++----- fpm/src/fpm_strings.f90 | 5 ++++- 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/fpm/src/fpm_backend.f90 b/fpm/src/fpm_backend.f90 index 9e45c86..ab8a27c 100644 --- a/fpm/src/fpm_backend.f90 +++ b/fpm/src/fpm_backend.f90 @@ -209,10 +209,13 @@ subroutine build_target(model,target) // " -o " // target%output_file) case (FPM_TARGET_EXECUTABLE) + + link_flags = string_cat(target%link_objects," ") + if (allocated(model%library_file)) then - link_flags = " "//model%library_file//" "//model%link_flags + link_flags = link_flags//" "//model%library_file//" "//model%link_flags else - link_flags = " "//model%link_flags + link_flags = link_flags//" "//model%link_flags end if if (allocated(target%link_libraries)) then @@ -220,9 +223,9 @@ subroutine build_target(model,target) link_flags = link_flags // " -l" // string_cat(target%link_libraries," -l") end if end if - - call run("gfortran " // string_cat(target%link_objects," ") // model%fortran_compile_flags & - //link_flags// " -o " // target%output_file) + + call run("gfortran " // model%fortran_compile_flags & + //" "//link_flags// " -o " // target%output_file) case (FPM_TARGET_ARCHIVE) call run("ar -rs " // target%output_file // " " // string_cat(target%link_objects," ")) diff --git a/fpm/src/fpm_strings.f90 b/fpm/src/fpm_strings.f90 index 2d1cb72..6935215 100644 --- a/fpm/src/fpm_strings.f90 +++ b/fpm/src/fpm_strings.f90 @@ -150,7 +150,10 @@ function string_cat(strings,delim) result(cat) integer :: i,n character(:), allocatable :: delim_str - if (size(strings) < 1) return + if (size(strings) < 1) then + cat = '' + return + end if if (present(delim)) then delim_str = delim -- cgit v1.2.3 From a16a2b789975f248b5603370a08acefe5b2686ec Mon Sep 17 00:00:00 2001 From: LKedward Date: Wed, 25 Nov 2020 11:41:35 +0000 Subject: Add: testsuite for backend build scheduling routines --- fpm/src/fpm_model.f90 | 2 +- fpm/test/fpm_test/main.f90 | 2 + fpm/test/fpm_test/test_backend.f90 | 353 +++++++++++++++++++++++++ fpm/test/fpm_test/test_module_dependencies.f90 | 2 +- 4 files changed, 357 insertions(+), 2 deletions(-) create mode 100644 fpm/test/fpm_test/test_backend.f90 diff --git a/fpm/src/fpm_model.f90 b/fpm/src/fpm_model.f90 index e38f58a..031af78 100644 --- a/fpm/src/fpm_model.f90 +++ b/fpm/src/fpm_model.f90 @@ -83,7 +83,7 @@ type build_target_t logical :: skip = .false. ! Flag set if build target will be skipped (not built) - integer :: schedule + integer :: schedule = -1 ! Targets in the same schedule group are guaranteed to be independent integer(int64), allocatable :: digest_cached ! Previous hash 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 -- cgit v1.2.3 From d57c59128ebea30ba29febdf98e739ce12880865 Mon Sep 17 00:00:00 2001 From: LKedward Date: Sat, 28 Nov 2020 16:32:10 +0000 Subject: Changes for review Lowercase openmp pragmas --- fpm/src/fpm_backend.f90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/fpm/src/fpm_backend.f90 b/fpm/src/fpm_backend.f90 index ab8a27c..d0843a3 100644 --- a/fpm/src/fpm_backend.f90 +++ b/fpm/src/fpm_backend.f90 @@ -42,13 +42,12 @@ subroutine build_package(model) do i=1,size(schedule_ptr)-1 ! Build targets in schedule region i - !$OMP PARALLEL DO DEFAULT(SHARED) + !$omp parallel do default(shared) do j=schedule_ptr(i),(schedule_ptr(i+1)-1) call build_target(model,queue(j)%ptr) end do - !$OMP END PARALLEL DO end do @@ -56,7 +55,7 @@ end subroutine build_package !> Topologically sort a target for scheduling by -!> recursing over it's dependencies. +!> 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. -- cgit v1.2.3 From 7d2f2162d517fc984124bf32e128899b9cdc809c Mon Sep 17 00:00:00 2001 From: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> Date: Sun, 29 Nov 2020 19:01:54 +0100 Subject: Rewrite README to focus on the Fortran fpm version - describe complete bootstapping process in collapsed details section --- README.md | 76 +++++++++++++++++++++++++++++++++++++++++++++------------------ 1 file changed, 54 insertions(+), 22 deletions(-) diff --git a/README.md b/README.md index a9d1a02..5025615 100644 --- a/README.md +++ b/README.md @@ -24,7 +24,44 @@ __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 +For other platforms and architectures have a look at the [bootstrapping instructions](#bootstrapping-fpm). + +### Creating a new project + +Creating a new *fpm* project is as simple as running the command +`fpm new project_name`. This will create a new folder in your current directory +with the following contents and initialized as a git repository. + +* `fpm.toml` – with your project’s name and some default standard meta-data +* `README.md` – with your project’s name +* `.gitignore` +* `src/project_name.f90` – with a simple hello world subroutine +* `app/main.f90` (if `--with-executable` flag used) – a program that calls the subroutine +* `test/main.f90` (if `--with-test` flag used) – an empty test program + +### Building your Fortran project with fpm + +*fpm* understands the basic commands: + +* `fpm build` – build your library, executables and tests +* `fpm run` – run executables +* `fpm test` – run tests + +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"`. + +See additional instructions in the [Packaging guide](PACKAGING.md) or +the [manifest reference](manifest-reference.md). + +
+Bootstrapping instructions + +### 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. #### Install Haskell @@ -64,31 +101,26 @@ $ stack install On Linux, the above command installs `fpm` to `${HOME}/.local/bin/`. -### Creating a new project +Now you can build the Fortran *fpm* version with -Creating a new *fpm* project is as simple as running the command -`fpm new project_name`. This will create a new folder in your current directory -with the following contents and initialized as a git repository. +```bash +$ cd fpm/ +$ fpm build +``` -* `fpm.toml` – with your project’s name and some default standard meta-data -* `README.md` – with your project’s name -* `.gitignore` -* `src/project_name.f90` – with a simple hello world subroutine -* `app/main.f90` (if `--with-executable` flag used) – a program that calls the subroutine -* `test/main.f90` (if `--with-test` flag used) – an empty test program +Test that everything is working as expected -### Building your Fortran project with fpm +```bash +$ fpm test +``` -*fpm* understands the basic commands: +Finally, install the Fortran *fpm* version with -* `fpm build` – build your library, executables and tests -* `fpm run` – run executables -* `fpm test` – run tests +```bash +$ fpm run --runner cp -- ~/.local/bin +``` -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"`. +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. -See additional instructions in the [Packaging guide](PACKAGING.md) or -the [manifest reference](manifest-reference.md). +
-- cgit v1.2.3 From 240060f49ac937b3582d91f13f6e6d66422ebcd6 Mon Sep 17 00:00:00 2001 From: LKedward Date: Mon, 30 Nov 2020 14:58:58 +0000 Subject: Update: CI to also test release version --- .github/workflows/CI.yml | 9 ++++++--- ci/run_tests.bat | 28 ++++++++++++++++++++++++---- ci/run_tests.sh | 35 +++++++++++++++++------------------ 3 files changed, 47 insertions(+), 25 deletions(-) diff --git a/.github/workflows/CI.yml b/.github/workflows/CI.yml index 8165ded..2b3b6bf 100644 --- a/.github/workflows/CI.yml +++ b/.github/workflows/CI.yml @@ -29,7 +29,7 @@ jobs: STACK_CACHE_VERSION: "" 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: "fpm run ${{ env.RELEASE_FLAGS }} --runner 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' -- {} @@ -40,7 +40,7 @@ jobs: STACK_CACHE_VERSION: "v2" 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: "fpm run ${{ env.RELEASE_FLAGS }} --runner 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' -- {} @@ -51,13 +51,14 @@ jobs: STACK_CACHE_VERSION: "v2" 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: fpm run ${{ env.RELEASE_FLAGS }} --runner 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"))} env: FC: gfortran GCC_V: ${{ matrix.gcc_v }} + RELEASE_FLAGS: --flag -g --flag -fbacktrace --flag -O3 steps: - name: Checkout code @@ -120,11 +121,13 @@ jobs: if: contains(matrix.os, 'ubuntu') || contains(matrix.os, 'macos') run: | ci/run_tests.sh + ci/run_tests.sh ${{ env.RELEASE_FLAGS }} - name: Build and run Fortran fpm (Windows) if: contains(matrix.os, 'windows') run: | ci\run_tests.bat + ci\run_tests.bat ${{ env.RELEASE_FLAGS }} # ----- Upload binaries if creating a release ----- - name: Check that fpm --version matches release tag 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 -- cgit v1.2.3 From 67a459170ce664a531d684337c57df809d528a9b Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Mon, 30 Nov 2020 15:05:21 +0000 Subject: Update CI.yml --- .github/workflows/CI.yml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/.github/workflows/CI.yml b/.github/workflows/CI.yml index 2b3b6bf..ba0af66 100644 --- a/.github/workflows/CI.yml +++ b/.github/workflows/CI.yml @@ -29,7 +29,7 @@ jobs: STACK_CACHE_VERSION: "" GET_VERSION_CMD: echo ${{ github.ref }} | cut -dv -f2 CHECK_VERSION_CMD: grep $(cat fpm_version) - RELEASE_CMD: "fpm run ${{ env.RELEASE_FLAGS }} --runner cp -- fpm-v$(cat fpm_version)-linux-x86_64" + RELEASE_CMD: "fpm run $RELEASE_FLAGS --runner 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' -- {} @@ -40,7 +40,7 @@ jobs: STACK_CACHE_VERSION: "v2" GET_VERSION_CMD: echo ${{ github.ref }} | cut -dv -f2 CHECK_VERSION_CMD: grep $(cat fpm_version) - RELEASE_CMD: "fpm run ${{ env.RELEASE_FLAGS }} --runner cp -- fpm-v$(cat fpm_version)-macos-x86_64" + RELEASE_CMD: "fpm run $RELEASE_FLAGS --runner 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' -- {} @@ -51,7 +51,7 @@ jobs: STACK_CACHE_VERSION: "v2" 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 ${{ env.RELEASE_FLAGS }} --runner copy -- (-join("fpm-v",(Get-Content fpm_version),"-windows-x86_64.exe")) + RELEASE_CMD: fpm run $RELEASE_FLAGS --runner 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"))} @@ -153,4 +153,4 @@ jobs: file: fpm/fpm-* file_glob: true tag: ${{ github.ref }} - overwrite: true \ No newline at end of file + overwrite: true -- cgit v1.2.3 From 53cdcf1d604f55a20e40b4b1060af31c16e0d253 Mon Sep 17 00:00:00 2001 From: LKedward Date: Mon, 30 Nov 2020 15:24:33 +0000 Subject: Fixes: for Windows release build using mingw-w64-gcc 8.1.0 Workaround for compiler bug when building Windows release. Update M_CLI2 revision to include same fix. --- fpm/fpm.toml | 2 +- fpm/src/fpm_strings.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/fpm/fpm.toml b/fpm/fpm.toml index 7afc0a0..e4f4437 100644 --- a/fpm/fpm.toml +++ b/fpm/fpm.toml @@ -12,7 +12,7 @@ tag = "v0.2.1" [dependencies.M_CLI2] git = "https://github.com/urbanjost/M_CLI2.git" -rev = "893cac0ce374bf07a70ffb9556439c7390e58131" +rev = "e59fb2bfcf36199f1af506f937b3849180454a0f" [[test]] name = "cli-test" diff --git a/fpm/src/fpm_strings.f90 b/fpm/src/fpm_strings.f90 index a6511c9..d1f5150 100644 --- a/fpm/src/fpm_strings.f90 +++ b/fpm/src/fpm_strings.f90 @@ -155,7 +155,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 -- cgit v1.2.3 From 0cffb8af2e4e653f742f2504da571ff21c7ea756 Mon Sep 17 00:00:00 2001 From: LKedward Date: Mon, 30 Nov 2020 15:40:06 +0000 Subject: Bump patch number for new release --- fpm/fpm.toml | 2 +- fpm/src/fpm_command_line.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/fpm/fpm.toml b/fpm/fpm.toml index e4f4437..c30c9b4 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_command_line.f90 b/fpm/src/fpm_command_line.f90 index 50a7d25..03daf6f 100644 --- a/fpm/src/fpm_command_line.f90 +++ b/fpm/src/fpm_command_line.f90 @@ -83,7 +83,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', & -- cgit v1.2.3 From 00443e00d5b0e07ce5a5ef7ec1bca6a7628b3b11 Mon Sep 17 00:00:00 2001 From: LKedward Date: Mon, 30 Nov 2020 16:43:34 +0000 Subject: Add --static flag back to binary releases --- .github/workflows/CI.yml | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/.github/workflows/CI.yml b/.github/workflows/CI.yml index ba0af66..0761de2 100644 --- a/.github/workflows/CI.yml +++ b/.github/workflows/CI.yml @@ -29,9 +29,10 @@ jobs: STACK_CACHE_VERSION: "" GET_VERSION_CMD: echo ${{ github.ref }} | cut -dv -f2 CHECK_VERSION_CMD: grep $(cat fpm_version) - RELEASE_CMD: "fpm run $RELEASE_FLAGS --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: | @@ -40,9 +41,10 @@ jobs: STACK_CACHE_VERSION: "v2" GET_VERSION_CMD: echo ${{ github.ref }} | cut -dv -f2 CHECK_VERSION_CMD: grep $(cat fpm_version) - RELEASE_CMD: "fpm run $RELEASE_FLAGS --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: | @@ -51,14 +53,14 @@ jobs: STACK_CACHE_VERSION: "v2" 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 $RELEASE_FLAGS --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 GCC_V: ${{ matrix.gcc_v }} - RELEASE_FLAGS: --flag -g --flag -fbacktrace --flag -O3 steps: - name: Checkout code @@ -121,13 +123,13 @@ jobs: if: contains(matrix.os, 'ubuntu') || contains(matrix.os, 'macos') run: | ci/run_tests.sh - ci/run_tests.sh ${{ env.RELEASE_FLAGS }} + ci/run_tests.sh ${{ matrix.RELEASE_FLAGS }} - name: Build and run Fortran fpm (Windows) if: contains(matrix.os, 'windows') run: | ci\run_tests.bat - ci\run_tests.bat ${{ env.RELEASE_FLAGS }} + ci\run_tests.bat ${{ matrix.RELEASE_FLAGS }} # ----- Upload binaries if creating a release ----- - name: Check that fpm --version matches release tag @@ -141,7 +143,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 }} -- cgit v1.2.3 From ac2bcb8b6024562571346f829703dede8ec5369e Mon Sep 17 00:00:00 2001 From: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> Date: Mon, 30 Nov 2020 17:46:10 +0100 Subject: Simplify bootstrapping instructions --- README.md | 35 +++++------------------------------ 1 file changed, 5 insertions(+), 30 deletions(-) diff --git a/README.md b/README.md index 5025615..7d966dc 100644 --- a/README.md +++ b/README.md @@ -24,7 +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` -For other platforms and architectures have a look at the [bootstrapping instructions](#bootstrapping-fpm). +For other platforms and architectures have a look at the [bootstrapping instructions](#bootstrapping-instructions). ### Creating a new project @@ -50,27 +50,17 @@ 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 ### 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. -#### 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 @@ -78,25 +68,12 @@ $ git clone https://github.com/fortran-lang/fpm $ cd fpm/ ``` -#### Build and test fpm - -Bootstrap *fpm* using: - -```bash -$ cd bootstrap/ -$ stack build -``` +#### Build a bootstrap version of fpm -To test: +You can use the install script to perform the build of the Haskell version of *fpm* with: ```bash -$ stack test -``` - -To install: - -```bash -$ stack install +$ ./install.sh ``` On Linux, the above command installs `fpm` to `${HOME}/.local/bin/`. @@ -122,5 +99,3 @@ $ 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. - -
-- cgit v1.2.3 From 0282a316388fb4486581276176ba97c6dc97cdba Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Mon, 30 Nov 2020 20:11:12 -0600 Subject: feat: add -fcoarray=single to default gfortran flags --- bootstrap/src/Fpm.hs | 2 ++ 1 file changed, 2 insertions(+) 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 -- cgit v1.2.3 From cbd75552604ac119211534a5d4b7fd79f18e7786 Mon Sep 17 00:00:00 2001 From: LKedward Date: Tue, 1 Dec 2020 13:04:16 +0000 Subject: Separate CI job steps for debug and release builds --- .github/workflows/CI.yml | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) diff --git a/.github/workflows/CI.yml b/.github/workflows/CI.yml index 0761de2..f42d8ff 100644 --- a/.github/workflows/CI.yml +++ b/.github/workflows/CI.yml @@ -27,6 +27,7 @@ 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: "cp -- fpm-v$(cat fpm_version)-linux-x86_64" @@ -39,6 +40,7 @@ jobs: /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: "cp -- fpm-v$(cat fpm_version)-macos-x86_64" @@ -51,6 +53,7 @@ jobs: 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: copy -- (-join("fpm-v",(Get-Content fpm_version),"-windows-x86_64.exe")) @@ -119,17 +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 - ci/run_tests.sh ${{ matrix.RELEASE_FLAGS }} + - 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 - ci\run_tests.bat ${{ matrix.RELEASE_FLAGS }} + - 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 -- cgit v1.2.3