From 22ec97aceb5239f2b24e58ab05f41e6e9e4abf35 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Mon, 22 Nov 2021 15:56:31 +0000 Subject: 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 a9f8c65..bcd9cb9 100644 --- a/src/fpm_environment.f90 +++ b/src/fpm_environment.f90 @@ -154,7 +154,7 @@ contains 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 -- cgit v1.2.3 From d9520ce7ca433c94d4309ee834c0d4494652c4d0 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Mon, 22 Nov 2021 16:08:27 +0000 Subject: 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 83cffe7..2b5b787 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 -- cgit v1.2.3 From 2654623adea742b2e10a85aa90706f20f8b87b88 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Mon, 22 Nov 2021 16:08:47 +0000 Subject: 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 bcd9cb9..22094e5 100644 --- a/src/fpm_environment.f90 +++ b/src/fpm_environment.f90 @@ -158,22 +158,40 @@ contains 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 -- cgit v1.2.3 From 30d730f51fea587574a922f8763f3c7988198029 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Mon, 22 Nov 2021 16:11:26 +0000 Subject: 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 6084a11..0fec0ed 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -284,7 +284,7 @@ if(settings%list)then 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 099a0e5..46f24a7 100644 --- a/src/fpm/cmd/install.f90 +++ b/src/fpm/cmd/install.f90 @@ -54,7 +54,7 @@ contains 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 e0c6d73..731763f 100644 --- a/src/fpm_backend.f90 +++ b/src/fpm_backend.f90 @@ -40,12 +40,20 @@ implicit none 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 0000000..bd0f74a --- /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 -- cgit v1.2.3 From 6ea34933fbb991df706d613718acfefee538efdc Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Mon, 22 Nov 2021 16:12:14 +0000 Subject: 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 0fec0ed..8b05a38 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 c0c5b73..e83d7a4 100644 --- a/src/fpm_compiler.f90 +++ b/src/fpm_compiler.f90 @@ -79,6 +79,8 @@ type :: compiler_t 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 @@ type :: archiver_t 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 -- cgit v1.2.3 From 995fb2e834e4e555e8b6bc32eadb57983ef5b298 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Mon, 22 Nov 2021 16:08:47 +0000 Subject: 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 22094e5..9c64653 100644 --- a/src/fpm_environment.f90 +++ b/src/fpm_environment.f90 @@ -185,7 +185,6 @@ contains 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) -- cgit v1.2.3 From bfd9b06249814ad7c4bc47c0f065d6337f87076c Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Mon, 22 Nov 2021 16:13:01 +0000 Subject: 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 7289c82..f3a297c 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 731763f..e0ed972 100644 --- a/src/fpm_backend.f90 +++ b/src/fpm_backend.f90 @@ -35,6 +35,7 @@ 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, & 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 0000000..4db0cdc --- /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 0000000..82c019f --- /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 -- cgit v1.2.3 From 5728b54443059fc07595251743ad1c0965afae58 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Mon, 22 Nov 2021 16:16:07 +0000 Subject: 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 2d951dc..55c548f 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 -- cgit v1.2.3 From 229761aa6fb342abd42dffdaa968611d48adf3d4 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Mon, 22 Nov 2021 16:18:41 +0000 Subject: 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 e0ed972..af50162 100644 --- a/src/fpm_backend.f90 +++ b/src/fpm_backend.f90 @@ -41,12 +41,14 @@ implicit none 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) -- cgit v1.2.3 From 778763233905a7a27d34b066793dc3fc12366ec5 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Tue, 23 Nov 2021 10:15:26 +0000 Subject: Update: fpm_backend as preprocessed file. --- src/fpm_backend.F90 | 342 ++++++++++++++++++++++++++++++++++++++++++++++++++++ src/fpm_backend.f90 | 342 ---------------------------------------------------- 2 files changed, 342 insertions(+), 342 deletions(-) create mode 100644 src/fpm_backend.F90 delete mode 100644 src/fpm_backend.f90 diff --git a/src/fpm_backend.F90 b/src/fpm_backend.F90 new file mode 100644 index 0000000..af50162 --- /dev/null +++ b/src/fpm_backend.F90 @@ -0,0 +1,342 @@ +!># Build backend +!> Uses a list of `[[build_target_ptr]]` and a valid `[[fpm_model]]` instance +!> to schedule and execute the compilation and linking of package targets. +!> +!> The package build process (`[[build_package]]`) comprises three steps: +!> +!> 1. __Target sorting:__ topological sort of the target dependency graph (`[[sort_target]]`) +!> 2. __Target scheduling:__ group targets into schedule regions based on the sorting (`[[schedule_targets]]`) +!> 3. __Target building:__ generate targets by compilation or linking +!> +!> @note If compiled with OpenMP, targets will be build in parallel where possible. +!> +!>### Incremental compilation +!> The backend process supports *incremental* compilation whereby targets are not +!> re-compiled if their corresponding dependencies have not been modified. +!> +!> - Source-based targets (*i.e.* objects) are not re-compiled if the corresponding source +!> file is unmodified AND all of the target dependencies are not marked for re-compilation +!> +!> - Link targets (*i.e.* executables and libraries) are not re-compiled if the +!> target output file already exists AND all of the target dependencies are not marked for +!> re-compilation +!> +!> Source file modification is determined by a file digest (hash) which is calculated during +!> the source parsing phase ([[fpm_source_parsing]]) and cached to disk after a target is +!> successfully generated. +!> +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_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, & + FPM_TARGET_C_OBJECT, FPM_TARGET_ARCHIVE, FPM_TARGET_EXECUTABLE +use fpm_backend_output +implicit none + +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 + +!> Top-level routine to build package described by `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(:) + integer, allocatable :: schedule_ptr(:), stat(:) + logical :: build_failed, skip_current + 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 + allocate(build_dirs(0)) + do i = 1, size(targets) + associate(target => targets(i)%ptr) + if (target%output_dir .in. build_dirs) cycle + temp%s = target%output_dir + build_dirs = [build_dirs, temp] + end associate + end do + + do i = 1, size(build_dirs) + call mkdir(build_dirs(i)%s,verbose) + end do + + ! Perform depth-first topological sort of targets + do i=1,size(targets) + + call sort_target(targets(i)%ptr) + + end do + + ! Construct build schedule queue + call schedule_targets(queue, schedule_ptr, targets) + + ! Initialise build status flags + 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 +#endif + 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,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 + + if (.not.skip_current) then + call build_target(model,queue(j)%ptr,verbose,stat(j)) + end if + + ! Set global flag if this target failed to build + if (stat(j) /= 0) then + !$omp atomic write + 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),'"' + end if + end do + call fpm_stop(1,'stopping due to failed compilation') + end if + + end do + + call output_progress_complete() + +end subroutine build_package + + +!> Topologically sort a target for scheduling by +!> recursing over its dependencies. +!> +!> Checks disk-cached source hashes to determine if objects are +!> up-to-date. Up-to-date sources are tagged as skipped. +!> +!> On completion, `target` should either be marked as +!> sorted (`target%sorted=.true.`) or skipped (`target%skip=.true.`) +!> +!> If `target` is marked as sorted, `target%schedule` should be an +!> integer greater than zero indicating the region for scheduling +!> +recursive subroutine sort_target(target) + type(build_target_t), intent(inout), target :: target + + integer :: i, fh, stat + + ! Check if target has already been processed (as a dependency) + if (target%sorted .or. target%skip) then + return + end if + + ! Check for a circular dependency + ! (If target has been touched but not processed) + if (target%touched) then + call fpm_stop(1,'(!) Circular dependency found with: '//target%output_file) + else + target%touched = .true. ! Set touched flag + end if + + ! Load cached source file digest if present + if (.not.allocated(target%digest_cached) .and. & + exists(target%output_file) .and. & + exists(target%output_file//'.digest')) then + + allocate(target%digest_cached) + open(newunit=fh,file=target%output_file//'.digest',status='old') + read(fh,*,iostat=stat) target%digest_cached + close(fh) + + if (stat /= 0) then ! Cached digest is not recognized + deallocate(target%digest_cached) + end if + + end if + + if (allocated(target%source)) then + + ! Skip if target is source-based and source file is unmodified + if (allocated(target%digest_cached)) then + if (target%digest_cached == target%source%digest) target%skip = .true. + end if + + elseif (exists(target%output_file)) then + + ! Skip if target is not source-based and already exists + target%skip = .true. + + end if + + ! Loop over target dependencies + target%schedule = 1 + do i=1,size(target%dependencies) + + ! Sort dependency + call sort_target(target%dependencies(i)%ptr) + + if (.not.target%dependencies(i)%ptr%skip) then + + ! Can't skip target if any dependency is not skipped + target%skip = .false. + + ! Set target schedule after all of its dependencies + target%schedule = max(target%schedule,target%dependencies(i)%ptr%schedule+1) + + end if + + end do + + ! Mark flag as processed: either sorted or skipped + target%sorted = .not.target%skip + +end subroutine sort_target + + +!> Construct a build schedule from the sorted targets. +!> +!> The schedule is broken into regions, described by `schedule_ptr`, +!> where targets in each region can be compiled in parallel. +!> +subroutine schedule_targets(queue, schedule_ptr, targets) + type(build_target_ptr), allocatable, intent(out) :: queue(:) + integer, allocatable :: schedule_ptr(:) + type(build_target_ptr), intent(in) :: targets(:) + + integer :: i, j + integer :: n_schedule, n_sorted + + n_schedule = 0 ! Number of schedule regions + n_sorted = 0 ! Total number of targets to build + do i=1,size(targets) + + if (targets(i)%ptr%sorted) then + n_sorted = n_sorted + 1 + end if + n_schedule = max(n_schedule, targets(i)%ptr%schedule) + + end do + + allocate(queue(n_sorted)) + allocate(schedule_ptr(n_schedule+1)) + + ! Construct the target queue and schedule region pointer + n_sorted = 1 + schedule_ptr(n_sorted) = 1 + do i=1,n_schedule + + do j=1,size(targets) + + if (targets(j)%ptr%sorted) then + if (targets(j)%ptr%schedule == i) then + + queue(n_sorted)%ptr => targets(j)%ptr + n_sorted = n_sorted + 1 + end if + end if + + end do + + schedule_ptr(i+1) = n_sorted + + end do + +end subroutine schedule_targets + + +!> Call compile/link command for a single target. +!> +!> If successful, also caches the source file digest to disk. +!> +subroutine build_target(model,target,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),verbose) + end if + !$omp end critical + + select case(target%target_type) + + case (FPM_TARGET_OBJECT) + call model%compiler%compile_fortran(target%source%file_name, target%output_file, & + & target%compile_flags, stat) + + case (FPM_TARGET_C_OBJECT) + call model%compiler%compile_c(target%source%file_name, target%output_file, & + & target%compile_flags, stat) + + case (FPM_TARGET_EXECUTABLE) + call model%compiler%link(target%output_file, & + & target%compile_flags//" "//target%link_flags, stat) + + case (FPM_TARGET_ARCHIVE) + call model%archiver%make_archive(target%output_file, target%link_objects, stat) + + end select + + if (stat == 0 .and. allocated(target%source)) then + open(newunit=fh,file=target%output_file//'.digest',status='unknown') + write(fh,*) target%source%digest + close(fh) + end if + +end subroutine build_target + + +end module fpm_backend diff --git a/src/fpm_backend.f90 b/src/fpm_backend.f90 deleted file mode 100644 index af50162..0000000 --- a/src/fpm_backend.f90 +++ /dev/null @@ -1,342 +0,0 @@ -!># Build backend -!> Uses a list of `[[build_target_ptr]]` and a valid `[[fpm_model]]` instance -!> to schedule and execute the compilation and linking of package targets. -!> -!> The package build process (`[[build_package]]`) comprises three steps: -!> -!> 1. __Target sorting:__ topological sort of the target dependency graph (`[[sort_target]]`) -!> 2. __Target scheduling:__ group targets into schedule regions based on the sorting (`[[schedule_targets]]`) -!> 3. __Target building:__ generate targets by compilation or linking -!> -!> @note If compiled with OpenMP, targets will be build in parallel where possible. -!> -!>### Incremental compilation -!> The backend process supports *incremental* compilation whereby targets are not -!> re-compiled if their corresponding dependencies have not been modified. -!> -!> - Source-based targets (*i.e.* objects) are not re-compiled if the corresponding source -!> file is unmodified AND all of the target dependencies are not marked for re-compilation -!> -!> - Link targets (*i.e.* executables and libraries) are not re-compiled if the -!> target output file already exists AND all of the target dependencies are not marked for -!> re-compilation -!> -!> Source file modification is determined by a file digest (hash) which is calculated during -!> the source parsing phase ([[fpm_source_parsing]]) and cached to disk after a target is -!> successfully generated. -!> -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_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, & - FPM_TARGET_C_OBJECT, FPM_TARGET_ARCHIVE, FPM_TARGET_EXECUTABLE -use fpm_backend_output -implicit none - -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 - -!> Top-level routine to build package described by `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(:) - integer, allocatable :: schedule_ptr(:), stat(:) - logical :: build_failed, skip_current - 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 - allocate(build_dirs(0)) - do i = 1, size(targets) - associate(target => targets(i)%ptr) - if (target%output_dir .in. build_dirs) cycle - temp%s = target%output_dir - build_dirs = [build_dirs, temp] - end associate - end do - - do i = 1, size(build_dirs) - call mkdir(build_dirs(i)%s,verbose) - end do - - ! Perform depth-first topological sort of targets - do i=1,size(targets) - - call sort_target(targets(i)%ptr) - - end do - - ! Construct build schedule queue - call schedule_targets(queue, schedule_ptr, targets) - - ! Initialise build status flags - 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 -#endif - 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,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 - - if (.not.skip_current) then - call build_target(model,queue(j)%ptr,verbose,stat(j)) - end if - - ! Set global flag if this target failed to build - if (stat(j) /= 0) then - !$omp atomic write - 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),'"' - end if - end do - call fpm_stop(1,'stopping due to failed compilation') - end if - - end do - - call output_progress_complete() - -end subroutine build_package - - -!> Topologically sort a target for scheduling by -!> recursing over its dependencies. -!> -!> Checks disk-cached source hashes to determine if objects are -!> up-to-date. Up-to-date sources are tagged as skipped. -!> -!> On completion, `target` should either be marked as -!> sorted (`target%sorted=.true.`) or skipped (`target%skip=.true.`) -!> -!> If `target` is marked as sorted, `target%schedule` should be an -!> integer greater than zero indicating the region for scheduling -!> -recursive subroutine sort_target(target) - type(build_target_t), intent(inout), target :: target - - integer :: i, fh, stat - - ! Check if target has already been processed (as a dependency) - if (target%sorted .or. target%skip) then - return - end if - - ! Check for a circular dependency - ! (If target has been touched but not processed) - if (target%touched) then - call fpm_stop(1,'(!) Circular dependency found with: '//target%output_file) - else - target%touched = .true. ! Set touched flag - end if - - ! Load cached source file digest if present - if (.not.allocated(target%digest_cached) .and. & - exists(target%output_file) .and. & - exists(target%output_file//'.digest')) then - - allocate(target%digest_cached) - open(newunit=fh,file=target%output_file//'.digest',status='old') - read(fh,*,iostat=stat) target%digest_cached - close(fh) - - if (stat /= 0) then ! Cached digest is not recognized - deallocate(target%digest_cached) - end if - - end if - - if (allocated(target%source)) then - - ! Skip if target is source-based and source file is unmodified - if (allocated(target%digest_cached)) then - if (target%digest_cached == target%source%digest) target%skip = .true. - end if - - elseif (exists(target%output_file)) then - - ! Skip if target is not source-based and already exists - target%skip = .true. - - end if - - ! Loop over target dependencies - target%schedule = 1 - do i=1,size(target%dependencies) - - ! Sort dependency - call sort_target(target%dependencies(i)%ptr) - - if (.not.target%dependencies(i)%ptr%skip) then - - ! Can't skip target if any dependency is not skipped - target%skip = .false. - - ! Set target schedule after all of its dependencies - target%schedule = max(target%schedule,target%dependencies(i)%ptr%schedule+1) - - end if - - end do - - ! Mark flag as processed: either sorted or skipped - target%sorted = .not.target%skip - -end subroutine sort_target - - -!> Construct a build schedule from the sorted targets. -!> -!> The schedule is broken into regions, described by `schedule_ptr`, -!> where targets in each region can be compiled in parallel. -!> -subroutine schedule_targets(queue, schedule_ptr, targets) - type(build_target_ptr), allocatable, intent(out) :: queue(:) - integer, allocatable :: schedule_ptr(:) - type(build_target_ptr), intent(in) :: targets(:) - - integer :: i, j - integer :: n_schedule, n_sorted - - n_schedule = 0 ! Number of schedule regions - n_sorted = 0 ! Total number of targets to build - do i=1,size(targets) - - if (targets(i)%ptr%sorted) then - n_sorted = n_sorted + 1 - end if - n_schedule = max(n_schedule, targets(i)%ptr%schedule) - - end do - - allocate(queue(n_sorted)) - allocate(schedule_ptr(n_schedule+1)) - - ! Construct the target queue and schedule region pointer - n_sorted = 1 - schedule_ptr(n_sorted) = 1 - do i=1,n_schedule - - do j=1,size(targets) - - if (targets(j)%ptr%sorted) then - if (targets(j)%ptr%schedule == i) then - - queue(n_sorted)%ptr => targets(j)%ptr - n_sorted = n_sorted + 1 - end if - end if - - end do - - schedule_ptr(i+1) = n_sorted - - end do - -end subroutine schedule_targets - - -!> Call compile/link command for a single target. -!> -!> If successful, also caches the source file digest to disk. -!> -subroutine build_target(model,target,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),verbose) - end if - !$omp end critical - - select case(target%target_type) - - case (FPM_TARGET_OBJECT) - call model%compiler%compile_fortran(target%source%file_name, target%output_file, & - & target%compile_flags, stat) - - case (FPM_TARGET_C_OBJECT) - call model%compiler%compile_c(target%source%file_name, target%output_file, & - & target%compile_flags, stat) - - case (FPM_TARGET_EXECUTABLE) - call model%compiler%link(target%output_file, & - & target%compile_flags//" "//target%link_flags, stat) - - case (FPM_TARGET_ARCHIVE) - call model%archiver%make_archive(target%output_file, target%link_objects, stat) - - end select - - if (stat == 0 .and. allocated(target%source)) then - open(newunit=fh,file=target%output_file//'.digest',status='unknown') - write(fh,*) target%source%digest - close(fh) - end if - -end subroutine build_target - - -end module fpm_backend -- cgit v1.2.3 From 2e2f0e326235c9bca9ee3855f012ab74cc4a56ed Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Tue, 23 Nov 2021 14:50:52 +0000 Subject: 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 bd0f74a..0000000 --- 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 0000000..90ee59f --- /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 0000000..61acee6 --- /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 0000000..722f88f --- /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 0000000..82fd0af --- /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 */ -- cgit v1.2.3 From 8b4f3a683db73c131467e591d319fe2d118bb8a8 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Thu, 25 Nov 2021 11:31:55 +0000 Subject: 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 55c548f..3874636 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 -- cgit v1.2.3 From b628302b8417c12d5ca4ead439f636f198352b55 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Thu, 25 Nov 2021 15:52:31 +0000 Subject: 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 9c64653..e8534ac 100644 --- a/src/fpm_environment.f90 +++ b/src/fpm_environment.f90 @@ -158,13 +158,17 @@ contains 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 @@ contains 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 -- cgit v1.2.3 From ab7cb42fddc3cf19fe20c76dac527a9e591b11c2 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Thu, 25 Nov 2021 15:53:29 +0000 Subject: 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 af50162..cb2dbc0 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 e83d7a4..dba21b2 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 2b5b787..6127844 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 7ea815b..122d73a 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -75,6 +75,9 @@ type build_target_t !> 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 -- cgit v1.2.3 From 37ba9d7cf61d6b9ddbfe59a4456311fda62ef101 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Fri, 26 Nov 2021 17:32:07 +0000 Subject: 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 cb2dbc0..796c7ac 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 4db0cdc..7daff14 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 82c019f..4eb2889 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 @@ contains 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 -- cgit v1.2.3 From 93b629e504900432ea712cc3ed65dd937483e1c1 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sat, 27 Nov 2021 17:35:12 +0000 Subject: 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 7daff14..4422037 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 @@ public :: console_t 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 4eb2889..8c7fd7d 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 @@ use fpm_backend_console, only: console_t 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 @@ contains 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 @@ contains 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 @@ contains 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 @@ contains 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 @@ contains 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 e8534ac..224d2aa 100644 --- a/src/fpm_environment.f90 +++ b/src/fpm_environment.f90 @@ -198,13 +198,6 @@ contains 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 61acee6..9b7f519 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) { -- cgit v1.2.3 From fc058eca31036584649cd3b712a649e9dd01c2d7 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sat, 27 Nov 2021 18:23:53 +0000 Subject: 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 796c7ac..f8d491f 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 -- cgit v1.2.3 From 4556e7a4435c6ef2da8782c033229e06e91b6a4e Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sun, 28 Nov 2021 11:11:11 +0000 Subject: 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 8b05a38..135cadc 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 dba21b2..2f939ad 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 -- cgit v1.2.3 From 6aba40db1385007e0bf4e9c2b9b4afe8bb105593 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sun, 28 Nov 2021 11:24:41 +0000 Subject: 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 f8d491f..e666d03 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 4422037..73bcd5d 100644 --- a/src/fpm_backend_console.f90 +++ b/src/fpm_backend_console.f90 @@ -30,22 +30,25 @@ type console_t !> 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 8c7fd7d..2cc8597 100644 --- a/src/fpm_backend_output.f90 +++ b/src/fpm_backend_output.f90 @@ -35,8 +35,6 @@ type build_progress_t !> 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 @@ contains 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 @@ contains 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) -- cgit v1.2.3 From b0115d1a000ee15d3ca773c3da3300595d805454 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sun, 28 Nov 2021 11:43:49 +0000 Subject: 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 f3a297c..7289c82 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 73bcd5d..014e800 100644 --- a/src/fpm_backend_console.f90 +++ b/src/fpm_backend_console.f90 @@ -14,21 +14,30 @@ implicit none 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 @@ contains 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 2cc8597..3f297f7 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 @@ contains 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 @@ contains 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 @@ contains 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 @@ contains 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 -- cgit v1.2.3 From 0c561b0f76bc6fa7777dec884a16b76694913adf Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sun, 28 Nov 2021 11:55:50 +0000 Subject: 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 135cadc..7291247 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -4,8 +4,9 @@ use fpm_backend, only: build_package 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 a402432..61afc74 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 e666d03..ceba7ac 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 0837bf2..99fdef2 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -29,8 +29,8 @@ use fpm_environment, only : get_os_type, get_env, & 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 2f939ad..1c086cc 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 @@ use fpm_environment, only: & 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 224d2aa..7926703 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 @@ contains 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 6127844..7510ba7 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 @@ integer :: i, j 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 f191015..61cbeb2 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(:) -- cgit v1.2.3 From b1b6a7b9bd1d3607dd80d8ba3fd767e88a852855 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Tue, 30 Nov 2021 14:23:55 +0000 Subject: 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 ceba7ac..f899f9d 100644 --- a/src/fpm_backend.F90 +++ b/src/fpm_backend.F90 @@ -44,7 +44,7 @@ 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 + 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) -- cgit v1.2.3 From 6cd53f7dfce8628b54a232c551b5f20171932dbb Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sat, 12 Feb 2022 11:28:20 +0000 Subject: 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 014e800..59d8f0e 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 -- cgit v1.2.3