Skip to content

Commit

Permalink
Minimal example of progress bar for backend.
Browse files Browse the repository at this point in the history
  • Loading branch information
LKedward committed Jun 30, 2021
1 parent c3ab3e1 commit 48bb051
Show file tree
Hide file tree
Showing 3 changed files with 104 additions and 15 deletions.
90 changes: 83 additions & 7 deletions src/fpm_backend.f90
Original file line number Diff line number Diff line change
Expand Up @@ -34,6 +34,7 @@ module fpm_backend
FPM_TARGET_C_OBJECT, FPM_TARGET_ARCHIVE, FPM_TARGET_EXECUTABLE
use fpm_strings, only: string_cat, string_t

!$use omp_lib, only: omp_get_num_threads
implicit none

private
Expand All @@ -46,11 +47,16 @@ subroutine build_package(targets,model)
type(build_target_ptr), intent(inout) :: targets(:)
type(fpm_model_t), intent(in) :: model

integer :: i, j
integer :: i, j, n, m, nc
type(build_target_ptr), allocatable :: queue(:)
integer, allocatable :: schedule_ptr(:), stat(:)
logical :: build_failed, skip_current

character(len=*), parameter :: COLOR_RED = char(27)//"[31m"
character(len=*), parameter :: COLOR_GREEN = char(27)//"[32m"
character(len=*), parameter :: COLOR_YELLOW = char(27)//"[93m"
character(len=*), parameter :: COLOR_RESET = char(27)//"[0m"

! 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))
Expand All @@ -72,12 +78,49 @@ subroutine build_package(targets,model)
build_failed = .false.

! Loop over parallel schedule regions
n = 1
nc = 0
do i=1,size(schedule_ptr)-1

!
! do j=schedule_ptr(i),(schedule_ptr(i+1)-1)

! if (allocated(queue(j)%ptr%source)) then
! write(*,*) basename(queue(j)%ptr%source%file_name),'...',repeat(' ',60)
! else
! write(*,*) basename(queue(j)%ptr%output_file),'...',repeat(' ',60)
! end if

! end do

! n = floor(30.0d0*schedule_ptr(i)/schedule_ptr(size(schedule_ptr)))
! write(*,'(A,I4,A)',advance="no") 'Building project |'//repeat('=',n)//repeat(' ',30-n)//'|',100*n/30,'%'//char(13)

! write(*,'(A,I4,A,A)',advance="no") '[',100*schedule_ptr(i)/schedule_ptr(size(schedule_ptr)),'%] Compiling...',char(13)

! Build targets in schedule region i
!$omp parallel do default(shared) private(skip_current) schedule(dynamic,1)
!$omp parallel do default(shared) private(skip_current,m) schedule(dynamic,1)
do j=schedule_ptr(i),(schedule_ptr(i+1)-1)

! !$omp atomic read
! m = n

!$omp critical

m = n

if (allocated(queue(j)%ptr%source)) then
write(*,'(A,T40,A,A)') basename(queue(j)%ptr%source%file_name),COLOR_YELLOW//'compiling...'//COLOR_RESET
else
write(*,'(A,T40,A,A)') basename(queue(j)%ptr%output_file),COLOR_YELLOW//'compiling...'//COLOR_RESET
end if
write(*,'(A,I4,A,A)',advance="no") '[',100*nc/size(queue),'%] Compiling project...',char(13)

n = n + 1


!$omp end critical

! Check if build already failed
!$omp atomic read
skip_current = build_failed
Expand All @@ -92,8 +135,39 @@ subroutine build_package(targets,model)
build_failed = .true.
end if

! !$omp atomic


!$omp critical

nc = nc + 1

