diff options
author | Laurence Kedward <laurence.kedward@bristol.ac.uk> | 2022-02-14 19:04:35 +0000 |
---|---|---|
committer | GitHub <noreply@github.com> | 2022-02-14 19:04:35 +0000 |
commit | 2c6148e0f9ceafc55da934b8b84299f05a3c030c (patch) | |
tree | 0f2c9d40a6410eebee73a4dcf8836cced6b27c0d | |
parent | 57b5636f5f573f06326fdecd24057a6297a53501 (diff) | |
parent | d2009f179da1ddd83d92666f6395cf72414d1be2 (diff) | |
download | fpm-2c6148e0f9ceafc55da934b8b84299f05a3c030c.tar.gz fpm-2c6148e0f9ceafc55da934b8b84299f05a3c030c.zip |
Merge pull request #622 from LKedward/backend-output
Cleanup the backend output
-rw-r--r-- | .github/workflows/CI.yml | 11 | ||||
-rw-r--r-- | src/fpm.f90 | 15 | ||||
-rw-r--r-- | src/fpm/cmd/install.f90 | 2 | ||||
-rw-r--r-- | src/fpm/cmd/new.f90 | 4 | ||||
-rw-r--r-- | src/fpm_backend.F90 (renamed from src/fpm_backend.f90) | 88 | ||||
-rw-r--r-- | src/fpm_backend_console.f90 | 113 | ||||
-rw-r--r-- | src/fpm_backend_output.f90 | 178 | ||||
-rw-r--r-- | src/fpm_command_line.f90 | 6 | ||||
-rw-r--r-- | src/fpm_compiler.f90 | 54 | ||||
-rw-r--r-- | src/fpm_environment.f90 | 30 | ||||
-rw-r--r-- | src/fpm_filesystem.F90 | 97 | ||||
-rw-r--r-- | src/fpm_targets.f90 | 7 | ||||
-rw-r--r-- | src/ptycheck/LICENSE | 22 | ||||
-rw-r--r-- | src/ptycheck/isatty.c | 33 | ||||
-rw-r--r-- | src/ptycheck/iscygpty.c | 185 | ||||
-rw-r--r-- | src/ptycheck/iscygpty.h | 41 | ||||
-rw-r--r-- | test/new_test/new_test.f90 | 4 |
17 files changed, 813 insertions, 77 deletions
diff --git a/.github/workflows/CI.yml b/.github/workflows/CI.yml index 2d951dc..3874636 100644 --- a/.github/workflows/CI.yml +++ b/.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 diff --git a/src/fpm.f90 b/src/fpm.f90 index 6084a11..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 @@ -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 @@ 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 +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() 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/cmd/new.f90 b/src/fpm/cmd/new.f90 index 99aa4c5..739f4e0 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, 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 diff --git a/src/fpm_backend.f90 b/src/fpm_backend.F90 index e0c6d73..f899f9d 100644 --- a/src/fpm_backend.f90 +++ b/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,16 +299,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 @@ -278,18 +317,19 @@ subroutine build_target(model,target,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 @@ -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 diff --git a/src/fpm_backend_console.f90 b/src/fpm_backend_console.f90 new file mode 100644 index 0000000..59d8f0e --- /dev/null +++ b/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
\ 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..3f297f7 --- /dev/null +++ b/src/fpm_backend_output.f90 @@ -0,0 +1,178 @@ +!># 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
+use fpm_targets, only: build_target_ptr
+use fpm_backend_console, only: console_t, LINE_RESET, COLOR_RED, COLOR_GREEN, COLOR_YELLOW, COLOR_RESET
+implicit none
+
+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
+ !> 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
+
+!> Constructor for build_progress_t
+interface build_progress_t
+ procedure :: new_build_progress
+end interface build_progress_t
+
+contains
+
+ !> 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
+
+ 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 function new_build_progress
+
+ !> 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
+ character(100) :: output_string
+ character(100) :: overall_progress
+
+ 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 ! Plain output
+
+ !$omp critical
+ write(*,'(A8,A30)') trim(overall_progress),target_name
+ !$omp end critical
+
+ else ! Pretty output
+
+ 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.)
+
+ end if
+
+ end associate
+
+ 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
+ character(100) :: output_string
+ character(100) :: overall_progress
+
+ !$omp critical
+ progress%n_complete = progress%n_complete + 1
+ !$omp end critical
+
+ 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
+
+ if (build_stat == 0) then
+ write(output_string,'(A,T40,A,A)') target_name,COLOR_GREEN//'done.'//COLOR_RESET
+ else
+ 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,'%] '
+
+ if (progress%plain_mode) then ! Plain output
+
+ !$omp critical
+ write(*,'(A8,A30,A7)') trim(overall_progress),target_name, 'done.'
+ !$omp end critical
+
+ else ! Pretty output
+
+ call progress%console%update_line(progress%output_lines(queue_index),trim(output_string))
+
+ call progress%console%write_line(trim(overall_progress)//'Compiling...',advance=.false.)
+
+ end if
+
+ end associate
+
+ 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 ! Plain output
+
+ write(*,'(A)') '[100%] Project compiled successfully.'
+
+ else ! Pretty output
+
+ write(*,'(A)') LINE_RESET//COLOR_GREEN//'[100%] Project compiled successfully.'//COLOR_RESET
+
+ end if
+
+ end subroutine output_progress_success
+
+end module fpm_backend_output
\ No newline at end of file diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index cb19192..836c1a9 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -29,10 +29,10 @@ 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_os, only : get_current_directory +use fpm_filesystem, only : basename, canon_path, which, run +use fpm_environment, only : get_command_arguments_quoted use fpm_error, only : fpm_stop, error_t +use fpm_os, only : get_current_directory use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, & & stdout=>output_unit, & & stderr=>error_unit diff --git a/src/fpm_compiler.f90 b/src/fpm_compiler.f90 index 98a3650..d94963c 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: split, string_cat, string_t implicit none public :: compiler_t, new_compiler, archiver_t, new_archiver @@ -81,6 +80,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 @@ -109,6 +110,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 @@ -639,16 +642,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 @@ -659,11 +668,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 @@ -697,12 +710,13 @@ 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 !> 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 @@ -711,16 +725,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, 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 @@ -729,47 +745,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, 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, exitstat=stat) + call run(self%fc // " " // args // " -o " // output, echo=self%echo, & + & 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, exitstat=stat) + call run(self%ar // output // " @" // output//".resp", echo=self%echo, & + & 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, exitstat=stat) + & echo=self%echo, verbose=self%verbose, redirect=log_file, exitstat=stat) end if end subroutine make_archive diff --git a/src/fpm_environment.f90 b/src/fpm_environment.f90 index a9f8c65..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 @@ -154,36 +153,9 @@ 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 - subroutine run(cmd,echo,exitstat) - character(len=*), intent(in) :: cmd - logical,intent(in),optional :: echo - integer, intent(out),optional :: exitstat - logical :: echo_local - integer :: stat - - if(present(echo))then - echo_local=echo - else - echo_local=.true. - endif - if(echo_local) print *, '+ ', cmd - - call execute_command_line(cmd, exitstat=stat) - - 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 6837fef..15292ec 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, str_begins_with_str 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 @@ -16,7 +16,7 @@ module fpm_filesystem public :: fileopen, fileclose, filewrite, warnwrite, parent_dir public :: is_hidden_file public :: read_lines, read_lines_expanded - public :: which + public :: which, run, LINE_BUFFER_LEN integer, parameter :: LINE_BUFFER_LEN = 1000 @@ -359,20 +359,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 @@ -844,4 +860,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/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 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..9b7f519 --- /dev/null +++ b/src/ptycheck/isatty.c @@ -0,0 +1,33 @@ +// 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 <unistd.h> //for isatty()
+#include <stdio.h> //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)
+{
+
+ 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 <ctype.h> +#include <io.h> +#include <wchar.h> +#include <windows.h> + +#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 <fileextd.h> +#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 */ 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(:) |