functionality to check whether STDERR/STDOUT are redirected

This commit is contained in:
Martin Diehl 2023-12-09 15:17:52 +01:00
parent 5d07851d60
commit 456b3fb76d
2 changed files with 48 additions and 2 deletions

View File

@ -85,6 +85,16 @@ void inflate_c(const uLong *s_deflated, const uLong *s_inflated, const Byte defl
} }
} }
int stdout_isatty_c(){
return isatty(STDOUT_FILENO);
}
int stderr_isatty_c(){
return isatty(STDERR_FILENO);
}
#ifdef FYAML #ifdef FYAML
void to_flow_c(char **flow, long* length_flow, const char *mixed){ void to_flow_c(char **flow, long* length_flow, const char *mixed){
struct fy_document *fyd = NULL; struct fy_document *fyd = NULL;

View File

@ -4,9 +4,9 @@
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module system_routines module system_routines
use, intrinsic :: ISO_C_Binding use, intrinsic :: ISO_C_Binding
use, intrinsic :: ISO_fortran_env
use prec use prec
use IO
implicit none(type,external) implicit none(type,external)
private private
@ -21,6 +21,8 @@ module system_routines
signalint_C, & signalint_C, &
signalusr1_C, & signalusr1_C, &
signalusr2_C, & signalusr2_C, &
STDOUT_isatty, &
STDERR_isatty, &
f_c_string, & f_c_string, &
free_C free_C
@ -91,6 +93,20 @@ module system_routines
type(C_PTR), value :: ptr type(C_PTR), value :: ptr
end subroutine free_C end subroutine free_C
function stdout_isatty_C() bind(C)
use, intrinsic :: ISO_C_Binding, only: C_INT
implicit none(type,external)
integer(C_INT) :: stdout_isatty_C
end function stdout_isatty_C
function stderr_isatty_C() bind(C)
use, intrinsic :: ISO_C_Binding, only: C_INT
implicit none(type,external)
integer(C_INT) :: stderr_isatty_C
end function stderr_isatty_C
end interface end interface
contains contains
@ -101,7 +117,7 @@ contains
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine system_routines_init() subroutine system_routines_init()
print'(/,1x,a)', '<<<+- system_routines init -+>>>'; flush(IO_STDOUT) print'(/,1x,a)', '<<<+- system_routines init -+>>>'; flush(OUTPUT_UNIT)
call system_routines_selfTest() call system_routines_selfTest()
@ -229,6 +245,26 @@ pure function f_c_string(f_string) result(c_string)
end function f_c_string end function f_c_string
!--------------------------------------------------------------------------------------------------
!> @brief
!--------------------------------------------------------------------------------------------------
logical function STDOUT_isatty()
STDOUT_isatty = merge(.true.,.false.,stdout_isatty_C()==1)
end function STDOUT_isatty
!--------------------------------------------------------------------------------------------------
!> @brief
!--------------------------------------------------------------------------------------------------
logical function STDERR_isatty()
STDERR_isatty = merge(.true.,.false.,stderr_isatty_C()==1)
end function STDERR_isatty
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Check correctness of some system_routine functions. !> @brief Check correctness of some system_routine functions.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------