write(*,'(A)',advance="no") repeat(char(27)//"[1A",n-m)//char(27)//"[2K"//char(27)//"[1G"
if (allocated(queue(j)%ptr%source)) then
write(*,'(A,T40,A,A)') basename(queue(j)%ptr%source%file_name),COLOR_GREEN//'done.'//COLOR_RESET
else
write(*,'(A,T40,A,A)') basename(queue(j)%ptr%output_file),COLOR_GREEN//'done.'//COLOR_RESET
end if
write(*,'(A)',advance="no") repeat(char(27)//"[1B",n-m)//char(27)//"[2K"//char(27)//"[1G"
! write(*,*) basename(queue(j)%ptr%output_file),'...',repeat(' ',20)
write(*,'(A,I4,A,A)',advance="no") '[',100*nc/size(queue),'%] Compiling project...',char(13)

!$omp end critical

end do

! write(*,*) repeat(char(27)//"[1A",2+(schedule_ptr(i+1)-1)-schedule_ptr(i))
! do j=schedule_ptr(i),(schedule_ptr(i+1)-1)

! if (allocated(queue(j)%ptr%source)) then
! write(*,'(A,T40,A,A)') basename(queue(j)%ptr%source%file_name),COLOR_GREEN//'done.'//COLOR_RESET,repeat(' ',60)
! else
! write(*,'(A,T40,A,A)') basename(queue(j)%ptr%output_file),COLOR_GREEN//'done.'//COLOR_RESET,repeat(' ',60)
! end if


! end do

! Check if this schedule region failed: exit with message if failed
if (build_failed) then
do j=1,size(stat)
Expand All @@ -106,6 +180,8 @@ subroutine build_package(targets,model)

end do

write(*,*) repeat(' ',60)

end subroutine build_package


Expand Down Expand Up @@ -267,28 +343,28 @@ subroutine build_target(model,target,stat)

case (FPM_TARGET_OBJECT)
call run(model%fortran_compiler//" -c " // target%source%file_name // target%compile_flags &
// " -o " // target%output_file, echo=.true., exitstat=stat)
// " -o " // target%output_file, echo=.false., verbose=.false., exitstat=stat)

case (FPM_TARGET_C_OBJECT)
call run(model%c_compiler//" -c " // target%source%file_name // target%compile_flags &
// " -o " // target%output_file, echo=.true., exitstat=stat)
// " -o " // target%output_file, echo=.false., verbose=.false., exitstat=stat)

case (FPM_TARGET_EXECUTABLE)

call run(model%fortran_compiler// " " // target%compile_flags &
//" "//target%link_flags// " -o " // target%output_file, echo=.true., exitstat=stat)
//" "//target%link_flags// " -o " // target%output_file, verbose=.false., echo=.false., exitstat=stat)

case (FPM_TARGET_ARCHIVE)

select case (get_os_type())
case (OS_WINDOWS)
call write_response_file(target%output_file//".resp" ,target%link_objects)
call run(model%archiver // target%output_file // " @" // target%output_file//".resp", &
echo=.true., exitstat=stat)
echo=.false., verbose=.false., exitstat=stat)

case default
call run(model%archiver // target%output_file // " " // string_cat(target%link_objects," "), &
echo=.true., exitstat=stat)
echo=.false., verbose=.false., exitstat=stat)

end select

Expand Down
17 changes: 14 additions & 3 deletions src/fpm_environment.f90
Original file line number Diff line number Diff line change
Expand Up @@ -137,11 +137,12 @@ logical function os_is_unix(os) result(unix)
end function os_is_unix

!> echo command string and pass it to the system for execution
subroutine run(cmd,echo,exitstat)
subroutine run(cmd,echo,verbose,exitstat)
character(len=*), intent(in) :: cmd
logical,intent(in),optional :: echo
logical,intent(in),optional :: verbose
integer, intent(out),optional :: exitstat
logical :: echo_local
logical :: echo_local, verbose_local
integer :: stat

if(present(echo))then
Expand All @@ -151,7 +152,17 @@ subroutine run(cmd,echo,exitstat)
endif
if(echo_local) print *, '+ ', cmd

call execute_command_line(cmd, exitstat=stat)
if (present(verbose)) then
verbose_local = verbose
else
verbose_local = .true.
end if

! if (verbose_local) then
call execute_command_line(cmd//">/dev/null 2>&1", exitstat=stat)
! else
! call execute_command_line(cmd, exitstat=stat)
! end if

if (present(exitstat)) then
exitstat = stat
Expand Down
12 changes: 7 additions & 5 deletions src/fpm_filesystem.f90
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@ module fpm_filesystem
use fpm_environment, only: get_os_type, &
OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, &
OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD
use fpm_environment, only: separator, get_env
use fpm_environment, only: separator, get_env,run
use fpm_strings, only: f_string, replace, string_t, split
implicit none
private
Expand Down Expand Up @@ -297,12 +297,14 @@ subroutine mkdir(dir)

select case (get_os_type())
case (OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD)
call execute_command_line('mkdir -p ' // dir, exitstat=stat)
write (*, '(" + ",2a)') 'mkdir -p ' // dir
call run('mkdir -p ' // dir, echo=.false., exitstat=stat)
! call execute_command_line('mkdir -p ' // dir, exitstat=stat)
! write (*, '(" + ",2a)') 'mkdir -p ' // dir

case (OS_WINDOWS)
call execute_command_line("mkdir " // windows_path(dir), exitstat=stat)
write (*, '(" + ",2a)') 'mkdir ' // windows_path(dir)
call run("mkdir " // windows_path(dir), echo=.false., exitstat=stat)
! call execute_command_line("mkdir " // windows_path(dir), exitstat=stat)
! write (*, '(" + ",2a)') 'mkdir ' // windows_path(dir)
end select

if (stat /= 0) then
Expand Down

0 comments on commit 48bb051

Please sign in to comment.