Merge pull request #622 from LKedward/backend-output

Cleanup the backend output

Author: LKedward

.github/workflows/CI.yml

@@ -59,11 +59,20 @@ 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
       with:
-        fpm-version: 'v0.2.0'
+        fpm-version: 'v0.3.0'
 
     - name: Remove fpm from path
       shell: bash

src/fpm.f90

@@ -4,8 +4,9 @@ module fpm
 use fpm_command_line, only: fpm_build_settings, fpm_new_settings, &
                       fpm_run_settings, fpm_install_settings, fpm_test_settings
 use fpm_dependency, only : new_dependency_tree
-use fpm_environment, only: run, get_env
-use fpm_filesystem, only: is_dir, join_path, number_of_rows, list_files, exists, basename, filewrite, mkdir
+use fpm_environment, only: get_env
+use fpm_filesystem, only: is_dir, join_path, number_of_rows, list_files, exists, &
+                   basename, filewrite, mkdir, run
 use fpm_model, only: fpm_model_t, srcfile_t, show_model, &
                     FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, FPM_SCOPE_DEP, &
                     FPM_SCOPE_APP, FPM_SCOPE_EXAMPLE, FPM_SCOPE_TEST
@@ -59,8 +60,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)
+    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")
@@ -284,7 +287,7 @@ subroutine cmd_build(settings)
 else if (settings%show_model) then
     call show_model(model)
 else
-    call build_package(targets,model)
+    call build_package(targets,model,verbose=settings%verbose)
 endif
 
 end subroutine cmd_build
@@ -415,7 +418,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()

src/fpm/cmd/install.f90

@@ -54,7 +54,7 @@ subroutine cmd_install(settings)
     end if
 
     if (.not.settings%no_rebuild) then
-      call build_package(targets,model)
+      call build_package(targets,model,verbose=settings%verbose)
     end if
 
     call new_installer(installer, prefix=settings%prefix, &

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, which
+use fpm_filesystem, only : fileopen, fileclose, filewrite, warnwrite, which, run
 use fpm_strings, only : join, to_fortran_name
 use fpm_error, only : fpm_stop
 

src/fpm_backend.f90 renamed to src/fpm_backend.F90

@@ -29,23 +29,33 @@ 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, 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, &
                        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)
+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 +64,9 @@ subroutine build_package(targets,model)
     type(string_t), allocatable :: build_dirs(:)
     type(string_t) :: temp
 
+    type(build_progress_t) :: progress
+    logical :: plain_output
+
     ! Need to make output directory for include (mod) files
     allocate(build_dirs(0))
     do i = 1, size(targets)
@@ -65,7 +78,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
@@ -78,11 +91,26 @@ subroutine build_package(targets,model)
     ! 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(*, '(a)') 'Project is up to date'
+        return
+    end if
+
     ! Initialise build status flags
     allocate(stat(size(queue)))
     stat(:) = 0
     build_failed = .false.
 
+    ! Set output mode
+#ifndef FPM_BOOTSTRAP
+    plain_output = (.not.(c_isatty()==1)) .or. verbose
+#else
+    plain_output = .true.
+#endif
+
+    progress = build_progress_t(queue,plain_output)
+
     ! Loop over parallel schedule regions
     do i=1,size(schedule_ptr)-1
 
@@ -95,7 +123,9 @@ subroutine build_package(targets,model)
             skip_current = build_failed
 
             if (.not.skip_current) then
-                call build_target(model,queue(j)%ptr,stat(j))
+                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
@@ -108,6 +138,12 @@ subroutine build_package(targets,model)
 
         ! 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))') '<ERROR> Compilation failed for object "',basename(queue(j)%ptr%output_file),'"'
@@ -118,6 +154,8 @@ subroutine build_package(targets,model)
 
     end do
 
+    call progress%success()
+
 end subroutine build_package
 
 
@@ -261,35 +299,37 @@ 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
 
     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)
+            & 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
 
@@ -302,4 +342,30 @@ subroutine build_target(model,target,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(:), allocatable :: line
+
+    if (exists(target%output_log_file)) then
+
+        open(newunit=fh,file=target%output_log_file,status='old')
+        do
+            call getline(fh, line, ios)
+            if (ios /= 0) exit
+            write(*,'(A)') trim(line)
+        end do
+        close(fh)
+
+    else
+
+        write(stderr,'(*(g0:,1x))') '<ERROR> Unable to find build log "',basename(target%output_log_file),'"'
+
+    end if
+
+end subroutine print_build_log
+
 end module fpm_backend

src/fpm_backend_console.f90

@@ -0,0 +1,113 @@
+!># 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
+
+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
+
+contains
+    !> 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
+
+!> Write a single line to the standard output
+subroutine console_write_line(console,str,line,advance)
+    !> Console object
+    class(console_t), intent(inout) :: 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
+
+    adv = "yes"
+    if (present(advance)) then
+        if (.not.advance) then
+            adv = "no"
+        end if
+    end if
+
+    !$omp critical
+
+    if (present(line)) then
+        line = console%n_line
+    end if
+    
+    write(stdout,'(A)',advance=trim(adv)) LINE_RESET//str
+
+    if (adv=="yes") then
+        console%n_line = console%n_line + 1
+    end if
+
+    !$omp end critical
+
+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
+
+    !$omp critical
+
+    n = console%n_line - line_no
+
+    ! Step back to line
+    write(stdout,'(A)',advance="no") repeat(LINE_UP,n)//LINE_RESET
+
+    write(stdout,'(A)') str
+
+    ! Step forward to end
+    write(stdout,'(A)',advance="no") repeat(LINE_DOWN,n)//LINE_RESET
+
+    !$omp end critical
+
+end subroutine console_update_line
+
+end module fpm_backend_console