From 6ea34933fbb991df706d613718acfefee538efdc Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Mon, 22 Nov 2021 16:12:14 +0000 Subject: Update: fpm_compiler objects with verbose field --- src/fpm_compiler.f90 | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) (limited to 'src/fpm_compiler.f90') diff --git a/src/fpm_compiler.f90 b/src/fpm_compiler.f90 index c0c5b73..e83d7a4 100644 --- a/src/fpm_compiler.f90 +++ b/src/fpm_compiler.f90 @@ -79,6 +79,8 @@ type :: compiler_t character(len=:), allocatable :: cc !> Print all commands logical :: echo = .true. + !> Verbose output of command + logical :: verbose = .true. contains !> Get default compiler flags procedure :: get_default_flags @@ -107,6 +109,8 @@ type :: archiver_t logical :: use_response_file = .false. !> Print all command logical :: echo = .true. + !> Verbose output of command + logical :: verbose = .true. contains !> Create static archive procedure :: make_archive @@ -695,7 +699,7 @@ subroutine compile_fortran(self, input, output, args, stat) integer, intent(out) :: stat call run(self%fc // " -c " // input // " " // args // " -o " // output, & - & echo=self%echo, exitstat=stat) + & echo=self%echo, verbose=self%verbose, exitstat=stat) end subroutine compile_fortran @@ -713,7 +717,7 @@ subroutine compile_c(self, input, output, args, stat) integer, intent(out) :: stat call run(self%cc // " -c " // input // " " // args // " -o " // output, & - & echo=self%echo, exitstat=stat) + & echo=self%echo, verbose=self%verbose, exitstat=stat) end subroutine compile_c @@ -728,7 +732,8 @@ subroutine link(self, output, args, stat) !> Status flag integer, intent(out) :: stat - call run(self%fc // " " // args // " -o " // output, echo=self%echo, exitstat=stat) + call run(self%fc // " " // args // " -o " // output, echo=self%echo, & + & verbose=self%verbose, exitstat=stat) end subroutine link @@ -745,11 +750,12 @@ subroutine make_archive(self, output, args, stat) if (self%use_response_file) then call write_response_file(output//".resp" , args) - call run(self%ar // output // " @" // output//".resp", echo=self%echo, exitstat=stat) + call run(self%ar // output // " @" // output//".resp", echo=self%echo, & + & verbose=self%verbose, exitstat=stat) call delete_file(output//".resp") else call run(self%ar // output // " " // string_cat(args, " "), & - & echo=self%echo, exitstat=stat) + & echo=self%echo, verbose=self%verbose, exitstat=stat) end if end subroutine make_archive -- cgit v1.2.3 From ab7cb42fddc3cf19fe20c76dac527a9e591b11c2 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Thu, 25 Nov 2021 15:53:29 +0000 Subject: Update: fpm_compiler & backend to redirect output to log files --- src/fpm_compiler.f90 | 26 +++++++++++++++++--------- 1 file changed, 17 insertions(+), 9 deletions(-) (limited to 'src/fpm_compiler.f90') diff --git a/src/fpm_compiler.f90 b/src/fpm_compiler.f90 index e83d7a4..dba21b2 100644 --- a/src/fpm_compiler.f90 +++ b/src/fpm_compiler.f90 @@ -686,7 +686,7 @@ end subroutine new_archiver !> Compile a Fortran object -subroutine compile_fortran(self, input, output, args, stat) +subroutine compile_fortran(self, input, output, args, log_file, stat) !> Instance of the compiler object class(compiler_t), intent(in) :: self !> Source file input @@ -695,16 +695,18 @@ subroutine compile_fortran(self, input, output, args, stat) character(len=*), intent(in) :: output !> Arguments for compiler character(len=*), intent(in) :: args + !> Compiler output log file + character(len=*), intent(in) :: log_file !> Status flag integer, intent(out) :: stat call run(self%fc // " -c " // input // " " // args // " -o " // output, & - & echo=self%echo, verbose=self%verbose, exitstat=stat) + & echo=self%echo, verbose=self%verbose, redirect=log_file, exitstat=stat) end subroutine compile_fortran !> Compile a C object -subroutine compile_c(self, input, output, args, stat) +subroutine compile_c(self, input, output, args, log_file, stat) !> Instance of the compiler object class(compiler_t), intent(in) :: self !> Source file input @@ -713,49 +715,55 @@ subroutine compile_c(self, input, output, args, stat) character(len=*), intent(in) :: output !> Arguments for compiler character(len=*), intent(in) :: args + !> Compiler output log file + character(len=*), intent(in) :: log_file !> Status flag integer, intent(out) :: stat call run(self%cc // " -c " // input // " " // args // " -o " // output, & - & echo=self%echo, verbose=self%verbose, exitstat=stat) + & echo=self%echo, verbose=self%verbose, redirect=log_file, exitstat=stat) end subroutine compile_c !> Link an executable -subroutine link(self, output, args, stat) +subroutine link(self, output, args, log_file, stat) !> Instance of the compiler object class(compiler_t), intent(in) :: self !> Output file of object character(len=*), intent(in) :: output !> Arguments for compiler character(len=*), intent(in) :: args + !> Compiler output log file + character(len=*), intent(in) :: log_file !> Status flag integer, intent(out) :: stat call run(self%fc // " " // args // " -o " // output, echo=self%echo, & - & verbose=self%verbose, exitstat=stat) + & verbose=self%verbose, redirect=log_file, exitstat=stat) end subroutine link !> Create an archive -subroutine make_archive(self, output, args, stat) +subroutine make_archive(self, output, args, log_file, stat) !> Instance of the archiver object class(archiver_t), intent(in) :: self !> Name of the archive to generate character(len=*), intent(in) :: output !> Object files to include into the archive type(string_t), intent(in) :: args(:) + !> Compiler output log file + character(len=*), intent(in) :: log_file !> Status flag integer, intent(out) :: stat if (self%use_response_file) then call write_response_file(output//".resp" , args) call run(self%ar // output // " @" // output//".resp", echo=self%echo, & - & verbose=self%verbose, exitstat=stat) + & verbose=self%verbose, redirect=log_file, exitstat=stat) call delete_file(output//".resp") else call run(self%ar // output // " " // string_cat(args, " "), & - & echo=self%echo, verbose=self%verbose, exitstat=stat) + & echo=self%echo, verbose=self%verbose, redirect=log_file, exitstat=stat) end if end subroutine make_archive -- cgit v1.2.3 From 4556e7a4435c6ef2da8782c033229e06e91b6a4e Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sun, 28 Nov 2021 11:11:11 +0000 Subject: Apply suggestion: move echo/verbosity into constructors For compiler_t and archive_t objects --- src/fpm_compiler.f90 | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) (limited to 'src/fpm_compiler.f90') diff --git a/src/fpm_compiler.f90 b/src/fpm_compiler.f90 index dba21b2..2f939ad 100644 --- a/src/fpm_compiler.f90 +++ b/src/fpm_compiler.f90 @@ -623,16 +623,22 @@ end function enumerate_libraries !> Create new compiler instance -subroutine new_compiler(self, fc, cc) +subroutine new_compiler(self, fc, cc, echo, verbose) !> New instance of the compiler type(compiler_t), intent(out) :: self !> Fortran compiler name or path character(len=*), intent(in) :: fc !> C compiler name or path character(len=*), intent(in) :: cc + !> Echo compiler command + logical, intent(in) :: echo + !> Verbose mode: dump compiler output + logical, intent(in) :: verbose self%id = get_compiler_id(fc) - + + self%echo = echo + self%verbose = verbose self%fc = fc if (len_trim(cc) > 0) then self%cc = cc @@ -643,11 +649,15 @@ end subroutine new_compiler !> Create new archiver instance -subroutine new_archiver(self, ar) +subroutine new_archiver(self, ar, echo, verbose) !> New instance of the archiver type(archiver_t), intent(out) :: self !> User provided archiver command character(len=*), intent(in) :: ar + !> Echo compiler command + logical, intent(in) :: echo + !> Verbose mode: dump compiler output + logical, intent(in) :: verbose integer :: estat, os_type @@ -681,7 +691,8 @@ subroutine new_archiver(self, ar) end if end if self%use_response_file = os_type == OS_WINDOWS - self%echo = .true. + self%echo = echo + self%verbose = verbose end subroutine new_archiver -- cgit v1.2.3 From 0c561b0f76bc6fa7777dec884a16b76694913adf Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Sun, 28 Nov 2021 11:55:50 +0000 Subject: Apply suggestion: move run to filesystem and use getline fpm_environment::run is moved to fpm_filesystem so that it can use the getline function to retrieve redirected output from file --- src/fpm_compiler.f90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'src/fpm_compiler.f90') diff --git a/src/fpm_compiler.f90 b/src/fpm_compiler.f90 index 2f939ad..1c086cc 100644 --- a/src/fpm_compiler.f90 +++ b/src/fpm_compiler.f90 @@ -27,7 +27,6 @@ ! Unisys ? ? ? ? ? discontinued module fpm_compiler use fpm_environment, only: & - run, & get_env, & get_os_type, & OS_LINUX, & @@ -39,7 +38,7 @@ use fpm_environment, only: & OS_OPENBSD, & OS_UNKNOWN use fpm_filesystem, only: join_path, basename, get_temp_filename, delete_file, unix_path, & - & getline + & getline, run use fpm_strings, only: string_cat, string_t implicit none public :: compiler_t, new_compiler, archiver_t, new_archiver -- cgit v1.2.3