From 22ec97aceb5239f2b24e58ab05f41e6e9e4abf35 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Mon, 22 Nov 2021 15:56:31 +0000 Subject: [PATCH 01/23] Fix: os_is_unix function --- src/fpm_environment.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fpm_environment.f90 b/src/fpm_environment.f90 index a9f8c65972..bcd9cb9154 100644 --- a/src/fpm_environment.f90 +++ b/src/fpm_environment.f90 @@ -154,7 +154,7 @@ logical function os_is_unix(os) result(unix) else build_os = get_os_type() end if - unix = os /= OS_WINDOWS + unix = build_os /= OS_WINDOWS end function os_is_unix !> echo command string and pass it to the system for execution From d9520ce7ca433c94d4309ee834c0d4494652c4d0 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Mon, 22 Nov 2021 16:08:27 +0000 Subject: [PATCH 02/23] Update: mkdir with optional echo argument --- src/fpm_filesystem.F90 | 24 ++++++++++++++++++++---- 1 file changed, 20 insertions(+), 4 deletions(-) diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90 index 83cffe7366..2b5b787475 100644 --- a/src/fpm_filesystem.F90 +++ b/src/fpm_filesystem.F90 @@ -349,20 +349,36 @@ function read_lines(fh) result(lines) end function read_lines !> Create a directory. Create subdirectories as needed -subroutine mkdir(dir) +subroutine mkdir(dir, echo) character(len=*), intent(in) :: dir - integer :: stat + logical, intent(in), optional :: echo + + integer :: stat + logical :: echo_local + + if(present(echo))then + echo_local=echo + else + echo_local=.true. + end if if (is_dir(dir)) return 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 + + if (echo_local) then + write (*, '(" + ",2a)') 'mkdir -p ' // dir + end if case (OS_WINDOWS) call execute_command_line("mkdir " // windows_path(dir), exitstat=stat) - write (*, '(" + ",2a)') 'mkdir ' // windows_path(dir) + + if (echo_local) then + write (*, '(" + ",2a)') 'mkdir ' // windows_path(dir) + end if + end select if (stat /= 0) then From 2654623adea742b2e10a85aa90706f20f8b87b88 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Mon, 22 Nov 2021 16:08:47 +0000 Subject: [PATCH 03/23] Update: run command with optional verbose argument --- src/fpm_environment.f90 | 28 +++++++++++++++++++++++----- 1 file changed, 23 insertions(+), 5 deletions(-) diff --git a/src/fpm_environment.f90 b/src/fpm_environment.f90 index bcd9cb9154..22094e50d0 100644 --- a/src/fpm_environment.f90 +++ b/src/fpm_environment.f90 @@ -158,22 +158,40 @@ 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,exitstat,verbose) character(len=*), intent(in) :: cmd logical,intent(in),optional :: echo integer, intent(out),optional :: exitstat - logical :: echo_local + logical, intent(in), optional :: verbose + logical :: echo_local, verbose_local integer :: stat + if(present(echo))then echo_local=echo else echo_local=.true. - endif - if(echo_local) print *, '+ ', cmd + end if + + if(present(verbose))then + verbose_local=verbose + else + verbose_local=.true. + end if - call execute_command_line(cmd, exitstat=stat) + if(echo_local) print *, '+ ', cmd + if(verbose_local)then + call execute_command_line(cmd, exitstat=stat) + else + if (os_is_unix()) then + write(*,*) "is_unix" + call execute_command_line(cmd//">/dev/null 2>&1", exitstat=stat) + else + call execute_command_line(cmd//">NUL 2>&1", exitstat=stat) + end if + endif + if (present(exitstat)) then exitstat = stat else From 30d730f51fea587574a922f8763f3c7988198029 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Mon, 22 Nov 2021 16:11:26 +0000 Subject: [PATCH 04/23] Update: backend with verbose argument --- src/fpm.f90 | 4 ++-- src/fpm/cmd/install.f90 | 2 +- src/fpm_backend.f90 | 23 ++++++++++++++++++----- src/isatty.c | 13 +++++++++++++ 4 files changed, 34 insertions(+), 8 deletions(-) create mode 100644 src/isatty.c diff --git a/src/fpm.f90 b/src/fpm.f90 index 6084a112dd..0fec0ed97d 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -284,7 +284,7 @@ subroutine cmd_build(settings) else if (settings%show_model) then call show_model(model) else - call build_package(targets,model) + call build_package(targets,model,verbose=settings%verbose) endif end subroutine cmd_build @@ -415,7 +415,7 @@ subroutine cmd_run(settings,test) end if - call build_package(targets,model) + call build_package(targets,model,verbose=settings%verbose) if (settings%list) then call compact_list() diff --git a/src/fpm/cmd/install.f90 b/src/fpm/cmd/install.f90 index 099a0e511c..46f24a7ae3 100644 --- a/src/fpm/cmd/install.f90 +++ b/src/fpm/cmd/install.f90 @@ -54,7 +54,7 @@ subroutine cmd_install(settings) end if if (.not.settings%no_rebuild) then - call build_package(targets,model) + call build_package(targets,model,verbose=settings%verbose) end if call new_installer(installer, prefix=settings%prefix, & diff --git a/src/fpm_backend.f90 b/src/fpm_backend.f90 index e0c6d73353..731763f30c 100644 --- a/src/fpm_backend.f90 +++ b/src/fpm_backend.f90 @@ -40,12 +40,20 @@ module fpm_backend private public :: build_package, sort_target, schedule_targets +interface + function c_isatty() bind(C, name = 'c_isatty') + use, intrinsic :: iso_c_binding, only: c_int + integer(c_int) :: c_isatty + end function +end interface + contains !> Top-level routine to build package described by `model` -subroutine build_package(targets,model) +subroutine build_package(targets,model,verbose) type(build_target_ptr), intent(inout) :: targets(:) type(fpm_model_t), intent(in) :: model + logical, intent(in) :: verbose integer :: i, j type(build_target_ptr), allocatable :: queue(:) @@ -54,6 +62,8 @@ subroutine build_package(targets,model) type(string_t), allocatable :: build_dirs(:) type(string_t) :: temp + logical :: plain_output + ! Need to make output directory for include (mod) files allocate(build_dirs(0)) do i = 1, size(targets) @@ -65,7 +75,7 @@ subroutine build_package(targets,model) end do do i = 1, size(build_dirs) - call mkdir(build_dirs(i)%s) + call mkdir(build_dirs(i)%s,verbose) end do ! Perform depth-first topological sort of targets @@ -83,6 +93,8 @@ subroutine build_package(targets,model) stat(:) = 0 build_failed = .false. + ! Set output mode + plain_output = (.not.(c_isatty()==1)) .or. verbose ! Loop over parallel schedule regions do i=1,size(schedule_ptr)-1 @@ -95,7 +107,7 @@ subroutine build_package(targets,model) skip_current = build_failed if (.not.skip_current) then - call build_target(model,queue(j)%ptr,stat(j)) + call build_target(model,queue(j)%ptr,verbose,stat(j)) end if ! Set global flag if this target failed to build @@ -261,16 +273,17 @@ end subroutine schedule_targets !> !> If successful, also caches the source file digest to disk. !> -subroutine build_target(model,target,stat) +subroutine build_target(model,target,verbose,stat) type(fpm_model_t), intent(in) :: model type(build_target_t), intent(in), target :: target + logical, intent(in) :: verbose integer, intent(out) :: stat integer :: fh !$omp critical if (.not.exists(dirname(target%output_file))) then - call mkdir(dirname(target%output_file)) + call mkdir(dirname(target%output_file),verbose) end if !$omp end critical diff --git a/src/isatty.c b/src/isatty.c new file mode 100644 index 0000000000..bd0f74a83f --- /dev/null +++ b/src/isatty.c @@ -0,0 +1,13 @@ +#include //for isatty() +#include //for fileno() + +int c_isatty(void) +{ + + if (isatty(fileno(stdin))){ + return 1; + } else { + return 0; + } + +} \ No newline at end of file From 6ea34933fbb991df706d613718acfefee538efdc Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Mon, 22 Nov 2021 16:12:14 +0000 Subject: [PATCH 05/23] Update: fpm_compiler objects with verbose field --- src/fpm.f90 | 5 +++++ src/fpm_compiler.f90 | 16 +++++++++++----- 2 files changed, 16 insertions(+), 5 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 0fec0ed97d..8b05a381d3 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -62,6 +62,11 @@ subroutine build_model(model, settings, package, error) call new_compiler(model%compiler, settings%compiler, settings%c_compiler) call new_archiver(model%archiver, settings%archiver) + model%compiler%verbose = settings%verbose + model%compiler%echo = settings%verbose + model%archiver%verbose = settings%verbose + model%archiver%echo = settings%verbose + if (settings%flag == '') then flags = model%compiler%get_default_flags(settings%profile == "release") else diff --git a/src/fpm_compiler.f90 b/src/fpm_compiler.f90 index c0c5b7349c..e83d7a4c9c 100644 --- a/src/fpm_compiler.f90 +++ b/src/fpm_compiler.f90 @@ -79,6 +79,8 @@ module fpm_compiler character(len=:), allocatable :: cc !> Print all commands logical :: echo = .true. + !> Verbose output of command + logical :: verbose = .true. contains !> Get default compiler flags procedure :: get_default_flags @@ -107,6 +109,8 @@ module fpm_compiler logical :: use_response_file = .false. !> Print all command logical :: echo = .true. + !> Verbose output of command + logical :: verbose = .true. contains !> Create static archive procedure :: make_archive @@ -695,7 +699,7 @@ subroutine compile_fortran(self, input, output, args, stat) integer, intent(out) :: stat call run(self%fc // " -c " // input // " " // args // " -o " // output, & - & echo=self%echo, exitstat=stat) + & echo=self%echo, verbose=self%verbose, exitstat=stat) end subroutine compile_fortran @@ -713,7 +717,7 @@ subroutine compile_c(self, input, output, args, stat) integer, intent(out) :: stat call run(self%cc // " -c " // input // " " // args // " -o " // output, & - & echo=self%echo, exitstat=stat) + & echo=self%echo, verbose=self%verbose, exitstat=stat) end subroutine compile_c @@ -728,7 +732,8 @@ subroutine link(self, output, args, stat) !> Status flag integer, intent(out) :: stat - call run(self%fc // " " // args // " -o " // output, echo=self%echo, exitstat=stat) + call run(self%fc // " " // args // " -o " // output, echo=self%echo, & + & verbose=self%verbose, exitstat=stat) end subroutine link @@ -745,11 +750,12 @@ subroutine make_archive(self, output, args, stat) if (self%use_response_file) then call write_response_file(output//".resp" , args) - call run(self%ar // output // " @" // output//".resp", echo=self%echo, exitstat=stat) + call run(self%ar // output // " @" // output//".resp", echo=self%echo, & + & verbose=self%verbose, exitstat=stat) call delete_file(output//".resp") else call run(self%ar // output // " " // string_cat(args, " "), & - & echo=self%echo, exitstat=stat) + & echo=self%echo, verbose=self%verbose, exitstat=stat) end if end subroutine make_archive From 995fb2e834e4e555e8b6bc32eadb57983ef5b298 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Mon, 22 Nov 2021 16:08:47 +0000 Subject: [PATCH 06/23] Update: run command with optional verbose argument --- src/fpm_environment.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/fpm_environment.f90 b/src/fpm_environment.f90 index 22094e50d0..9c646532e9 100644 --- a/src/fpm_environment.f90 +++ b/src/fpm_environment.f90 @@ -185,7 +185,6 @@ subroutine run(cmd,echo,exitstat,verbose) call execute_command_line(cmd, exitstat=stat) else if (os_is_unix()) then - write(*,*) "is_unix" call execute_command_line(cmd//">/dev/null 2>&1", exitstat=stat) else call execute_command_line(cmd//">NUL 2>&1", exitstat=stat) From bfd9b06249814ad7c4bc47c0f065d6337f87076c Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Mon, 22 Nov 2021 16:13:01 +0000 Subject: [PATCH 07/23] Add: backend_output to manage pretty printing of build progress --- fpm.toml | 5 ++ src/fpm_backend.f90 | 20 +++++++- src/fpm_backend_console.f90 | 82 +++++++++++++++++++++++++++++++ src/fpm_backend_output.f90 | 97 +++++++++++++++++++++++++++++++++++++ 4 files changed, 203 insertions(+), 1 deletion(-) create mode 100644 src/fpm_backend_console.f90 create mode 100644 src/fpm_backend_output.f90 diff --git a/fpm.toml b/fpm.toml index 7289c823e3..f3a297ca62 100644 --- a/fpm.toml +++ b/fpm.toml @@ -14,6 +14,11 @@ rev = "2f5eaba864ff630ba0c3791126a3f811b6e437f3" git = "https://github.com/urbanjost/M_CLI2.git" rev = "ea6bbffc1c2fb0885e994d37ccf0029c99b19f24" +[dependencies.M_attr] +git = "https://github.com/urbanjost/M_attr.git" +rev = "608b9d3b40be9ff2590c23d2089781fd4da76344" + + [[test]] name = "cli-test" source-dir = "test/cli_test" diff --git a/src/fpm_backend.f90 b/src/fpm_backend.f90 index 731763f30c..e0ed972f2b 100644 --- a/src/fpm_backend.f90 +++ b/src/fpm_backend.f90 @@ -35,6 +35,7 @@ module fpm_backend use fpm_strings, only: string_t, operator(.in.) use fpm_targets, only: build_target_t, build_target_ptr, FPM_TARGET_OBJECT, & FPM_TARGET_C_OBJECT, FPM_TARGET_ARCHIVE, FPM_TARGET_EXECUTABLE +use fpm_backend_output implicit none private @@ -62,6 +63,8 @@ subroutine build_package(targets,model,verbose) type(string_t), allocatable :: build_dirs(:) type(string_t) :: temp + type(console_t) :: console + integer :: line, n_complete logical :: plain_output ! Need to make output directory for include (mod) files @@ -92,16 +95,24 @@ subroutine build_package(targets,model,verbose) allocate(stat(size(queue))) stat(:) = 0 build_failed = .false. + n_complete = 0 ! Set output mode plain_output = (.not.(c_isatty()==1)) .or. verbose + call console%init(plain_output) + call output_init(plain_output) + ! Loop over parallel schedule regions do i=1,size(schedule_ptr)-1 ! 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,line) schedule(dynamic,1) do j=schedule_ptr(i),(schedule_ptr(i+1)-1) + ! Update console output + call output_status_compiling(console, line, queue(j)%ptr) + call output_progress(n_complete, size(queue),plain_output) + ! Check if build already failed !$omp atomic read skip_current = build_failed @@ -116,10 +127,15 @@ subroutine build_package(targets,model,verbose) build_failed = .true. end if + ! Update console output + call output_status_complete(console, line, queue(j)%ptr,stat(j), n_complete) + call output_progress(n_complete, size(queue),plain_output) + end do ! Check if this schedule region failed: exit with message if failed if (build_failed) then + write(*,*) '' do j=1,size(stat) if (stat(j) /= 0) then write(stderr,'(*(g0:,1x))') ' Compilation failed for object "',basename(queue(j)%ptr%output_file),'"' @@ -130,6 +146,8 @@ subroutine build_package(targets,model,verbose) end do + call output_progress_complete() + end subroutine build_package diff --git a/src/fpm_backend_console.f90 b/src/fpm_backend_console.f90 new file mode 100644 index 0000000000..4db0cdc59c --- /dev/null +++ b/src/fpm_backend_console.f90 @@ -0,0 +1,82 @@ +module fpm_backend_console +use iso_fortran_env, only: stdout=>output_unit +implicit none + +private +public :: console_t + +character(len=*), parameter :: ESC = char(27) + +type console_t + integer :: n_line = 1 + logical :: plain_mode = .false. + character(:), allocatable :: LINE_RESET + character(:), allocatable :: LINE_UP + character(:), allocatable :: LINE_DOWN +contains + procedure :: init => console_init + procedure :: write_line => console_write_line + procedure :: update_line => console_update_line +end type console_t + +contains + +subroutine console_init(console,plain_mode) + class(console_t), intent(out), target :: console + logical, intent(in), optional :: plain_mode + + if (present(plain_mode)) then + console%plain_mode = plain_mode + end if + + if (console%plain_mode) then + console%LINE_RESET = "" + console%LINE_UP = "" + console%LINE_DOWN = "" + else + console%LINE_RESET = ESC//"[2K"//ESC//"[1G" + console%LINE_UP = ESC//"[1A" + console%LINE_DOWN = ESC//"[1B" + end if + +end subroutine console_init + +function console_write_line(console,str) result(line) + class(console_t), intent(inout), target :: console + character(*), intent(in) :: str + integer :: line + + !$omp critical + line = console%n_line + + write(stdout,*) console%LINE_RESET//str + + console%n_line = console%n_line + 1 + !$omp end critical + +end function console_write_line + +subroutine console_update_line(console,line_no,str) + class(console_t), intent(in) :: console + integer, intent(in) :: line_no + character(*), intent(in) :: str + + integer :: n + + !$omp critical + + n = console%n_line - line_no !+ 1 !+ 1 + + ! Step back to line + write(stdout,'(A)',advance="no") repeat(console%LINE_UP,n)//console%LINE_RESET + + write(stdout,*) str + + ! Step forward to end + write(stdout,'(A)',advance="no") repeat(console%LINE_DOWN,n)//console%LINE_RESET + + !$omp end critical + +end subroutine console_update_line + +end module fpm_backend_console \ No newline at end of file diff --git a/src/fpm_backend_output.f90 b/src/fpm_backend_output.f90 new file mode 100644 index 0000000000..82c019fe4e --- /dev/null +++ b/src/fpm_backend_output.f90 @@ -0,0 +1,97 @@ +module fpm_backend_output +use iso_fortran_env, only: stdout=>output_unit +use fpm_filesystem, only: basename +use fpm_targets, only: build_target_t +use fpm_backend_console, only: console_t +use M_attr, only: attr, attr_mode +implicit none + + +contains + + subroutine output_init(plain_mode) + logical, intent(in), optional :: plain_mode + + if (plain_mode) then + call attr_mode('plain') + else + call attr_mode('color') + end if + + end subroutine output_init + + subroutine output_status_compiling(console, line, target) + type(console_t), intent(inout), target :: console + integer, intent(inout) :: line + type(build_target_t), intent(in) :: target + + character(:), allocatable :: target_name + character(100) :: output_string + + if (allocated(target%source)) then + target_name = basename(target%source%file_name) + else + target_name = basename(target%output_file) + end if + + write(output_string,'(A,T40,A,A)') target_name,attr('compiling...') + + line = console%write_line(trim(output_string)) + + end subroutine output_status_compiling + + subroutine output_status_complete(console, line, target, build_stat, n_complete) + type(console_t), intent(inout), target :: console + integer, intent(in) :: line + type(build_target_t), intent(in) :: target + integer, intent(in) :: build_stat + integer, intent(inout) :: n_complete + + character(:), allocatable :: target_name + character(100) :: output_string + + if (allocated(target%source)) then + target_name = basename(target%source%file_name) + else + target_name = basename(target%output_file) + end if + + if (build_stat == 0) then + write(output_string,'(A,T40,A,A)') target_name,attr('done.') + else + write(output_string,'(A,T40,A,A)') target_name,attr('failed.') + end if + + call console%update_line(line,trim(output_string)) + + !$omp critical + n_complete = n_complete + 1 + !$omp end critical + + end subroutine output_status_complete + + subroutine output_progress(n_complete, total, plain_mode) + integer, intent(in) :: n_complete, total + logical :: plain_mode + + character(:), allocatable :: advance + + if (plain_mode) then + advance = "yes" + else + advance = "no" + end if + + !$omp critical + write(*,'(A,I4,A,A)',advance=advance) '[',100*n_complete/total,'%] Compiling project...' + !$omp end critical + + end subroutine output_progress + + subroutine output_progress_complete() + + write(*,'(A)') char(27)//"[2K"//char(27)//"[1G"//attr('[100%] Project compiled successfully.') + + end subroutine output_progress_complete + +end module fpm_backend_output \ No newline at end of file From 5728b54443059fc07595251743ad1c0965afae58 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Mon, 22 Nov 2021 16:16:07 +0000 Subject: [PATCH 08/23] Bump bootstrap fpm version to 0.3.0 --- .github/workflows/CI.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/CI.yml b/.github/workflows/CI.yml index 2d951dc167..55c548f360 100644 --- a/.github/workflows/CI.yml +++ b/.github/workflows/CI.yml @@ -63,7 +63,7 @@ jobs: - name: Install fpm uses: fortran-lang/setup-fpm@v3 with: - fpm-version: 'v0.2.0' + fpm-version: 'v0.3.0' - name: Remove fpm from path shell: bash From 229761aa6fb342abd42dffdaa968611d48adf3d4 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Mon, 22 Nov 2021 16:18:41 +0000 Subject: [PATCH 09/23] Fix: backend c_isatty for bootstrapping --- src/fpm_backend.f90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/fpm_backend.f90 b/src/fpm_backend.f90 index e0ed972f2b..af50162d07 100644 --- a/src/fpm_backend.f90 +++ b/src/fpm_backend.f90 @@ -41,12 +41,14 @@ module fpm_backend private public :: build_package, sort_target, schedule_targets +#ifndef FPM_BOOTSTRAP interface function c_isatty() bind(C, name = 'c_isatty') use, intrinsic :: iso_c_binding, only: c_int integer(c_int) :: c_isatty end function end interface +#endif contains @@ -98,7 +100,11 @@ subroutine build_package(targets,model,verbose) n_complete = 0 ! Set output mode +#ifndef FPM_BOOTSTRAP plain_output = (.not.(c_isatty()==1)) .or. verbose +#else + plain_output = verbose +#endif call console%init(plain_output) call output_init(plain_output) From 778763233905a7a27d34b066793dc3fc12366ec5 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Tue, 23 Nov 2021 10:15:26 +0000 Subject: [PATCH 10/23] Update: fpm_backend as preprocessed file. --- src/{fpm_backend.f90 => fpm_backend.F90} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename src/{fpm_backend.f90 => fpm_backend.F90} (100%) diff --git a/src/fpm_backend.f90 b/src/fpm_backend.F90 similarity index 100% rename from src/fpm_backend.f90 rename to src/fpm_backend.F90 From 2e2f0e326235c9bca9ee3855f012ab74cc4a56ed Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Tue, 23 Nov 2021 14:50:52 +0000 Subject: [PATCH 11/23] Fix for checking isatty in MSYS2 mintty. --- src/isatty.c | 13 --- src/ptycheck/LICENSE | 22 +++++ src/ptycheck/isatty.c | 26 ++++++ src/ptycheck/iscygpty.c | 185 ++++++++++++++++++++++++++++++++++++++++ src/ptycheck/iscygpty.h | 41 +++++++++ 5 files changed, 274 insertions(+), 13 deletions(-) delete mode 100644 src/isatty.c create mode 100644 src/ptycheck/LICENSE create mode 100644 src/ptycheck/isatty.c create mode 100644 src/ptycheck/iscygpty.c create mode 100644 src/ptycheck/iscygpty.h diff --git a/src/isatty.c b/src/isatty.c deleted file mode 100644 index bd0f74a83f..0000000000 --- a/src/isatty.c +++ /dev/null @@ -1,13 +0,0 @@ -#include //for isatty() -#include //for fileno() - -int c_isatty(void) -{ - - if (isatty(fileno(stdin))){ - return 1; - } else { - return 0; - } - -} \ No newline at end of file diff --git a/src/ptycheck/LICENSE b/src/ptycheck/LICENSE new file mode 100644 index 0000000000..90ee59f15c --- /dev/null +++ b/src/ptycheck/LICENSE @@ -0,0 +1,22 @@ +The MIT License (MIT) + +Copyright (c) 2015-2016 K.Takata + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. + diff --git a/src/ptycheck/isatty.c b/src/ptycheck/isatty.c new file mode 100644 index 0000000000..61acee6f4e --- /dev/null +++ b/src/ptycheck/isatty.c @@ -0,0 +1,26 @@ +#include //for isatty() +#include //for fileno() + +#ifdef __MINGW64__ +#include "iscygpty.h" +#endif + +int c_isatty(void) +{ + + if (isatty(fileno(stdout))){ + return 1; + } else { + + #ifdef __MINGW64__ + if (is_cygpty(fileno(stdout))){ + return 1; + } else { + return 0; + } + #endif + + return 0; + } + +} \ No newline at end of file diff --git a/src/ptycheck/iscygpty.c b/src/ptycheck/iscygpty.c new file mode 100644 index 0000000000..722f88f2f4 --- /dev/null +++ b/src/ptycheck/iscygpty.c @@ -0,0 +1,185 @@ +/* + * iscygpty.c -- part of ptycheck + * https://github.com/k-takata/ptycheck + * + * Copyright (c) 2015-2017 K.Takata + * + * You can redistribute it and/or modify it under the terms of either + * the MIT license (as described below) or the Vim license. + * + * Permission is hereby granted, free of charge, to any person obtaining + * a copy of this software and associated documentation files (the + * "Software"), to deal in the Software without restriction, including + * without limitation the rights to use, copy, modify, merge, publish, + * distribute, sublicense, and/or sell copies of the Software, and to + * permit persons to whom the Software is furnished to do so, subject to + * the following conditions: + * + * The above copyright notice and this permission notice shall be + * included in all copies or substantial portions of the Software. + * + * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, + * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF + * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. + * IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY + * CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, + * TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE + * SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + */ + +#ifdef _WIN32 + +#include +#include +#include +#include + +#ifdef USE_FILEEXTD +/* VC 7.1 or earlier doesn't support SAL. */ +# if !defined(_MSC_VER) || (_MSC_VER < 1400) +# define __out +# define __in +# define __in_opt +# endif +/* Win32 FileID API Library: + * http://www.microsoft.com/en-us/download/details.aspx?id=22599 + * Needed for WinXP. */ +# include +#else /* USE_FILEEXTD */ +/* VC 8 or earlier. */ +# if defined(_MSC_VER) && (_MSC_VER < 1500) +# ifdef ENABLE_STUB_IMPL +# define STUB_IMPL +# else +# error "Win32 FileID API Library is required for VC2005 or earlier." +# endif +# endif +#endif /* USE_FILEEXTD */ + + +#include "iscygpty.h" + +//#define USE_DYNFILEID +#ifdef USE_DYNFILEID +typedef BOOL (WINAPI *pfnGetFileInformationByHandleEx)( + HANDLE hFile, + FILE_INFO_BY_HANDLE_CLASS FileInformationClass, + LPVOID lpFileInformation, + DWORD dwBufferSize +); +static pfnGetFileInformationByHandleEx pGetFileInformationByHandleEx = NULL; + +# ifndef USE_FILEEXTD +static BOOL WINAPI stub_GetFileInformationByHandleEx( + HANDLE hFile, + FILE_INFO_BY_HANDLE_CLASS FileInformationClass, + LPVOID lpFileInformation, + DWORD dwBufferSize + ) +{ + return FALSE; +} +# endif + +static void setup_fileid_api(void) +{ + if (pGetFileInformationByHandleEx != NULL) { + return; + } + pGetFileInformationByHandleEx = (pfnGetFileInformationByHandleEx) + GetProcAddress(GetModuleHandle(TEXT("kernel32.dll")), + "GetFileInformationByHandleEx"); + if (pGetFileInformationByHandleEx == NULL) { +# ifdef USE_FILEEXTD + pGetFileInformationByHandleEx = GetFileInformationByHandleEx; +# else + pGetFileInformationByHandleEx = stub_GetFileInformationByHandleEx; +# endif + } +} +#else +# define pGetFileInformationByHandleEx GetFileInformationByHandleEx +# define setup_fileid_api() +#endif + + +#define is_wprefix(s, prefix) \ + (wcsncmp((s), (prefix), sizeof(prefix) / sizeof(WCHAR) - 1) == 0) + +/* Check if the fd is a cygwin/msys's pty. */ +int is_cygpty(int fd) +{ +#ifdef STUB_IMPL + return 0; +#else + HANDLE h; + int size = sizeof(FILE_NAME_INFO) + sizeof(WCHAR) * (MAX_PATH - 1); + FILE_NAME_INFO *nameinfo; + WCHAR *p = NULL; + + setup_fileid_api(); + + h = (HANDLE) _get_osfhandle(fd); + if (h == INVALID_HANDLE_VALUE) { + return 0; + } + /* Cygwin/msys's pty is a pipe. */ + if (GetFileType(h) != FILE_TYPE_PIPE) { + return 0; + } + nameinfo = malloc(size + sizeof(WCHAR)); + if (nameinfo == NULL) { + return 0; + } + /* Check the name of the pipe: + * '\{cygwin,msys}-XXXXXXXXXXXXXXXX-ptyN-{from,to}-master' */ + if (pGetFileInformationByHandleEx(h, FileNameInfo, nameinfo, size)) { + nameinfo->FileName[nameinfo->FileNameLength / sizeof(WCHAR)] = L'\0'; + p = nameinfo->FileName; + if (is_wprefix(p, L"\\cygwin-")) { /* Cygwin */ + p += 8; + } else if (is_wprefix(p, L"\\msys-")) { /* MSYS and MSYS2 */ + p += 6; + } else { + p = NULL; + } + if (p != NULL) { + while (*p && isxdigit(*p)) /* Skip 16-digit hexadecimal. */ + ++p; + if (is_wprefix(p, L"-pty")) { + p += 4; + } else { + p = NULL; + } + } + if (p != NULL) { + while (*p && isdigit(*p)) /* Skip pty number. */ + ++p; + if (is_wprefix(p, L"-from-master")) { + //p += 12; + } else if (is_wprefix(p, L"-to-master")) { + //p += 10; + } else { + p = NULL; + } + } + } + free(nameinfo); + return (p != NULL); +#endif /* STUB_IMPL */ +} + +/* Check if at least one cygwin/msys pty is used. */ +int is_cygpty_used(void) +{ + int fd, ret = 0; + + for (fd = 0; fd < 3; fd++) { + ret |= is_cygpty(fd); + } + return ret; +} + +#endif /* _WIN32 */ + +/* vim: set ts=4 sw=4: */ diff --git a/src/ptycheck/iscygpty.h b/src/ptycheck/iscygpty.h new file mode 100644 index 0000000000..82fd0affbd --- /dev/null +++ b/src/ptycheck/iscygpty.h @@ -0,0 +1,41 @@ +/* + * iscygpty.h -- part of ptycheck + * https://github.com/k-takata/ptycheck + * + * Copyright (c) 2015-2017 K.Takata + * + * You can redistribute it and/or modify it under the terms of either + * the MIT license (as described below) or the Vim license. + * + * Permission is hereby granted, free of charge, to any person obtaining + * a copy of this software and associated documentation files (the + * "Software"), to deal in the Software without restriction, including + * without limitation the rights to use, copy, modify, merge, publish, + * distribute, sublicense, and/or sell copies of the Software, and to + * permit persons to whom the Software is furnished to do so, subject to + * the following conditions: + * + * The above copyright notice and this permission notice shall be + * included in all copies or substantial portions of the Software. + * + * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, + * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF + * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. + * IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY + * CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, + * TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE + * SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + */ + +#ifndef _ISCYGPTY_H +#define _ISCYGPTY_H + +#ifdef _WIN32 +int is_cygpty(int fd); +int is_cygpty_used(void); +#else +#define is_cygpty(fd) 0 +#define is_cygpty_used() 0 +#endif + +#endif /* _ISCYGPTY_H */ From 8b4f3a683db73c131467e591d319fe2d118bb8a8 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Thu, 25 Nov 2021 11:31:55 +0000 Subject: [PATCH 12/23] Update: Windows CI to use gfortran 9 from winlibs. --- .github/workflows/CI.yml | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/.github/workflows/CI.yml b/.github/workflows/CI.yml index 55c548f360..387463626d 100644 --- a/.github/workflows/CI.yml +++ b/.github/workflows/CI.yml @@ -59,6 +59,15 @@ jobs: --slave /usr/bin/gfortran gfortran /usr/bin/gfortran-${GCC_V} \ --slave /usr/bin/gcov gcov /usr/bin/gcov-${GCC_V} + - name: Install GFortran Windows + if: contains(matrix.os, 'windows') + run: | + Invoke-WebRequest -Uri $Env:GCC_DOWNLOAD -OutFile mingw-w64.zip + Expand-Archive mingw-w64.zip + echo "$pwd\mingw-w64\mingw64\bin" | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append + env: + GCC_DOWNLOAD: "https://github.com/brechtsanders/winlibs_mingw/releases/download/9.4.0-9.0.0-msvcrt-r2/winlibs-x86_64-posix-seh-gcc-9.4.0-mingw-w64-9.0.0-r2.zip" + # Phase 1: Bootstrap fpm with existing version - name: Install fpm uses: fortran-lang/setup-fpm@v3 From b628302b8417c12d5ca4ead439f636f198352b55 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Thu, 25 Nov 2021 15:52:31 +0000 Subject: [PATCH 13/23] Update: run to allow output redirection to file --- src/fpm_environment.f90 | 53 ++++++++++++++++++++++++++++++++--------- 1 file changed, 42 insertions(+), 11 deletions(-) diff --git a/src/fpm_environment.f90 b/src/fpm_environment.f90 index 9c646532e9..e8534ac595 100644 --- a/src/fpm_environment.f90 +++ b/src/fpm_environment.f90 @@ -158,13 +158,17 @@ 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,verbose) + subroutine run(cmd,echo,exitstat,verbose,redirect) character(len=*), intent(in) :: cmd logical,intent(in),optional :: echo integer, intent(out),optional :: exitstat logical, intent(in), optional :: verbose + character(*), intent(in), optional :: redirect + logical :: echo_local, verbose_local - integer :: stat + character(:), allocatable :: redirect_str + character(1000) :: line + integer :: stat, fh, ios if(present(echo))then @@ -178,18 +182,45 @@ subroutine run(cmd,echo,exitstat,verbose) else verbose_local=.true. end if - - if(echo_local) print *, '+ ', cmd - - if(verbose_local)then - call execute_command_line(cmd, exitstat=stat) + + if (present(redirect)) then + redirect_str = ">"//redirect//" 2>&1" else - if (os_is_unix()) then - call execute_command_line(cmd//">/dev/null 2>&1", exitstat=stat) + if(verbose_local)then + ! No redirection but verbose output + redirect_str = "" else - call execute_command_line(cmd//">NUL 2>&1", exitstat=stat) + ! No redirection and non-verbose output + if (os_is_unix()) then + redirect_str = ">/dev/null 2>&1" + else + redirect_str = ">NUL 2>&1" + end if end if - endif + end if + + + if(present(redirect))then + verbose_local=verbose + else + verbose_local=.true. + end if + + if(echo_local) print *, '+ ', cmd + + call execute_command_line(cmd//redirect_str, exitstat=stat) + + if (verbose_local.and.present(redirect)) then + + open(newunit=fh,file=redirect,status='old') + do + read(fh, '(A)', iostat=ios) line + if (ios /= 0) exit + write(*,'(A)') trim(line) + end do + close(fh) + + end if if (present(exitstat)) then exitstat = stat From ab7cb42fddc3cf19fe20c76dac527a9e591b11c2 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Thu, 25 Nov 2021 15:53:29 +0000 Subject: [PATCH 14/23] Update: fpm_compiler & backend to redirect output to log files --- src/fpm_backend.F90 | 42 +++++++++++++++++++++++++++++++++++++----- src/fpm_compiler.f90 | 26 +++++++++++++++++--------- src/fpm_filesystem.F90 | 2 +- src/fpm_targets.f90 | 7 ++++++- 4 files changed, 61 insertions(+), 16 deletions(-) diff --git a/src/fpm_backend.F90 b/src/fpm_backend.F90 index af50162d07..cb2dbc0756 100644 --- a/src/fpm_backend.F90 +++ b/src/fpm_backend.F90 @@ -30,7 +30,7 @@ module fpm_backend use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit use fpm_error, only : fpm_stop use fpm_environment, only: run, get_os_type, OS_WINDOWS -use fpm_filesystem, only: basename, dirname, join_path, exists, mkdir +use fpm_filesystem, only: basename, dirname, join_path, exists, mkdir, LINE_BUFFER_LEN use fpm_model, only: fpm_model_t use fpm_strings, only: string_t, operator(.in.) use fpm_targets, only: build_target_t, build_target_ptr, FPM_TARGET_OBJECT, & @@ -142,6 +142,11 @@ subroutine build_package(targets,model,verbose) ! Check if this schedule region failed: exit with message if failed if (build_failed) then write(*,*) '' + do j=1,size(stat) + if (stat(j) /= 0) Then + call print_build_log(queue(j)%ptr) + end if + end do do j=1,size(stat) if (stat(j) /= 0) then write(stderr,'(*(g0:,1x))') ' Compilation failed for object "',basename(queue(j)%ptr%output_file),'"' @@ -315,18 +320,19 @@ subroutine build_target(model,target,verbose,stat) case (FPM_TARGET_OBJECT) call model%compiler%compile_fortran(target%source%file_name, target%output_file, & - & target%compile_flags, stat) + & target%compile_flags, target%output_log_file, stat) case (FPM_TARGET_C_OBJECT) call model%compiler%compile_c(target%source%file_name, target%output_file, & - & target%compile_flags, stat) + & target%compile_flags, target%output_log_file, stat) case (FPM_TARGET_EXECUTABLE) call model%compiler%link(target%output_file, & - & target%compile_flags//" "//target%link_flags, stat) + & target%compile_flags//" "//target%link_flags, target%output_log_file, stat) case (FPM_TARGET_ARCHIVE) - call model%archiver%make_archive(target%output_file, target%link_objects, stat) + call model%archiver%make_archive(target%output_file, target%link_objects, & + & target%output_log_file, stat) end select @@ -339,4 +345,30 @@ subroutine build_target(model,target,verbose,stat) end subroutine build_target +!> Read and print the build log for target +!> +subroutine print_build_log(target) + type(build_target_t), intent(in), target :: target + + integer :: fh, ios + character(LINE_BUFFER_LEN) :: line + + if (exists(target%output_log_file)) then + + open(newunit=fh,file=target%output_log_file,status='old') + do + read(fh, '(A)', iostat=ios) line + if (ios /= 0) exit + write(*,'(A)') trim(line) + end do + close(fh) + + else + + write(stderr,'(*(g0:,1x))') ' Unable to find build log "',basename(target%output_log_file),'"' + + end if + +end subroutine print_build_log + end module fpm_backend diff --git a/src/fpm_compiler.f90 b/src/fpm_compiler.f90 index e83d7a4c9c..dba21b2dad 100644 --- a/src/fpm_compiler.f90 +++ b/src/fpm_compiler.f90 @@ -686,7 +686,7 @@ end subroutine new_archiver !> Compile a Fortran object -subroutine compile_fortran(self, input, output, args, stat) +subroutine compile_fortran(self, input, output, args, log_file, stat) !> Instance of the compiler object class(compiler_t), intent(in) :: self !> Source file input @@ -695,16 +695,18 @@ subroutine compile_fortran(self, input, output, args, stat) character(len=*), intent(in) :: output !> Arguments for compiler character(len=*), intent(in) :: args + !> Compiler output log file + character(len=*), intent(in) :: log_file !> Status flag integer, intent(out) :: stat call run(self%fc // " -c " // input // " " // args // " -o " // output, & - & echo=self%echo, verbose=self%verbose, exitstat=stat) + & echo=self%echo, verbose=self%verbose, redirect=log_file, exitstat=stat) end subroutine compile_fortran !> Compile a C object -subroutine compile_c(self, input, output, args, stat) +subroutine compile_c(self, input, output, args, log_file, stat) !> Instance of the compiler object class(compiler_t), intent(in) :: self !> Source file input @@ -713,49 +715,55 @@ subroutine compile_c(self, input, output, args, stat) character(len=*), intent(in) :: output !> Arguments for compiler character(len=*), intent(in) :: args + !> Compiler output log file + character(len=*), intent(in) :: log_file !> Status flag integer, intent(out) :: stat call run(self%cc // " -c " // input // " " // args // " -o " // output, & - & echo=self%echo, verbose=self%verbose, exitstat=stat) + & echo=self%echo, verbose=self%verbose, redirect=log_file, exitstat=stat) end subroutine compile_c !> Link an executable -subroutine link(self, output, args, stat) +subroutine link(self, output, args, log_file, stat) !> Instance of the compiler object class(compiler_t), intent(in) :: self !> Output file of object character(len=*), intent(in) :: output !> Arguments for compiler character(len=*), intent(in) :: args + !> Compiler output log file + character(len=*), intent(in) :: log_file !> Status flag integer, intent(out) :: stat call run(self%fc // " " // args // " -o " // output, echo=self%echo, & - & verbose=self%verbose, exitstat=stat) + & verbose=self%verbose, redirect=log_file, exitstat=stat) end subroutine link !> Create an archive -subroutine make_archive(self, output, args, stat) +subroutine make_archive(self, output, args, log_file, stat) !> Instance of the archiver object class(archiver_t), intent(in) :: self !> Name of the archive to generate character(len=*), intent(in) :: output !> Object files to include into the archive type(string_t), intent(in) :: args(:) + !> Compiler output log file + character(len=*), intent(in) :: log_file !> Status flag integer, intent(out) :: stat if (self%use_response_file) then call write_response_file(output//".resp" , args) call run(self%ar // output // " @" // output//".resp", echo=self%echo, & - & verbose=self%verbose, exitstat=stat) + & verbose=self%verbose, redirect=log_file, exitstat=stat) call delete_file(output//".resp") else call run(self%ar // output // " " // string_cat(args, " "), & - & echo=self%echo, verbose=self%verbose, exitstat=stat) + & echo=self%echo, verbose=self%verbose, redirect=log_file, exitstat=stat) end if end subroutine make_archive diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90 index 2b5b787475..6127844b9a 100644 --- a/src/fpm_filesystem.F90 +++ b/src/fpm_filesystem.F90 @@ -15,7 +15,7 @@ module fpm_filesystem mkdir, exists, get_temp_filename, windows_path, unix_path, getline, delete_file public :: fileopen, fileclose, filewrite, warnwrite, parent_dir public :: read_lines, read_lines_expanded - public :: which + public :: which, LINE_BUFFER_LEN integer, parameter :: LINE_BUFFER_LEN = 1000 diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index 7ea815ba7d..122d73a7cd 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -75,6 +75,9 @@ module fpm_targets !> File path of output directory character(:), allocatable :: output_dir + !> File path of build log file relative to cwd + character(:), allocatable :: output_log_file + !> Primary source for this build target type(srcfile_t), allocatable :: source @@ -491,6 +494,7 @@ subroutine resolve_target_linking(targets, model) end if target%output_dir = get_output_dir(model%build_prefix, target%compile_flags) target%output_file = join_path(target%output_dir, target%output_name) + target%output_log_file = join_path(target%output_dir, target%output_name)//'.log' end associate end do @@ -528,7 +532,8 @@ subroutine resolve_target_linking(targets, model) target%output_dir = get_output_dir(model%build_prefix, & & target%compile_flags//local_link_flags) target%output_file = join_path(target%output_dir, target%output_name) - end if + target%output_log_file = join_path(target%output_dir, target%output_name)//'.log' + end if end associate From 37ba9d7cf61d6b9ddbfe59a4456311fda62ef101 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Fri, 26 Nov 2021 17:32:07 +0000 Subject: [PATCH 15/23] Simplify implementation and cleanup plain mode output --- src/fpm_backend.F90 | 24 ++---- src/fpm_backend_console.f90 | 28 +++++-- src/fpm_backend_output.f90 | 157 ++++++++++++++++++++++++------------ 3 files changed, 137 insertions(+), 72 deletions(-) diff --git a/src/fpm_backend.F90 b/src/fpm_backend.F90 index cb2dbc0756..796c7aca8c 100644 --- a/src/fpm_backend.F90 +++ b/src/fpm_backend.F90 @@ -65,8 +65,7 @@ subroutine build_package(targets,model,verbose) type(string_t), allocatable :: build_dirs(:) type(string_t) :: temp - type(console_t) :: console - integer :: line, n_complete + type(build_progress_t) :: progress logical :: plain_output ! Need to make output directory for include (mod) files @@ -97,34 +96,31 @@ subroutine build_package(targets,model,verbose) allocate(stat(size(queue))) stat(:) = 0 build_failed = .false. - n_complete = 0 ! Set output mode #ifndef FPM_BOOTSTRAP plain_output = (.not.(c_isatty()==1)) .or. verbose #else - plain_output = verbose + plain_output = .true. #endif - call console%init(plain_output) - call output_init(plain_output) + + call progress%init(queue,plain_output) ! Loop over parallel schedule regions do i=1,size(schedule_ptr)-1 ! Build targets in schedule region i - !$omp parallel do default(shared) private(skip_current,line) schedule(dynamic,1) + !$omp parallel do default(shared) private(skip_current) schedule(dynamic,1) do j=schedule_ptr(i),(schedule_ptr(i+1)-1) - ! Update console output - call output_status_compiling(console, line, queue(j)%ptr) - call output_progress(n_complete, size(queue),plain_output) - ! Check if build already failed !$omp atomic read skip_current = build_failed if (.not.skip_current) then + call progress%compiling_status(j) call build_target(model,queue(j)%ptr,verbose,stat(j)) + call progress%completed_status(j,stat(j)) end if ! Set global flag if this target failed to build @@ -133,10 +129,6 @@ subroutine build_package(targets,model,verbose) build_failed = .true. end if - ! Update console output - call output_status_complete(console, line, queue(j)%ptr,stat(j), n_complete) - call output_progress(n_complete, size(queue),plain_output) - end do ! Check if this schedule region failed: exit with message if failed @@ -157,7 +149,7 @@ subroutine build_package(targets,model,verbose) end do - call output_progress_complete() + call progress%success() end subroutine build_package diff --git a/src/fpm_backend_console.f90 b/src/fpm_backend_console.f90 index 4db0cdc59c..7daff14003 100644 --- a/src/fpm_backend_console.f90 +++ b/src/fpm_backend_console.f90 @@ -41,20 +41,36 @@ subroutine console_init(console,plain_mode) end subroutine console_init -function console_write_line(console,str) result(line) +subroutine console_write_line(console,str,line,advance) class(console_t), intent(inout), target :: console character(*), intent(in) :: str - integer :: line + integer, intent(out), optional :: line + logical, intent(in), optional :: advance + + character(3) :: adv + + adv = "yes" + if (present(advance)) then + if (.not.advance) then + adv = "no" + end if + end if !$omp critical - line = console%n_line - write(stdout,*) console%LINE_RESET//str + if (present(line)) then + line = console%n_line + end if + + write(stdout,'(A)',advance=trim(adv)) console%LINE_RESET//str + + if (adv=="yes") then + console%n_line = console%n_line + 1 + end if - console%n_line = console%n_line + 1 !$omp end critical -end function console_write_line +end subroutine console_write_line subroutine console_update_line(console,line_no,str) class(console_t), intent(in) :: console diff --git a/src/fpm_backend_output.f90 b/src/fpm_backend_output.f90 index 82c019fe4e..4eb2889fa4 100644 --- a/src/fpm_backend_output.f90 +++ b/src/fpm_backend_output.f90 @@ -1,15 +1,38 @@ module fpm_backend_output use iso_fortran_env, only: stdout=>output_unit use fpm_filesystem, only: basename -use fpm_targets, only: build_target_t +use fpm_targets, only: build_target_ptr use fpm_backend_console, only: console_t use M_attr, only: attr, attr_mode implicit none +type build_progress_t + + type(console_t) :: console + + integer :: n_complete + + integer :: n_target + + logical :: plain_mode = .true. + + integer, allocatable :: output_lines(:) + + type(build_target_ptr), pointer :: target_queue(:) + +contains + procedure :: init => output_init + procedure :: compiling_status => output_status_compiling + procedure :: completed_status => output_status_complete + procedure :: success => output_progress_success + +end type build_progress_t contains - subroutine output_init(plain_mode) + subroutine output_init(progress,target_queue,plain_mode) + class(build_progress_t), intent(out) :: progress + type(build_target_ptr), intent(in), target :: target_queue(:) logical, intent(in), optional :: plain_mode if (plain_mode) then @@ -18,80 +41,114 @@ subroutine output_init(plain_mode) call attr_mode('color') end if + call progress%console%init(plain_mode) + + progress%n_target = size(target_queue,1) + progress%target_queue => target_queue + progress%plain_mode = plain_mode + + allocate(progress%output_lines(progress%n_target)) + end subroutine output_init - subroutine output_status_compiling(console, line, target) - type(console_t), intent(inout), target :: console - integer, intent(inout) :: line - type(build_target_t), intent(in) :: target + subroutine output_status_compiling(progress, queue_index) + class(build_progress_t), intent(inout) :: progress + integer, intent(in) :: queue_index character(:), allocatable :: target_name character(100) :: output_string + character(100) :: overall_progress - if (allocated(target%source)) then - target_name = basename(target%source%file_name) - else - target_name = basename(target%output_file) - end if + associate(target=>progress%target_queue(queue_index)%ptr) + + if (allocated(target%source)) then + target_name = basename(target%source%file_name) + else + target_name = basename(target%output_file) + end if + + write(overall_progress,'(A,I4,A)') '[',100*progress%n_complete/progress%n_target,'%]' + + if (progress%plain_mode) then + + !$omp critical + write(*,'(A8,A30)') trim(overall_progress),target_name + !$omp end critical - write(output_string,'(A,T40,A,A)') target_name,attr('compiling...') + else - line = console%write_line(trim(output_string)) + write(output_string,'(A,T40,A,A)') target_name,attr('compiling...') + call progress%console%write_line(trim(output_string),progress%output_lines(queue_index)) + + call progress%console%write_line(trim(overall_progress)//'Compiling...',advance=.false.) + + end if + + end associate end subroutine output_status_compiling - subroutine output_status_complete(console, line, target, build_stat, n_complete) - type(console_t), intent(inout), target :: console - integer, intent(in) :: line - type(build_target_t), intent(in) :: target + + subroutine output_status_complete(progress, queue_index, build_stat) + class(build_progress_t), intent(inout) :: progress + integer, intent(in) :: queue_index integer, intent(in) :: build_stat - integer, intent(inout) :: n_complete character(:), allocatable :: target_name character(100) :: output_string - - if (allocated(target%source)) then - target_name = basename(target%source%file_name) - else - target_name = basename(target%output_file) - end if - - if (build_stat == 0) then - write(output_string,'(A,T40,A,A)') target_name,attr('done.') - else - write(output_string,'(A,T40,A,A)') target_name,attr('failed.') - end if - - call console%update_line(line,trim(output_string)) + character(100) :: overall_progress !$omp critical - n_complete = n_complete + 1 + progress%n_complete = progress%n_complete + 1 !$omp end critical - end subroutine output_status_complete + associate(target=>progress%target_queue(queue_index)%ptr) - subroutine output_progress(n_complete, total, plain_mode) - integer, intent(in) :: n_complete, total - logical :: plain_mode + if (allocated(target%source)) then + target_name = basename(target%source%file_name) + else + target_name = basename(target%output_file) + end if - character(:), allocatable :: advance + if (build_stat == 0) then + write(output_string,'(A,T40,A,A)') target_name,attr('done.') + else + write(output_string,'(A,T40,A,A)') target_name,attr('failed.') + end if - if (plain_mode) then - advance = "yes" - else - advance = "no" - end if + write(overall_progress,'(A,I4,A)') '[',100*progress%n_complete/progress%n_target,'%] ' - !$omp critical - write(*,'(A,I4,A,A)',advance=advance) '[',100*n_complete/total,'%] Compiling project...' - !$omp end critical + if (progress%plain_mode) then + + !$omp critical + write(*,'(A8,A30,A7)') trim(overall_progress),target_name, 'done.' + !$omp end critical + + else - end subroutine output_progress + call progress%console%update_line(progress%output_lines(queue_index),trim(output_string)) - subroutine output_progress_complete() + call progress%console%write_line(trim(overall_progress)//'Compiling...',advance=.false.) - write(*,'(A)') char(27)//"[2K"//char(27)//"[1G"//attr('[100%] Project compiled successfully.') + end if + + end associate + + end subroutine output_status_complete + + subroutine output_progress_success(progress) + class(build_progress_t), intent(inout) :: progress + + if (progress%plain_mode) then + + write(*,'(A)') attr('[100%] Project compiled successfully.') + + else + + write(*,'(A)') progress%console%LINE_RESET//attr('[100%] Project compiled successfully.') + + end if - end subroutine output_progress_complete + end subroutine output_progress_success end module fpm_backend_output \ No newline at end of file From 93b629e504900432ea712cc3ed65dd937483e1c1 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sat, 27 Nov 2021 17:35:12 +0000 Subject: [PATCH 16/23] Add: developer documentation to new files --- src/fpm_backend_console.f90 | 31 ++++++++++++++++++++ src/fpm_backend_output.f90 | 58 +++++++++++++++++++++++++++---------- src/fpm_environment.f90 | 7 ----- src/ptycheck/isatty.c | 7 +++++ 4 files changed, 81 insertions(+), 22 deletions(-) diff --git a/src/fpm_backend_console.f90 b/src/fpm_backend_console.f90 index 7daff14003..44220376ee 100644 --- a/src/fpm_backend_console.f90 +++ b/src/fpm_backend_console.f90 @@ -1,3 +1,13 @@ +!># Build Backend Console +!> This module provides a lightweight implementation for printing to the console +!> and updating previously-printed console lines. It used by `[[fpm_backend_output]]` +!> for pretty-printing build status and progress. +!> +!> @note The implementation for updating previous lines relies on no other output +!> going to `stdout`/`stderr` except through the `console_t` object provided. +!> +!> @note All write statements to `stdout` are enclosed within OpenMP `critical` regions +!> module fpm_backend_console use iso_fortran_env, only: stdout=>output_unit implicit none @@ -7,22 +17,34 @@ module fpm_backend_console character(len=*), parameter :: ESC = char(27) +!> Console object type console_t + !> Number of lines printed integer :: n_line = 1 + !> 'Plain' output (no escape codes) logical :: plain_mode = .false. + !> Escape code for erasing current line character(:), allocatable :: LINE_RESET + !> Escape code for moving up one line character(:), allocatable :: LINE_UP + !> Escape code for moving down one line character(:), allocatable :: LINE_DOWN contains + !> Initialise the console object procedure :: init => console_init + !> Write a single line to the console procedure :: write_line => console_write_line + !> Update a previously-written console line procedure :: update_line => console_update_line end type console_t contains +!> Initialise the console object subroutine console_init(console,plain_mode) + !> Console object to initialise class(console_t), intent(out), target :: console + !> 'Plain' output (no escape codes) logical, intent(in), optional :: plain_mode if (present(plain_mode)) then @@ -41,10 +63,15 @@ subroutine console_init(console,plain_mode) end subroutine console_init +!> Write a single line to the standard output subroutine console_write_line(console,str,line,advance) + !> Console object class(console_t), intent(inout), target :: console + !> String to write character(*), intent(in) :: str + !> Integer needed to later update console line integer, intent(out), optional :: line + !> Advancing output (print newline?) logical, intent(in), optional :: advance character(3) :: adv @@ -72,9 +99,13 @@ subroutine console_write_line(console,str,line,advance) end subroutine console_write_line +!> Overwrite a previously-written line in standard output subroutine console_update_line(console,line_no,str) + !> Console object class(console_t), intent(in) :: console + !> Integer output from `[[console_write_line]]` integer, intent(in) :: line_no + !> New string to overwrite line character(*), intent(in) :: str integer :: n diff --git a/src/fpm_backend_output.f90 b/src/fpm_backend_output.f90 index 4eb2889fa4..8c7fd7d94e 100644 --- a/src/fpm_backend_output.f90 +++ b/src/fpm_backend_output.f90 @@ -1,3 +1,14 @@ +!># Build Backend Progress Output +!> This module provides a derived type `build_progress_t` for printing build status +!> and progress messages to the console while the backend is building the package. +!> +!> The `build_progress_t` type supports two modes: `normal` and `plain` +!> where the former does 'pretty' output and the latter does not. +!> The `normal` mode is intended for typical interactive usage whereas +!> 'plain' mode is used with the `--verbose` flag or when `stdout` is not attached +!> to a terminal (e.g. when piping or redirecting `stdout`). In these cases, +!> the pretty output must be suppressed to avoid control codes being output. + module fpm_backend_output use iso_fortran_env, only: stdout=>output_unit use fpm_filesystem, only: basename @@ -6,33 +17,43 @@ module fpm_backend_output use M_attr, only: attr, attr_mode implicit none -type build_progress_t +private +public build_progress_t +!> Build progress object +type build_progress_t + !> Console object for updating console lines type(console_t) :: console - + !> Number of completed targets integer :: n_complete - + !> Total number of targets scheduled integer :: n_target - + !> 'Plain' output (no colors or updating) logical :: plain_mode = .true. - + !> Store needed when updating previous console lines integer, allocatable :: output_lines(:) - + !> Queue of scheduled build targets type(build_target_ptr), pointer :: target_queue(:) - contains + !> Initialise build progress object procedure :: init => output_init + !> Output 'compiling' status for build target procedure :: compiling_status => output_status_compiling + !> Output 'complete' status for build target procedure :: completed_status => output_status_complete + !> Output finished status for whole package procedure :: success => output_progress_success - end type build_progress_t contains + !> Initialise build progress object subroutine output_init(progress,target_queue,plain_mode) + !> Progress object to initialise class(build_progress_t), intent(out) :: progress + !> The queue of scheduled targets type(build_target_ptr), intent(in), target :: target_queue(:) + !> Enable 'plain' output for progress object logical, intent(in), optional :: plain_mode if (plain_mode) then @@ -51,8 +72,11 @@ subroutine output_init(progress,target_queue,plain_mode) end subroutine output_init + !> Output 'compiling' status for build target and overall percentage progress subroutine output_status_compiling(progress, queue_index) + !> Progress object class(build_progress_t), intent(inout) :: progress + !> Index of build target in the target queue integer, intent(in) :: queue_index character(:), allocatable :: target_name @@ -69,13 +93,13 @@ subroutine output_status_compiling(progress, queue_index) write(overall_progress,'(A,I4,A)') '[',100*progress%n_complete/progress%n_target,'%]' - if (progress%plain_mode) then + if (progress%plain_mode) then ! Plain output !$omp critical write(*,'(A8,A30)') trim(overall_progress),target_name !$omp end critical - else + else ! Pretty output write(output_string,'(A,T40,A,A)') target_name,attr('compiling...') call progress%console%write_line(trim(output_string),progress%output_lines(queue_index)) @@ -88,10 +112,13 @@ subroutine output_status_compiling(progress, queue_index) end subroutine output_status_compiling - + !> Output 'complete' status for build target and update overall percentage progress subroutine output_status_complete(progress, queue_index, build_stat) + !> Progress object class(build_progress_t), intent(inout) :: progress + !> Index of build target in the target queue integer, intent(in) :: queue_index + !> Build status flag integer, intent(in) :: build_stat character(:), allocatable :: target_name @@ -118,13 +145,13 @@ subroutine output_status_complete(progress, queue_index, build_stat) write(overall_progress,'(A,I4,A)') '[',100*progress%n_complete/progress%n_target,'%] ' - if (progress%plain_mode) then + if (progress%plain_mode) then ! Plain output !$omp critical write(*,'(A8,A30,A7)') trim(overall_progress),target_name, 'done.' !$omp end critical - else + else ! Pretty output call progress%console%update_line(progress%output_lines(queue_index),trim(output_string)) @@ -136,14 +163,15 @@ subroutine output_status_complete(progress, queue_index, build_stat) end subroutine output_status_complete + !> Output finished status for whole package subroutine output_progress_success(progress) class(build_progress_t), intent(inout) :: progress - if (progress%plain_mode) then + if (progress%plain_mode) then ! Plain output write(*,'(A)') attr('[100%] Project compiled successfully.') - else + else ! Pretty output write(*,'(A)') progress%console%LINE_RESET//attr('[100%] Project compiled successfully.') diff --git a/src/fpm_environment.f90 b/src/fpm_environment.f90 index e8534ac595..224d2aa940 100644 --- a/src/fpm_environment.f90 +++ b/src/fpm_environment.f90 @@ -198,13 +198,6 @@ subroutine run(cmd,echo,exitstat,verbose,redirect) end if end if end if - - - if(present(redirect))then - verbose_local=verbose - else - verbose_local=.true. - end if if(echo_local) print *, '+ ', cmd diff --git a/src/ptycheck/isatty.c b/src/ptycheck/isatty.c index 61acee6f4e..9b7f519cb9 100644 --- a/src/ptycheck/isatty.c +++ b/src/ptycheck/isatty.c @@ -1,10 +1,17 @@ +// This file provides a `c_isatty` wrapper function to check if `stdout` is connected +// to a terminal or not. This wrapper is required for better portability, specifically +// for supporting the MS Windows command prompt and the MinTTY terminal used by MSYS2. + #include //for isatty() #include //for fileno() #ifdef __MINGW64__ +// ptycheck/iscygpty allows us to check if connected to MinTTY in MSYS2 on Windows #include "iscygpty.h" #endif +// Check if `stdout` is connected to a terminal +// Returns 1 if is a terminal, and 0 otherwise int c_isatty(void) { From fc058eca31036584649cd3b712a649e9dd01c2d7 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sat, 27 Nov 2021 18:23:53 +0000 Subject: [PATCH 17/23] Update: backend to print message if up to date. --- src/fpm_backend.F90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/fpm_backend.F90 b/src/fpm_backend.F90 index 796c7aca8c..f8d491fb32 100644 --- a/src/fpm_backend.F90 +++ b/src/fpm_backend.F90 @@ -92,6 +92,12 @@ subroutine build_package(targets,model,verbose) ! Construct build schedule queue call schedule_targets(queue, schedule_ptr, targets) + ! Check if queue is empty + if (.not.verbose .and. size(queue) < 1) then + write(*,*) 'Project is up to date' + return + end if + ! Initialise build status flags allocate(stat(size(queue))) stat(:) = 0 From 4556e7a4435c6ef2da8782c033229e06e91b6a4e Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sun, 28 Nov 2021 11:11:11 +0000 Subject: [PATCH 18/23] Apply suggestion: move echo/verbosity into constructors For compiler_t and archive_t objects --- src/fpm.f90 | 11 ++++------- src/fpm_compiler.f90 | 19 +++++++++++++++---- 2 files changed, 19 insertions(+), 11 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 8b05a381d3..135cadc11a 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -59,13 +59,10 @@ subroutine build_model(model, settings, package, error) call filewrite(join_path("build", ".gitignore"),["*"]) end if - call new_compiler(model%compiler, settings%compiler, settings%c_compiler) - call new_archiver(model%archiver, settings%archiver) - - model%compiler%verbose = settings%verbose - model%compiler%echo = settings%verbose - model%archiver%verbose = settings%verbose - model%archiver%echo = settings%verbose + call new_compiler(model%compiler, settings%compiler, settings%c_compiler, & + & echo=settings%verbose, verbose=settings%verbose) + call new_archiver(model%archiver, settings%archiver, & + & echo=settings%verbose, verbose=settings%verbose) if (settings%flag == '') then flags = model%compiler%get_default_flags(settings%profile == "release") diff --git a/src/fpm_compiler.f90 b/src/fpm_compiler.f90 index dba21b2dad..2f939ad1f6 100644 --- a/src/fpm_compiler.f90 +++ b/src/fpm_compiler.f90 @@ -623,16 +623,22 @@ end function enumerate_libraries !> Create new compiler instance -subroutine new_compiler(self, fc, cc) +subroutine new_compiler(self, fc, cc, echo, verbose) !> New instance of the compiler type(compiler_t), intent(out) :: self !> Fortran compiler name or path character(len=*), intent(in) :: fc !> C compiler name or path character(len=*), intent(in) :: cc + !> Echo compiler command + logical, intent(in) :: echo + !> Verbose mode: dump compiler output + logical, intent(in) :: verbose self%id = get_compiler_id(fc) - + + self%echo = echo + self%verbose = verbose self%fc = fc if (len_trim(cc) > 0) then self%cc = cc @@ -643,11 +649,15 @@ end subroutine new_compiler !> Create new archiver instance -subroutine new_archiver(self, ar) +subroutine new_archiver(self, ar, echo, verbose) !> New instance of the archiver type(archiver_t), intent(out) :: self !> User provided archiver command character(len=*), intent(in) :: ar + !> Echo compiler command + logical, intent(in) :: echo + !> Verbose mode: dump compiler output + logical, intent(in) :: verbose integer :: estat, os_type @@ -681,7 +691,8 @@ subroutine new_archiver(self, ar) end if end if self%use_response_file = os_type == OS_WINDOWS - self%echo = .true. + self%echo = echo + self%verbose = verbose end subroutine new_archiver From 6aba40db1385007e0bf4e9c2b9b4afe8bb105593 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sun, 28 Nov 2021 11:24:41 +0000 Subject: [PATCH 19/23] Apply suggestion: don't use TBP for new constructors --- src/fpm_backend.F90 | 2 +- src/fpm_backend_console.f90 | 19 +++++++++++-------- src/fpm_backend_output.f90 | 20 ++++++++++++-------- 3 files changed, 24 insertions(+), 17 deletions(-) diff --git a/src/fpm_backend.F90 b/src/fpm_backend.F90 index f8d491fb32..e666d037da 100644 --- a/src/fpm_backend.F90 +++ b/src/fpm_backend.F90 @@ -110,7 +110,7 @@ subroutine build_package(targets,model,verbose) plain_output = .true. #endif - call progress%init(queue,plain_output) + progress = build_progress_t(queue,plain_output) ! Loop over parallel schedule regions do i=1,size(schedule_ptr)-1 diff --git a/src/fpm_backend_console.f90 b/src/fpm_backend_console.f90 index 44220376ee..73bcd5d4eb 100644 --- a/src/fpm_backend_console.f90 +++ b/src/fpm_backend_console.f90 @@ -30,22 +30,25 @@ module fpm_backend_console !> Escape code for moving down one line character(:), allocatable :: LINE_DOWN contains - !> Initialise the console object - procedure :: init => console_init !> Write a single line to the console procedure :: write_line => console_write_line !> Update a previously-written console line procedure :: update_line => console_update_line end type console_t +!> Constructor for console_t +interface console_t + procedure :: new_console +end interface console_t + contains -!> Initialise the console object -subroutine console_init(console,plain_mode) - !> Console object to initialise - class(console_t), intent(out), target :: console +!> Initialise a new console object +function new_console(plain_mode) result(console) !> 'Plain' output (no escape codes) logical, intent(in), optional :: plain_mode + !> Console object to initialise + type(console_t) :: console if (present(plain_mode)) then console%plain_mode = plain_mode @@ -61,12 +64,12 @@ subroutine console_init(console,plain_mode) console%LINE_DOWN = ESC//"[1B" end if -end subroutine console_init +end function new_console !> Write a single line to the standard output subroutine console_write_line(console,str,line,advance) !> Console object - class(console_t), intent(inout), target :: console + class(console_t), intent(inout) :: console !> String to write character(*), intent(in) :: str !> Integer needed to later update console line diff --git a/src/fpm_backend_output.f90 b/src/fpm_backend_output.f90 index 8c7fd7d94e..2cc8597c1e 100644 --- a/src/fpm_backend_output.f90 +++ b/src/fpm_backend_output.f90 @@ -35,8 +35,6 @@ module fpm_backend_output !> Queue of scheduled build targets type(build_target_ptr), pointer :: target_queue(:) contains - !> Initialise build progress object - procedure :: init => output_init !> Output 'compiling' status for build target procedure :: compiling_status => output_status_compiling !> Output 'complete' status for build target @@ -45,16 +43,21 @@ module fpm_backend_output procedure :: success => output_progress_success end type build_progress_t +!> Constructor for build_progress_t +interface build_progress_t + procedure :: new_build_progress +end interface build_progress_t + contains - !> Initialise build progress object - subroutine output_init(progress,target_queue,plain_mode) - !> Progress object to initialise - class(build_progress_t), intent(out) :: progress + !> Initialise a new build progress object + function new_build_progress(target_queue,plain_mode) result(progress) !> The queue of scheduled targets type(build_target_ptr), intent(in), target :: target_queue(:) !> Enable 'plain' output for progress object logical, intent(in), optional :: plain_mode + !> Progress object to initialise + type(build_progress_t) :: progress if (plain_mode) then call attr_mode('plain') @@ -62,15 +65,16 @@ subroutine output_init(progress,target_queue,plain_mode) call attr_mode('color') end if - call progress%console%init(plain_mode) + progress%console = console_t(plain_mode) progress%n_target = size(target_queue,1) progress%target_queue => target_queue progress%plain_mode = plain_mode + progress%n_complete = 0 allocate(progress%output_lines(progress%n_target)) - end subroutine output_init + end function new_build_progress !> Output 'compiling' status for build target and overall percentage progress subroutine output_status_compiling(progress, queue_index) From b0115d1a000ee15d3ca773c3da3300595d805454 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sun, 28 Nov 2021 11:43:49 +0000 Subject: [PATCH 20/23] Apply suggestion: don't use M_attr, simplify implementation --- fpm.toml | 5 ---- src/fpm_backend_console.f90 | 59 +++++++++++++------------------------ src/fpm_backend_output.f90 | 22 +++++--------- 3 files changed, 27 insertions(+), 59 deletions(-) diff --git a/fpm.toml b/fpm.toml index f3a297ca62..7289c823e3 100644 --- a/fpm.toml +++ b/fpm.toml @@ -14,11 +14,6 @@ rev = "2f5eaba864ff630ba0c3791126a3f811b6e437f3" git = "https://github.com/urbanjost/M_CLI2.git" rev = "ea6bbffc1c2fb0885e994d37ccf0029c99b19f24" -[dependencies.M_attr] -git = "https://github.com/urbanjost/M_attr.git" -rev = "608b9d3b40be9ff2590c23d2089781fd4da76344" - - [[test]] name = "cli-test" source-dir = "test/cli_test" diff --git a/src/fpm_backend_console.f90 b/src/fpm_backend_console.f90 index 73bcd5d4eb..014e800909 100644 --- a/src/fpm_backend_console.f90 +++ b/src/fpm_backend_console.f90 @@ -14,21 +14,30 @@ module fpm_backend_console private public :: console_t +public :: LINE_RESET +public :: COLOR_RED, COLOR_GREEN, COLOR_YELLOW, COLOR_RESET character(len=*), parameter :: ESC = char(27) +!> Escape code for erasing current line +character(len=*), parameter :: LINE_RESET = ESC//"[2K"//ESC//"[1G" +!> Escape code for moving up one line +character(len=*), parameter :: LINE_UP = ESC//"[1A" +!> Escape code for moving down one line +character(len=*), parameter :: LINE_DOWN = ESC//"[1B" +!> Escape code for red foreground color +character(len=*), parameter :: COLOR_RED = ESC//"[31m" +!> Escape code for green foreground color +character(len=*), parameter :: COLOR_GREEN = ESC//"[32m" +!> Escape code for yellow foreground color +character(len=*), parameter :: COLOR_YELLOW = ESC//"[93m" +!> Escape code to reset foreground color +character(len=*), parameter :: COLOR_RESET = ESC//"[0m" !> Console object type console_t !> Number of lines printed integer :: n_line = 1 - !> 'Plain' output (no escape codes) - logical :: plain_mode = .false. - !> Escape code for erasing current line - character(:), allocatable :: LINE_RESET - !> Escape code for moving up one line - character(:), allocatable :: LINE_UP - !> Escape code for moving down one line - character(:), allocatable :: LINE_DOWN + contains !> Write a single line to the console procedure :: write_line => console_write_line @@ -36,36 +45,8 @@ module fpm_backend_console procedure :: update_line => console_update_line end type console_t -!> Constructor for console_t -interface console_t - procedure :: new_console -end interface console_t - contains -!> Initialise a new console object -function new_console(plain_mode) result(console) - !> 'Plain' output (no escape codes) - logical, intent(in), optional :: plain_mode - !> Console object to initialise - type(console_t) :: console - - if (present(plain_mode)) then - console%plain_mode = plain_mode - end if - - if (console%plain_mode) then - console%LINE_RESET = "" - console%LINE_UP = "" - console%LINE_DOWN = "" - else - console%LINE_RESET = ESC//"[2K"//ESC//"[1G" - console%LINE_UP = ESC//"[1A" - console%LINE_DOWN = ESC//"[1B" - end if - -end function new_console - !> Write a single line to the standard output subroutine console_write_line(console,str,line,advance) !> Console object @@ -92,7 +73,7 @@ subroutine console_write_line(console,str,line,advance) line = console%n_line end if - write(stdout,'(A)',advance=trim(adv)) console%LINE_RESET//str + write(stdout,'(A)',advance=trim(adv)) LINE_RESET//str if (adv=="yes") then console%n_line = console%n_line + 1 @@ -118,12 +99,12 @@ subroutine console_update_line(console,line_no,str) n = console%n_line - line_no !+ 1 !+ 1 ! Step back to line - write(stdout,'(A)',advance="no") repeat(console%LINE_UP,n)//console%LINE_RESET + write(stdout,'(A)',advance="no") repeat(LINE_UP,n)//LINE_RESET write(stdout,*) str ! Step forward to end - write(stdout,'(A)',advance="no") repeat(console%LINE_DOWN,n)//console%LINE_RESET + write(stdout,'(A)',advance="no") repeat(LINE_DOWN,n)//LINE_RESET !$omp end critical diff --git a/src/fpm_backend_output.f90 b/src/fpm_backend_output.f90 index 2cc8597c1e..3f297f71f5 100644 --- a/src/fpm_backend_output.f90 +++ b/src/fpm_backend_output.f90 @@ -13,8 +13,7 @@ module fpm_backend_output use iso_fortran_env, only: stdout=>output_unit use fpm_filesystem, only: basename use fpm_targets, only: build_target_ptr -use fpm_backend_console, only: console_t -use M_attr, only: attr, attr_mode +use fpm_backend_console, only: console_t, LINE_RESET, COLOR_RED, COLOR_GREEN, COLOR_YELLOW, COLOR_RESET implicit none private @@ -58,14 +57,6 @@ function new_build_progress(target_queue,plain_mode) result(progress) logical, intent(in), optional :: plain_mode !> Progress object to initialise type(build_progress_t) :: progress - - if (plain_mode) then - call attr_mode('plain') - else - call attr_mode('color') - end if - - progress%console = console_t(plain_mode) progress%n_target = size(target_queue,1) progress%target_queue => target_queue @@ -105,7 +96,8 @@ subroutine output_status_compiling(progress, queue_index) else ! Pretty output - write(output_string,'(A,T40,A,A)') target_name,attr('compiling...') + write(output_string,'(A,T40,A,A)') target_name, COLOR_YELLOW//'compiling...'//COLOR_RESET + call progress%console%write_line(trim(output_string),progress%output_lines(queue_index)) call progress%console%write_line(trim(overall_progress)//'Compiling...',advance=.false.) @@ -142,9 +134,9 @@ subroutine output_status_complete(progress, queue_index, build_stat) end if if (build_stat == 0) then - write(output_string,'(A,T40,A,A)') target_name,attr('done.') + write(output_string,'(A,T40,A,A)') target_name,COLOR_GREEN//'done.'//COLOR_RESET else - write(output_string,'(A,T40,A,A)') target_name,attr('failed.') + write(output_string,'(A,T40,A,A)') target_name,COLOR_RED//'failed.'//COLOR_RESET end if write(overall_progress,'(A,I4,A)') '[',100*progress%n_complete/progress%n_target,'%] ' @@ -173,11 +165,11 @@ subroutine output_progress_success(progress) if (progress%plain_mode) then ! Plain output - write(*,'(A)') attr('[100%] Project compiled successfully.') + write(*,'(A)') '[100%] Project compiled successfully.' else ! Pretty output - write(*,'(A)') progress%console%LINE_RESET//attr('[100%] Project compiled successfully.') + write(*,'(A)') LINE_RESET//COLOR_GREEN//'[100%] Project compiled successfully.'//COLOR_RESET end if From 0c561b0f76bc6fa7777dec884a16b76694913adf Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sun, 28 Nov 2021 11:55:50 +0000 Subject: [PATCH 21/23] Apply suggestion: move run to filesystem and use getline fpm_environment::run is moved to fpm_filesystem so that it can use the getline function to retrieve redirected output from file --- src/fpm.f90 | 5 +-- src/fpm/cmd/new.f90 | 4 +-- src/fpm_backend.F90 | 7 ++-- src/fpm_command_line.f90 | 4 +-- src/fpm_compiler.f90 | 3 +- src/fpm_environment.f90 | 69 ----------------------------------- src/fpm_filesystem.F90 | 73 ++++++++++++++++++++++++++++++++++++-- test/new_test/new_test.f90 | 4 +-- 8 files changed, 84 insertions(+), 85 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 135cadc11a..7291247993 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -4,8 +4,9 @@ module fpm use fpm_command_line, only: fpm_build_settings, fpm_new_settings, & fpm_run_settings, fpm_install_settings, fpm_test_settings use fpm_dependency, only : new_dependency_tree -use fpm_environment, only: run, get_env -use fpm_filesystem, only: is_dir, join_path, number_of_rows, list_files, exists, basename, filewrite, mkdir +use fpm_environment, only: get_env +use fpm_filesystem, only: is_dir, join_path, number_of_rows, list_files, exists, & + basename, filewrite, mkdir, run use fpm_model, only: fpm_model_t, srcfile_t, show_model, & FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, FPM_SCOPE_DEP, & FPM_SCOPE_APP, FPM_SCOPE_EXAMPLE, FPM_SCOPE_TEST diff --git a/src/fpm/cmd/new.f90 b/src/fpm/cmd/new.f90 index a402432a2f..61afc740cf 100644 --- a/src/fpm/cmd/new.f90 +++ b/src/fpm/cmd/new.f90 @@ -54,9 +54,9 @@ module fpm_cmd_new !> be the first go-to for a CLI utility). use fpm_command_line, only : fpm_new_settings -use fpm_environment, only : run, OS_LINUX, OS_MACOS, OS_WINDOWS +use fpm_environment, only : OS_LINUX, OS_MACOS, OS_WINDOWS use fpm_filesystem, only : join_path, exists, basename, mkdir, is_dir -use fpm_filesystem, only : fileopen, fileclose, filewrite, warnwrite +use fpm_filesystem, only : fileopen, fileclose, filewrite, warnwrite, run use fpm_strings, only : join, to_fortran_name use fpm_error, only : fpm_stop use,intrinsic :: iso_fortran_env, only : stderr=>error_unit diff --git a/src/fpm_backend.F90 b/src/fpm_backend.F90 index e666d037da..ceba7acb91 100644 --- a/src/fpm_backend.F90 +++ b/src/fpm_backend.F90 @@ -29,8 +29,7 @@ module fpm_backend use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit use fpm_error, only : fpm_stop -use fpm_environment, only: run, get_os_type, OS_WINDOWS -use fpm_filesystem, only: basename, dirname, join_path, exists, mkdir, LINE_BUFFER_LEN +use fpm_filesystem, only: basename, dirname, join_path, exists, mkdir, run, getline use fpm_model, only: fpm_model_t use fpm_strings, only: string_t, operator(.in.) use fpm_targets, only: build_target_t, build_target_ptr, FPM_TARGET_OBJECT, & @@ -349,13 +348,13 @@ subroutine print_build_log(target) type(build_target_t), intent(in), target :: target integer :: fh, ios - character(LINE_BUFFER_LEN) :: line + character(:), allocatable :: line if (exists(target%output_log_file)) then open(newunit=fh,file=target%output_log_file,status='old') do - read(fh, '(A)', iostat=ios) line + call getline(fh, line, ios) if (ios /= 0) exit write(*,'(A)') trim(line) end do diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 0837bf2f0e..99fdef26a0 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -29,8 +29,8 @@ module fpm_command_line use M_CLI2, only : set_args, lget, sget, unnamed, remaining, specified use M_CLI2, only : get_subcommand, CLI_RESPONSE_FILE use fpm_strings, only : lower, split, fnv_1a, to_fortran_name, is_fortran_name -use fpm_filesystem, only : basename, canon_path, which -use fpm_environment, only : run, get_command_arguments_quoted +use fpm_filesystem, only : basename, canon_path, which, run +use fpm_environment, only : get_command_arguments_quoted use fpm_error, only : fpm_stop use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, & & stdout=>output_unit, & diff --git a/src/fpm_compiler.f90 b/src/fpm_compiler.f90 index 2f939ad1f6..1c086cc45b 100644 --- a/src/fpm_compiler.f90 +++ b/src/fpm_compiler.f90 @@ -27,7 +27,6 @@ ! Unisys ? ? ? ? ? discontinued module fpm_compiler use fpm_environment, only: & - run, & get_env, & get_os_type, & OS_LINUX, & @@ -39,7 +38,7 @@ module fpm_compiler OS_OPENBSD, & OS_UNKNOWN use fpm_filesystem, only: join_path, basename, get_temp_filename, delete_file, unix_path, & - & getline + & getline, run use fpm_strings, only: string_cat, string_t implicit none public :: compiler_t, new_compiler, archiver_t, new_archiver diff --git a/src/fpm_environment.f90 b/src/fpm_environment.f90 index 224d2aa940..7926703256 100644 --- a/src/fpm_environment.f90 +++ b/src/fpm_environment.f90 @@ -11,7 +11,6 @@ module fpm_environment private public :: get_os_type public :: os_is_unix - public :: run public :: get_env public :: get_command_arguments_quoted public :: separator @@ -157,74 +156,6 @@ logical function os_is_unix(os) result(unix) unix = build_os /= OS_WINDOWS end function os_is_unix - !> echo command string and pass it to the system for execution - subroutine run(cmd,echo,exitstat,verbose,redirect) - character(len=*), intent(in) :: cmd - logical,intent(in),optional :: echo - integer, intent(out),optional :: exitstat - logical, intent(in), optional :: verbose - character(*), intent(in), optional :: redirect - - logical :: echo_local, verbose_local - character(:), allocatable :: redirect_str - character(1000) :: line - integer :: stat, fh, ios - - - if(present(echo))then - echo_local=echo - else - echo_local=.true. - end if - - if(present(verbose))then - verbose_local=verbose - else - verbose_local=.true. - end if - - if (present(redirect)) then - redirect_str = ">"//redirect//" 2>&1" - else - if(verbose_local)then - ! No redirection but verbose output - redirect_str = "" - else - ! No redirection and non-verbose output - if (os_is_unix()) then - redirect_str = ">/dev/null 2>&1" - else - redirect_str = ">NUL 2>&1" - end if - end if - end if - - if(echo_local) print *, '+ ', cmd - - call execute_command_line(cmd//redirect_str, exitstat=stat) - - if (verbose_local.and.present(redirect)) then - - open(newunit=fh,file=redirect,status='old') - do - read(fh, '(A)', iostat=ios) line - if (ios /= 0) exit - write(*,'(A)') trim(line) - end do - close(fh) - - end if - - if (present(exitstat)) then - exitstat = stat - else - if (stat /= 0) then - call fpm_stop(1,'*run*:Command failed') - end if - end if - - end subroutine run - !> get named environment variable value. It it is blank or !! not set return the optional default value function get_env(NAME,DEFAULT) result(VALUE) diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90 index 6127844b9a..7510ba7eda 100644 --- a/src/fpm_filesystem.F90 +++ b/src/fpm_filesystem.F90 @@ -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, os_is_unix use fpm_strings, only: f_string, replace, string_t, split, notabs use iso_c_binding, only: c_char, c_ptr, c_int, c_null_char, c_associated, c_f_pointer use fpm_error, only : fpm_stop @@ -15,7 +15,7 @@ module fpm_filesystem mkdir, exists, get_temp_filename, windows_path, unix_path, getline, delete_file public :: fileopen, fileclose, filewrite, warnwrite, parent_dir public :: read_lines, read_lines_expanded - public :: which, LINE_BUFFER_LEN + public :: which, run, LINE_BUFFER_LEN integer, parameter :: LINE_BUFFER_LEN = 1000 @@ -850,4 +850,73 @@ function which(command) result(pathname) enddo SEARCH end function which +!> echo command string and pass it to the system for execution +subroutine run(cmd,echo,exitstat,verbose,redirect) + character(len=*), intent(in) :: cmd + logical,intent(in),optional :: echo + integer, intent(out),optional :: exitstat + logical, intent(in), optional :: verbose + character(*), intent(in), optional :: redirect + + logical :: echo_local, verbose_local + character(:), allocatable :: redirect_str + character(:), allocatable :: line + integer :: stat, fh, ios + + + if(present(echo))then + echo_local=echo + else + echo_local=.true. + end if + + if(present(verbose))then + verbose_local=verbose + else + verbose_local=.true. + end if + + if (present(redirect)) then + redirect_str = ">"//redirect//" 2>&1" + else + if(verbose_local)then + ! No redirection but verbose output + redirect_str = "" + else + ! No redirection and non-verbose output + if (os_is_unix()) then + redirect_str = ">/dev/null 2>&1" + else + redirect_str = ">NUL 2>&1" + end if + end if + end if + + if(echo_local) print *, '+ ', cmd + + call execute_command_line(cmd//redirect_str, exitstat=stat) + + if (verbose_local.and.present(redirect)) then + + open(newunit=fh,file=redirect,status='old') + do + call getline(fh, line, ios) + if (ios /= 0) exit + write(*,'(A)') trim(line) + end do + close(fh) + + end if + + if (present(exitstat)) then + exitstat = stat + else + if (stat /= 0) then + call fpm_stop(1,'*run*:Command failed') + end if + end if + +end subroutine run + + end module fpm_filesystem diff --git a/test/new_test/new_test.f90 b/test/new_test/new_test.f90 index f191015ff5..61cbeb2ff9 100644 --- a/test/new_test/new_test.f90 +++ b/test/new_test/new_test.f90 @@ -1,9 +1,9 @@ program new_test use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit use fpm_filesystem, only : is_dir, list_files, exists, windows_path, join_path, & - dirname + dirname, run use fpm_strings, only : string_t, operator(.in.) -use fpm_environment, only : run, get_os_type +use fpm_environment, only : get_os_type use fpm_environment, only : OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD, OS_WINDOWS implicit none type(string_t), allocatable :: file_names(:) From b1b6a7b9bd1d3607dd80d8ba3fd767e88a852855 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Tue, 30 Nov 2021 14:23:55 +0000 Subject: [PATCH 22/23] Apply suggestions from code review Co-authored-by: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> --- src/fpm_backend.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/fpm_backend.F90 b/src/fpm_backend.F90 index ceba7acb91..f899f9d1bc 100644 --- a/src/fpm_backend.F90 +++ b/src/fpm_backend.F90 @@ -44,7 +44,7 @@ module fpm_backend interface function c_isatty() bind(C, name = 'c_isatty') use, intrinsic :: iso_c_binding, only: c_int - integer(c_int) :: c_isatty + integer(c_int) :: c_isatty end function end interface #endif @@ -93,7 +93,7 @@ subroutine build_package(targets,model,verbose) ! Check if queue is empty if (.not.verbose .and. size(queue) < 1) then - write(*,*) 'Project is up to date' + write(*, '(a)') 'Project is up to date' return end if @@ -138,7 +138,7 @@ subroutine build_package(targets,model,verbose) ! Check if this schedule region failed: exit with message if failed if (build_failed) then - write(*,*) '' + write(*,*) do j=1,size(stat) if (stat(j) /= 0) Then call print_build_log(queue(j)%ptr) From 6cd53f7dfce8628b54a232c551b5f20171932dbb Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sat, 12 Feb 2022 11:28:20 +0000 Subject: [PATCH 23/23] Fix: for consistent alignment of backend console output. --- src/fpm_backend_console.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/fpm_backend_console.f90 b/src/fpm_backend_console.f90 index 014e800909..59d8f0e91e 100644 --- a/src/fpm_backend_console.f90 +++ b/src/fpm_backend_console.f90 @@ -96,12 +96,12 @@ subroutine console_update_line(console,line_no,str) !$omp critical - n = console%n_line - line_no !+ 1 !+ 1 + n = console%n_line - line_no ! Step back to line write(stdout,'(A)',advance="no") repeat(LINE_UP,n)//LINE_RESET - write(stdout,*) str + write(stdout,'(A)') str ! Step forward to end write(stdout,'(A)',advance="no") repeat(LINE_DOWN,n)//LINE_RESET