aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--.github/workflows/CI.yml11
-rw-r--r--src/fpm.f9015
-rw-r--r--src/fpm/cmd/install.f902
-rw-r--r--src/fpm/cmd/new.f904
-rw-r--r--src/fpm_backend.F90 (renamed from src/fpm_backend.f90)88
-rw-r--r--src/fpm_backend_console.f90113
-rw-r--r--src/fpm_backend_output.f90178
-rw-r--r--src/fpm_command_line.f906
-rw-r--r--src/fpm_compiler.f9054
-rw-r--r--src/fpm_environment.f9030
-rw-r--r--src/fpm_filesystem.F9097
-rw-r--r--src/fpm_targets.f907
-rw-r--r--src/ptycheck/LICENSE22
-rw-r--r--src/ptycheck/isatty.c33
-rw-r--r--src/ptycheck/iscygpty.c185
-rw-r--r--src/ptycheck/iscygpty.h41
-rw-r--r--test/new_test/new_test.f904
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..014e800
--- /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 !+ 1 !+ 1
+
+ ! Step back to line
+ write(stdout,'(A)',advance="no") repeat(LINE_UP,n)//LINE_RESET
+
+ write(stdout,*) 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 83cffe7..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
+ public :: which, run, LINE_BUFFER_LEN
integer, parameter :: LINE_BUFFER_LEN = 1000
@@ -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
@@ -834,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/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(:)
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-23 08:17:28 +0000