From bde8ce89308c9ca20c0b5a854406314f84d3dd89 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sun, 29 Nov 2020 18:29:17 +0100 Subject: [PATCH 01/13] level_logger: addition of levels --- src/stdlib_logger.f90 | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index 979aeed29..4904682f4 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -68,6 +68,15 @@ module stdlib_logger unopened_in_error = 7, & write_failure = 8 + integer, parameter, public :: & + stdlib_debug_level = 10, & + stdlib_information_level = 20, & + stdlib_warning_level = 30, & + stdlib_error_level = 40, & + stdlib_io_error_level = 40, & + stdlib_text_error_level = 40 + + character(*), parameter :: module_name = 'stdlib_logger' type :: logger_type @@ -78,6 +87,7 @@ module stdlib_logger logical :: add_blank_line = .false. logical :: indent_lines = .true. + integer :: level = stdlib_information_level integer, allocatable :: log_units(:) integer :: max_width = 0 logical :: time_stamp = .true. @@ -806,6 +816,8 @@ subroutine log_debug( self, message, module, procedure ) !! The name of the procedure contining the current invocation of !! `log_information` + if ( self % level > stdlib_debug_level) return + call self % log_message( message, & module = module, & procedure = procedure, & @@ -877,6 +889,8 @@ subroutine log_error( self, message, module, procedure, stat, errmsg ) character(*), parameter :: procedure_name = 'log_error' character(:), allocatable :: suffix + if ( self % level > stdlib_error_level) return + if ( present(stat) ) then write( dummy, '(a, i0)', err=999, iostat=iostat, iomsg=iomsg ) & new_line('a') // "With stat = ", stat @@ -957,6 +971,8 @@ subroutine log_information( self, message, module, procedure ) !! The name of the procedure contining the current invocation of !! `log_information` + if ( self % level > stdlib_information_level) return + call self % log_message( message, & module = module, & procedure = procedure, & @@ -1019,6 +1035,8 @@ subroutine log_io_error( self, message, module, procedure, iostat, & character(*), parameter :: procedure_name = 'log_io_error' character(:), allocatable :: suffix + if ( self % level > stdlib_io_error_level) return + if ( present(iostat) ) then write( dummy, '(a, i0)', err=999, iostat=iostat2, iomsg=iomsg2 ) & new_line('a') // "With iostat = ", iostat @@ -1237,6 +1255,8 @@ subroutine log_text_error( self, line, column, summary, filename, & character(*), parameter :: procedure_name = 'LOG_TEXT_ERROR' character(len=:), allocatable :: buffer + if ( self % level > stdlib_text_error_level) return + acaret = optval(caret, '^') if ( column < 0 .or. column > len( line ) + 1 ) then From 478fe70c3d79f06337073f773dfcc1120d7956e6 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sun, 29 Nov 2020 18:41:55 +0100 Subject: [PATCH 02/13] level_logger: addition of conditions --- src/stdlib_logger.f90 | 32 +++++++++++++++++++++++--------- 1 file changed, 23 insertions(+), 9 deletions(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index 4904682f4..22e8f9626 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -69,13 +69,20 @@ module stdlib_logger write_failure = 8 integer, parameter, public :: & + stdlib_all_level = 0, & stdlib_debug_level = 10, & stdlib_information_level = 20, & stdlib_warning_level = 30, & stdlib_error_level = 40, & stdlib_io_error_level = 40, & - stdlib_text_error_level = 40 - + stdlib_text_error_level = 40, & + stdlib_none_level = 10 + max( & + stdlib_debug_level, & + stdlib_information_level, & + stdlib_warning_level, & + stdlib_error_level, & + stdlib_io_error_level, & + stdlib_text_error_level) character(*), parameter :: module_name = 'stdlib_logger' @@ -389,7 +396,7 @@ end subroutine validate_unit end subroutine add_log_unit - pure subroutine configuration( self, add_blank_line, indent, & + pure subroutine configuration( self, add_blank_line, indent, level, & max_width, time_stamp, log_units ) !! version: experimental @@ -399,12 +406,13 @@ pure subroutine configuration( self, add_blank_line, indent, & !! starts with a blank line, and `.false.` implying no blank line. !! 2. `indent` is a logical flag with `.true.` implying that subsequent columns !! will be indented 4 spaces and `.false.` implying no indentation. -!! 3. `max_width` is the maximum number of columns of output text with +!! 3. `level` is the lowest level for printing a message +!! 4. `max_width` is the maximum number of columns of output text with !! `max_width` == 0 => no bounds on output width. -!! 4. `time_stamp` is a logical flag with `.true.` implying that the output +!! 5. `time_stamp` is a logical flag with `.true.` implying that the output !! will have a time stamp, and `.false.` implying that there will be no !! time stamp. -!! 5. `log_units` is an array of the I/O unit numbers to which log output +!! 6. `log_units` is an array of the I/O unit numbers to which log output !! will be written. !!([Specification](../page/specs/stdlib_logger.html#configuration-report-a-loggers-configuration)) @@ -414,6 +422,8 @@ pure subroutine configuration( self, add_blank_line, indent, & !! A logical flag to add a preceding blank line logical, intent(out), optional :: indent !! A logical flag to indent subsequent lines + integer, intent(out), optional :: level +!! The mimimum level for printing a message integer, intent(out), optional :: max_width !! The maximum number of columns for most outputs logical, intent(out), optional :: time_stamp @@ -444,6 +454,7 @@ pure subroutine configuration( self, add_blank_line, indent, & if ( present(add_blank_line) ) add_blank_line = self % add_blank_line if ( present(indent) ) indent = self % indent_lines + if ( present(level) ) level = self % level if ( present(max_width) ) max_width = self % max_width if ( present(time_stamp) ) time_stamp = self % time_stamp if ( present(log_units) .and. self % units .gt. 0 ) then @@ -455,7 +466,7 @@ pure subroutine configuration( self, add_blank_line, indent, & end subroutine configuration - pure subroutine configure( self, add_blank_line, indent, max_width, & + pure subroutine configure( self, add_blank_line, indent, level, max_width, & time_stamp ) !! version: experimental @@ -467,10 +478,11 @@ pure subroutine configure( self, add_blank_line, indent, max_width, & !! 2. `indent` is a logical flag with `.true.` implying that subsequent lines !! will be indented 4 spaces and `.false.` implying no indentation. `indent` !! has a startup value of `.true.`. -!! 3. `max_width` is the maximum number of columns of output text with +!! 3. `level` is the lowest level for printing a message +!! 4. `max_width` is the maximum number of columns of output text with !! `max_width == 0` => no bounds on output width. `max_width` has a startup !! value of 0. -!! 4. `time_stamp` is a logical flag with `.true.` implying that the output +!! 5. `time_stamp` is a logical flag with `.true.` implying that the output !! will have a time stamp, and `.false.` implying that there will be no !! time stamp. `time_stamp` has a startup value of `.true.`. !!([Specification](../page/specs/stdlib_logger.html#configure-configure-the-logging-process)) @@ -485,10 +497,12 @@ pure subroutine configure( self, add_blank_line, indent, max_width, & class(logger_type), intent(inout) :: self logical, intent(in), optional :: add_blank_line logical, intent(in), optional :: indent + integer, intent(in), optional :: level integer, intent(in), optional :: max_width logical, intent(in), optional :: time_stamp if ( present(add_blank_line) ) self % add_blank_line = add_blank_line + if ( present(level) ) self % level = level if ( present(indent) ) self % indent_lines = indent if ( present(max_width) ) then if ( max_width <= 4 ) then From a220e5b17e9e347dfc3467c1e6a9137f1f56813f Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sun, 29 Nov 2020 19:03:46 +0100 Subject: [PATCH 03/13] level_logger: progress --- src/tests/logger/test_stdlib_logger.f90 | 32 ++++++++++++++++++++++++- 1 file changed, 31 insertions(+), 1 deletion(-) diff --git a/src/tests/logger/test_stdlib_logger.f90 b/src/tests/logger/test_stdlib_logger.f90 index 8a9e1d959..98ee3e0fb 100644 --- a/src/tests/logger/test_stdlib_logger.f90 +++ b/src/tests/logger/test_stdlib_logger.f90 @@ -12,7 +12,7 @@ program test_stdlib_logger implicit none integer, allocatable :: log_units(:) - integer :: max_width, stat + integer :: level, max_width, stat integer :: unit1, unit2, unit3, unit4, unit5, unit6 logical :: add_blank_line, exist, indent, time_stamp @@ -71,6 +71,7 @@ program test_stdlib_logger caret = '^', & stat = stat ) + call test_level() contains @@ -649,4 +650,33 @@ subroutine test_adding_log_units() return end subroutine test_adding_log_units + subroutine test_level() + + print *, 'running test_level' + + call global % configure( level = stdlib_none_level ) + + call global % configuration( level = level ) + + if ( level == stdlib_none_level ) then + write(*,*) 'LEVEL is none as expected.' + + else + error stop 'LEVEL starts off as not equal to none contrary ' // & + 'to expectations.' + + end if + + call global % log_message('log_message printed') + + call global % log_debug( 'This message should not be printed') + call global % log_information( 'This message should not be printed') + call global % log_error( 'This message should not be printed') + call global % log_io_error( 'This message should not be printed') + + + + + end subroutine test_level + end program test_stdlib_logger From ba71ac84aa00d420d41c09b7a0f9664d0a449df3 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sun, 29 Nov 2020 19:38:11 +0100 Subject: [PATCH 04/13] logger_level:addition of tests --- src/tests/logger/test_stdlib_logger.f90 | 135 ++++++++++++++++++++++-- 1 file changed, 126 insertions(+), 9 deletions(-) diff --git a/src/tests/logger/test_stdlib_logger.f90 b/src/tests/logger/test_stdlib_logger.f90 index 98ee3e0fb..050e9ba13 100644 --- a/src/tests/logger/test_stdlib_logger.f90 +++ b/src/tests/logger/test_stdlib_logger.f90 @@ -654,27 +654,144 @@ subroutine test_level() print *, 'running test_level' - call global % configure( level = stdlib_none_level ) - call global % configuration( level = level ) + call global % configure( level = stdlib_all_level ) + + call global % configuration( level = level) + if ( level == stdlib_all_level ) then + write(*,*) 'LEVEL is stdlib_all_level as expected.' + + else + error stop 'LEVEL starts off as not equal to stdlib_all_level ' //& + 'contrary to expectations.' + + end if + + call global % log_message('log_message printed') + + call global % log_debug( 'This message should be printed') + call global % log_information( 'This message should be printed') + call global % log_warning( 'This message should be printed') + call global % log_error( 'This message should be printed') + call global % log_io_error( 'This message should be printed') + + + + + call global % configure( level = stdlib_debug_level ) + + call global % configuration( level = level) + if ( level == stdlib_debug_level ) then + write(*,*) 'LEVEL is stdlib_debug_level as expected.' + + else + error stop 'LEVEL starts off as not equal to stdlib_debug_level ' //& + 'contrary to expectations.' + + end if + + call global % log_message('log_message printed') + + call global % log_debug( 'This message should be printed') + call global % log_information( 'This message should be printed') + call global % log_warning( 'This message should be printed') + call global % log_error( 'This message should be printed') + call global % log_io_error( 'This message should be printed') + + + + + call global % configure( level = stdlib_information_level ) + + call global % configuration( level = level) + if ( level == stdlib_information_level ) then + write(*,*) 'LEVEL is stdlib_information_level as expected.' + + else + error stop 'LEVEL starts off as not equal to stdlib_information_level ' //& + 'contrary to expectations.' + + end if + + call global % log_message('log_message printed') + call global % log_debug( 'This message should NOT be printed') + call global % log_information( 'This message should be printed') + call global % log_warning( 'This message should be printed') + call global % log_error( 'This message should be printed') + call global % log_io_error( 'This message should be printed') + + + + + call global % configure( level = stdlib_warning_level ) + + call global % configuration( level = level) + if ( level == stdlib_warning_level ) then + write(*,*) 'LEVEL is stdlib_warning_level as expected.' + + else + error stop 'LEVEL starts off as not equal to stdlib_warning_level ' //& + 'contrary to expectations.' + + end if + + call global % log_message('log_message printed') + + call global % log_debug( 'This message should NOT be printed') + call global % log_information( 'This message should NOT be printed') + call global % log_warning( 'This message should be printed') + call global % log_error( 'This message should be printed') + call global % log_io_error( 'This message should be printed') + + + + + call global % configure( level = stdlib_error_level ) + + call global % configuration( level = level) + if ( level == stdlib_error_level ) then + write(*,*) 'LEVEL is stdlib_error_level as expected.' + + else + error stop 'LEVEL starts off as not equal to stdlib_error_level ' //& + 'contrary to expectations.' + + end if + + call global % log_message('log_message printed') + + call global % log_debug( 'This message should NOT be printed') + call global % log_information( 'This message should NOT be printed') + call global % log_warning( 'This message should NOT be printed') + call global % log_error( 'This message should be printed') + call global % log_io_error( 'This message should be printed') + + + + + call global % configure( level = stdlib_none_level ) + + call global % configuration( level = level) if ( level == stdlib_none_level ) then - write(*,*) 'LEVEL is none as expected.' + write(*,*) 'LEVEL is stdlib_none_level as expected.' else - error stop 'LEVEL starts off as not equal to none contrary ' // & - 'to expectations.' + error stop 'LEVEL starts off as not equal to stdlib_none_level ' //& + 'contrary to expectations.' end if call global % log_message('log_message printed') - call global % log_debug( 'This message should not be printed') - call global % log_information( 'This message should not be printed') - call global % log_error( 'This message should not be printed') - call global % log_io_error( 'This message should not be printed') + call global % log_debug( 'This message should NOT be printed') + call global % log_information( 'This message should NOT be printed') + call global % log_warning( 'This message should NOT be printed') + call global % log_error( 'This message should be NOT printed') + call global % log_io_error( 'This message should NOT be printed') + print *, 'end of test_level' end subroutine test_level From 25c1226d866fef585142e37be8bad41cb35e3afb Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sun, 29 Nov 2020 19:39:58 +0100 Subject: [PATCH 05/13] logger_level: modify definition of stdlib_all_level --- src/stdlib_logger.f90 | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index adb4c2eb6..50f24a222 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -69,13 +69,19 @@ module stdlib_logger write_failure = 8 integer, parameter, public :: & - stdlib_all_level = 0, & stdlib_debug_level = 10, & stdlib_information_level = 20, & stdlib_warning_level = 30, & stdlib_error_level = 40, & stdlib_io_error_level = 40, & stdlib_text_error_level = 40, & + stdlib_all_level = -10 + min( & + stdlib_debug_level, & + stdlib_information_level, & + stdlib_warning_level, & + stdlib_error_level, & + stdlib_io_error_level, & + stdlib_text_error_level), & stdlib_none_level = 10 + max( & stdlib_debug_level, & stdlib_information_level, & From 323870fdfe6a53e2622c5450a0cd271772eb12f4 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Fri, 4 Dec 2020 20:24:38 +0100 Subject: [PATCH 06/13] level_logger: changes following #254 --- src/stdlib_logger.f90 | 52 ++++++++++++------------- src/tests/logger/test_stdlib_logger.f90 | 32 ++++----------- 2 files changed, 33 insertions(+), 51 deletions(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index 50f24a222..17551690c 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -69,26 +69,26 @@ module stdlib_logger write_failure = 8 integer, parameter, public :: & - stdlib_debug_level = 10, & - stdlib_information_level = 20, & - stdlib_warning_level = 30, & - stdlib_error_level = 40, & - stdlib_io_error_level = 40, & - stdlib_text_error_level = 40, & - stdlib_all_level = -10 + min( & - stdlib_debug_level, & - stdlib_information_level, & - stdlib_warning_level, & - stdlib_error_level, & - stdlib_io_error_level, & - stdlib_text_error_level), & - stdlib_none_level = 10 + max( & - stdlib_debug_level, & - stdlib_information_level, & - stdlib_warning_level, & - stdlib_error_level, & - stdlib_io_error_level, & - stdlib_text_error_level) + debug_level = 10, & + information_level = 20, & + warning_level = 30, & + error_level = 40, & + io_error_level = 40, & + text_error_level = 40, & + all_level = -10 + min( & + debug_level, & + information_level, & + warning_level, & + error_level, & + io_error_level, & + text_error_level), & + none_level = 10 + max( & + debug_level, & + information_level, & + warning_level, & + error_level, & + io_error_level, & + text_error_level) character(*), parameter :: module_name = 'stdlib_logger' @@ -100,7 +100,7 @@ module stdlib_logger logical :: add_blank_line = .false. logical :: indent_lines = .true. - integer :: level = stdlib_information_level + integer :: level = information_level integer, allocatable :: log_units(:) integer :: max_width = 0 logical :: time_stamp = .true. @@ -838,7 +838,7 @@ subroutine log_debug( self, message, module, procedure ) !! The name of the procedure contining the current invocation of !! `log_information` - if ( self % level > stdlib_debug_level) return + if ( self % level > debug_level ) return call self % log_message( message, & module = module, & @@ -911,7 +911,7 @@ subroutine log_error( self, message, module, procedure, stat, errmsg ) character(*), parameter :: procedure_name = 'log_error' character(:), allocatable :: suffix - if ( self % level > stdlib_error_level) return + if ( self % level > error_level ) return if ( present(stat) ) then write( dummy, '(a, i0)', err=999, iostat=iostat, iomsg=iomsg ) & @@ -993,7 +993,7 @@ subroutine log_information( self, message, module, procedure ) !! The name of the procedure contining the current invocation of !! `log_information` - if ( self % level > stdlib_information_level) return + if ( self % level > information_level ) return call self % log_message( message, & module = module, & @@ -1057,7 +1057,7 @@ subroutine log_io_error( self, message, module, procedure, iostat, & character(*), parameter :: procedure_name = 'log_io_error' character(:), allocatable :: suffix - if ( self % level > stdlib_io_error_level) return + if ( self % level > io_error_level ) return if ( present(iostat) ) then write( dummy, '(a, i0)', err=999, iostat=iostat2, iomsg=iomsg2 ) & @@ -1277,7 +1277,7 @@ subroutine log_text_error( self, line, column, summary, filename, & character(*), parameter :: procedure_name = 'LOG_TEXT_ERROR' character(len=:), allocatable :: buffer - if ( self % level > stdlib_text_error_level) return + if ( self % level > text_error_level ) return acaret = optval(caret, '^') diff --git a/src/tests/logger/test_stdlib_logger.f90 b/src/tests/logger/test_stdlib_logger.f90 index 050e9ba13..b36a42188 100644 --- a/src/tests/logger/test_stdlib_logger.f90 +++ b/src/tests/logger/test_stdlib_logger.f90 @@ -654,10 +654,9 @@ subroutine test_level() print *, 'running test_level' - call global % configure( level = stdlib_all_level ) - call global % configuration( level = level) + call global % configuration( level = level ) if ( level == stdlib_all_level ) then write(*,*) 'LEVEL is stdlib_all_level as expected.' @@ -675,12 +674,9 @@ subroutine test_level() call global % log_error( 'This message should be printed') call global % log_io_error( 'This message should be printed') - - - call global % configure( level = stdlib_debug_level ) - call global % configuration( level = level) + call global % configuration( level = level ) if ( level == stdlib_debug_level ) then write(*,*) 'LEVEL is stdlib_debug_level as expected.' @@ -698,12 +694,9 @@ subroutine test_level() call global % log_error( 'This message should be printed') call global % log_io_error( 'This message should be printed') - - - call global % configure( level = stdlib_information_level ) - call global % configuration( level = level) + call global % configuration( level = level ) if ( level == stdlib_information_level ) then write(*,*) 'LEVEL is stdlib_information_level as expected.' @@ -721,12 +714,9 @@ subroutine test_level() call global % log_error( 'This message should be printed') call global % log_io_error( 'This message should be printed') - - - call global % configure( level = stdlib_warning_level ) - call global % configuration( level = level) + call global % configuration( level = level ) if ( level == stdlib_warning_level ) then write(*,*) 'LEVEL is stdlib_warning_level as expected.' @@ -744,12 +734,9 @@ subroutine test_level() call global % log_error( 'This message should be printed') call global % log_io_error( 'This message should be printed') - - - call global % configure( level = stdlib_error_level ) - call global % configuration( level = level) + call global % configuration( level = level ) if ( level == stdlib_error_level ) then write(*,*) 'LEVEL is stdlib_error_level as expected.' @@ -767,12 +754,9 @@ subroutine test_level() call global % log_error( 'This message should be printed') call global % log_io_error( 'This message should be printed') - - - call global % configure( level = stdlib_none_level ) - call global % configuration( level = level) + call global % configuration( level = level ) if ( level == stdlib_none_level ) then write(*,*) 'LEVEL is stdlib_none_level as expected.' @@ -787,13 +771,11 @@ subroutine test_level() call global % log_debug( 'This message should NOT be printed') call global % log_information( 'This message should NOT be printed') call global % log_warning( 'This message should NOT be printed') - call global % log_error( 'This message should be NOT printed') + call global % log_error( 'This message should NOT be printed') call global % log_io_error( 'This message should NOT be printed') - print *, 'end of test_level' - end subroutine test_level end program test_stdlib_logger From 8f77748952f7f12eb1d88bc616d70e58b1c30fdc Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Fri, 4 Dec 2020 20:38:25 +0100 Subject: [PATCH 07/13] level_logger: correction --- src/tests/logger/test_stdlib_logger.f90 | 48 ++++++++++++------------- 1 file changed, 24 insertions(+), 24 deletions(-) diff --git a/src/tests/logger/test_stdlib_logger.f90 b/src/tests/logger/test_stdlib_logger.f90 index b36a42188..10d45d8b2 100644 --- a/src/tests/logger/test_stdlib_logger.f90 +++ b/src/tests/logger/test_stdlib_logger.f90 @@ -654,14 +654,14 @@ subroutine test_level() print *, 'running test_level' - call global % configure( level = stdlib_all_level ) + call global % configure( level = all_level ) call global % configuration( level = level ) - if ( level == stdlib_all_level ) then - write(*,*) 'LEVEL is stdlib_all_level as expected.' + if ( level == all_level ) then + write(*,*) 'LEVEL is all_level as expected.' else - error stop 'LEVEL starts off as not equal to stdlib_all_level ' //& + error stop 'LEVEL starts off as not equal to all_level ' //& 'contrary to expectations.' end if @@ -674,14 +674,14 @@ subroutine test_level() call global % log_error( 'This message should be printed') call global % log_io_error( 'This message should be printed') - call global % configure( level = stdlib_debug_level ) + call global % configure( level = debug_level ) call global % configuration( level = level ) - if ( level == stdlib_debug_level ) then - write(*,*) 'LEVEL is stdlib_debug_level as expected.' + if ( level == debug_level ) then + write(*,*) 'LEVEL is debug_level as expected.' else - error stop 'LEVEL starts off as not equal to stdlib_debug_level ' //& + error stop 'LEVEL starts off as not equal to debug_level ' //& 'contrary to expectations.' end if @@ -694,14 +694,14 @@ subroutine test_level() call global % log_error( 'This message should be printed') call global % log_io_error( 'This message should be printed') - call global % configure( level = stdlib_information_level ) + call global % configure( level = information_level ) call global % configuration( level = level ) - if ( level == stdlib_information_level ) then - write(*,*) 'LEVEL is stdlib_information_level as expected.' + if ( level == information_level ) then + write(*,*) 'LEVEL is information_level as expected.' else - error stop 'LEVEL starts off as not equal to stdlib_information_level ' //& + error stop 'LEVEL starts off as not equal to information_level ' //& 'contrary to expectations.' end if @@ -714,14 +714,14 @@ subroutine test_level() call global % log_error( 'This message should be printed') call global % log_io_error( 'This message should be printed') - call global % configure( level = stdlib_warning_level ) + call global % configure( level = warning_level ) call global % configuration( level = level ) - if ( level == stdlib_warning_level ) then - write(*,*) 'LEVEL is stdlib_warning_level as expected.' + if ( level == warning_level ) then + write(*,*) 'LEVEL is warning_level as expected.' else - error stop 'LEVEL starts off as not equal to stdlib_warning_level ' //& + error stop 'LEVEL starts off as not equal to warning_level ' //& 'contrary to expectations.' end if @@ -734,14 +734,14 @@ subroutine test_level() call global % log_error( 'This message should be printed') call global % log_io_error( 'This message should be printed') - call global % configure( level = stdlib_error_level ) + call global % configure( level = error_level ) call global % configuration( level = level ) - if ( level == stdlib_error_level ) then - write(*,*) 'LEVEL is stdlib_error_level as expected.' + if ( level == error_level ) then + write(*,*) 'LEVEL is error_level as expected.' else - error stop 'LEVEL starts off as not equal to stdlib_error_level ' //& + error stop 'LEVEL starts off as not equal to error_level ' //& 'contrary to expectations.' end if @@ -754,14 +754,14 @@ subroutine test_level() call global % log_error( 'This message should be printed') call global % log_io_error( 'This message should be printed') - call global % configure( level = stdlib_none_level ) + call global % configure( level = none_level ) call global % configuration( level = level ) - if ( level == stdlib_none_level ) then - write(*,*) 'LEVEL is stdlib_none_level as expected.' + if ( level == none_level ) then + write(*,*) 'LEVEL is none_level as expected.' else - error stop 'LEVEL starts off as not equal to stdlib_none_level ' //& + error stop 'LEVEL starts off as not equal to none_level ' //& 'contrary to expectations.' end if From c3d6c8b747e48242fea58b08dfc173a0ece2c0f8 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Wed, 9 Dec 2020 11:08:53 +0100 Subject: [PATCH 08/13] level_logger: update specs --- doc/specs/stdlib_logger.md | 67 ++++++++++++++++++++++++++++---------- 1 file changed, 50 insertions(+), 17 deletions(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 9677b48ad..73b8b2c8a 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -8,19 +8,20 @@ title: logger ## Introduction This module defines a derived type, its methods, a variable, and -constants to be used for the reporting of errors and other -information. The derived type, `logger_type`, is to be used to define -both global and local logger variables. The `logger_type` methods serve -to configure the loggers and use the logger variables to report -messages to a variable specific list of I/O units termed -`log_units`. The variable, `global_logger`, of type `logger_type`, is -intended to serve as the default global logger. The constants serve as +constants to be used for the reporting of errors, for filtering the +log messages, and other information. The derived type, `logger_type`, +is to be used to define both global and local logger variables. The +`logger_type` methods serve to configure the loggers and use the logger +variables to report messages to a variable specific list of I/O units +termed `log_units`. The variable, `global_logger`, of type `logger_type`, +is intended to serve as the default global logger. The constants serve as error flags returned by the optional integer `stat` argument. The logger variables have the option to: * change which units receive the log messages; * report which units receive the log messages; +* change the level for filtering the log messages; * precede messages by a blank line; * precede messages by a time stamp of the form `yyyy-mm-dd hh:mm:ss.sss`; @@ -64,6 +65,17 @@ Error Code | Description `unopened_in_error` | the unit was not opened `write_fault` | one of the writes to `log_units` failed +The module also defines eight distinct public integer constants for +filtering the log messages. These constants, termed severity levels, are +(sorted following their increasing order of severity): `all_level`, +`debug_level`, `information_level`, `warning_level`, `error_level`, +`io_error_level`, `text_error_level`, and `none_level`. +All log messages with a level lower than a specified severity level (e.g., +`information_level`) will be ignored. The levels `error_level`, +`io_error_level`, and `text_error_level` have the same severity. +The default severity level is `information_level`. + + ## The derived type: logger_type ### Status @@ -81,14 +93,15 @@ significant events encountered during the execution of a program. ### Private attributes -| Attribute | Type | Description | Initial value | -|------------------|---------------|-------------------------------------------------|--------------| -| `add_blank_line` | Logical | Flag to precede output with a blank line | `.false.` | -| `indent_lines` | Logical | Flag to indent subsequent lines by four columns | `.true.` | -| `log_units` | Integer array | List of I/O units used for output | Unallocated | -| `max_width` | Integer | Maximum column width of output | 0 | -| `time_stamp` | Logical | Flag to precede output by a time stamp | `.true.` | -| `units` | Integer | Count of the number of active output units | 0 | +| Attribute | Type | Description | Initial value | +|------------------|---------------|-------------------------------------------------|---------------------| +| `add_blank_line` | Logical | Flag to precede output with a blank line | `.false.` | +| `indent_lines` | Logical | Flag to indent subsequent lines by four columns | `.true.` | +| `level` | Integer | Severity level | `information_level` | +| `log_units` | Integer array | List of I/O units used for output | Unallocated | +| `max_width` | Integer | Maximum column width of output | 0 | +| `time_stamp` | Logical | Flag to precede output by a time stamp | `.true.` | +| `units` | Integer | Count of the number of active output units | 0 | ## The `stdlib_logger` variable @@ -284,7 +297,7 @@ Reports the configuration of a logger. #### Syntax -`call self % [[logger_type(type):configuration(bound)]]( [ add_blankline, indent, max_width, time_stamp, log_units ] )` +`call self % [[logger_type(type):configuration(bound)]]( [ add_blankline, indent, level, max_width, time_stamp, log_units ] )` #### Class @@ -303,6 +316,10 @@ Pure subroutine is an `intent(out)` argument. A value of `.true.` indents subsequent lines by four spaces, and `.false.` otherwise. +`level` (optional): shall be a scalar default integer variable. It is an + `intent(out)` argument. The value corresponds to the severity level for + ignoring a message. + `max_width` (optional): shall be a scalar default integer variable. It is an `intent(out)` argument. A positive value bigger than four defines the maximum width of the output, otherwise there @@ -355,7 +372,7 @@ Configures the logging process for self. #### Syntax -`call self % [[logger_type(type):configure(bound)]]( [ add_blank_line, indent, max_width, time_stamp ] )` +`call self % [[logger_type(type):configure(bound)]]( [ add_blank_line, indent, level, max_width, time_stamp ] )` #### Class @@ -375,6 +392,10 @@ Pure subroutine indent subsequent lines by four spaces, and to `.false.` to not indent. +`level` (optional): shall be a scalar default integer expression. It is + an `intent(in)` argument. Set the severity level for ignoring a log + message. + `max_width` (optional): shall be a scalar default integer expression. It is an `intent(in)` argument. Set to a positive value bigger than four to define the maximum width of the output, @@ -416,6 +437,8 @@ If time stamps are active, a time stamp is written, followed by `module` and `procedure` if present, and then `message` is written with the prefix `'DEBUG: '`. +It is ignored if the `level` of `self` is higher than `debug_level`. + #### Class Subroutine @@ -486,6 +509,8 @@ followed by `module` and `procedure` if present, then `message` is written with the prefix `'ERROR: '`, and then if `stat` or `errmsg` are present they are written. +It is ignored if the `level` of `self` is higher than `error_level`. + #### Class Subroutine @@ -569,6 +594,8 @@ If time stamps are active, a time stamp is written, followed by `module` and `procedure` if present, and then `message` is written with the prefix `'INFO: '`. +It is ignored if the `level` of `self` is higher than `information_level`. + #### Class Subroutine @@ -637,6 +664,8 @@ written. Then `message` is written with the prefix `'I/O ERROR: '`. Then if `iostat` or `iomsg` are present they are written. +It is ignored if the `level` of `self` is higher than `io_error_level`. + #### Syntax `call self % [[logger_type(type):log_io_error(bound)]]( message [, module, procedure, iostat, iomsg ] )` @@ -714,6 +743,8 @@ If time stamps are active, a time stamp is written, then `module` and `procedure` are written if present, followed by `prefix \\ ': '`, if present, and finally `message`. +No severity level is applied to `log_message`. + #### Syntax `call self % [[logger_type(type):log_message(bound)]]( message [, module, procedure, prefix ] )` @@ -790,6 +821,8 @@ written with `column`. Then `line` is written. Then a caret, '^', is written below `line` at the column indicated by `column`. Then `summary` is written below the caret. +It is ignored if the `level` of `self` is higher than `text_error_level`. + #### Syntax `call self % [[logger_type(type):log_text_error(bound)]]( line, column, summary [, filename, line_number, caret, stat ] )` From 09b1480ebe63e8edb86975167602e94c57467662 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Wed, 9 Dec 2020 11:27:33 +0100 Subject: [PATCH 09/13] level_logger: update test and specs --- doc/specs/stdlib_logger.md | 8 ++++---- src/stdlib_logger.f90 | 2 ++ src/tests/logger/test_stdlib_logger.f90 | 18 ++++++++++++------ 3 files changed, 18 insertions(+), 10 deletions(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 73b8b2c8a..945c1ea18 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -70,10 +70,10 @@ filtering the log messages. These constants, termed severity levels, are (sorted following their increasing order of severity): `all_level`, `debug_level`, `information_level`, `warning_level`, `error_level`, `io_error_level`, `text_error_level`, and `none_level`. -All log messages with a level lower than a specified severity level (e.g., -`information_level`) will be ignored. The levels `error_level`, -`io_error_level`, and `text_error_level` have the same severity. -The default severity level is `information_level`. +All log messages with a level (e.g., `debug_level`) lower than a +specified severity level (e.g., `information_level`) will be ignored. +The levels `error_level`, `io_error_level`, and `text_error_level` +have the same severity. The default severity level is `information_level`. ## The derived type: logger_type diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index 17551690c..d910421f4 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -1472,6 +1472,8 @@ subroutine log_warning( self, message, module, procedure ) character(len=*), intent(in), optional :: procedure !! The name of the procedure contining the current invocation of `log_warning` + if ( self % level > warning_level ) return + call self % log_message( message, & module = module, & procedure = procedure, & diff --git a/src/tests/logger/test_stdlib_logger.f90 b/src/tests/logger/test_stdlib_logger.f90 index b21ee1961..649494819 100644 --- a/src/tests/logger/test_stdlib_logger.f90 +++ b/src/tests/logger/test_stdlib_logger.f90 @@ -722,7 +722,8 @@ subroutine test_level() end if - call global % log_message('log_message printed') + call global % log_message('This message should be always printed, & + & irrespective of the severity level') call global % log_debug( 'This message should be printed') call global % log_information( 'This message should be printed') @@ -742,7 +743,8 @@ subroutine test_level() end if - call global % log_message('log_message printed') + call global % log_message('This message should be always printed, & + & irrespective of the severity level') call global % log_debug( 'This message should be printed') call global % log_information( 'This message should be printed') @@ -762,7 +764,8 @@ subroutine test_level() end if - call global % log_message('log_message printed') + call global % log_message('This message should be always printed, & + & irrespective of the severity level') call global % log_debug( 'This message should NOT be printed') call global % log_information( 'This message should be printed') @@ -782,7 +785,8 @@ subroutine test_level() end if - call global % log_message('log_message printed') + call global % log_message('This message should be always printed, & + & irrespective of the severity level') call global % log_debug( 'This message should NOT be printed') call global % log_information( 'This message should NOT be printed') @@ -802,7 +806,8 @@ subroutine test_level() end if - call global % log_message('log_message printed') + call global % log_message('This message should be always printed, & + & irrespective of the severity level') call global % log_debug( 'This message should NOT be printed') call global % log_information( 'This message should NOT be printed') @@ -822,7 +827,8 @@ subroutine test_level() end if - call global % log_message('log_message printed') + call global % log_message('This message should be always printed, & + & irrespective of the severity level') call global % log_debug( 'This message should NOT be printed') call global % log_information( 'This message should NOT be printed') From 4c9723fad1b2e05766bb0859f738449ff8bddcba Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 12 Dec 2020 19:29:20 +0100 Subject: [PATCH 10/13] Update src/stdlib_logger.f90 --- src/stdlib_logger.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index d910421f4..d41943017 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -429,7 +429,7 @@ pure subroutine configuration( self, add_blank_line, indent, level, & logical, intent(out), optional :: indent !! A logical flag to indent subsequent lines integer, intent(out), optional :: level -!! The mimimum level for printing a message +!! The minimum level for printing a message integer, intent(out), optional :: max_width !! The maximum number of columns for most outputs logical, intent(out), optional :: time_stamp From 6fb16bc1e919c3a7f8b398473c517bca58eefcde Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sun, 13 Dec 2020 19:09:05 +0100 Subject: [PATCH 11/13] level_logger: set text_error_level at 50 (higher level than previously) --- doc/specs/stdlib_logger.md | 4 ++-- src/stdlib_logger.f90 | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 945c1ea18..e949e41fb 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -72,8 +72,8 @@ filtering the log messages. These constants, termed severity levels, are `io_error_level`, `text_error_level`, and `none_level`. All log messages with a level (e.g., `debug_level`) lower than a specified severity level (e.g., `information_level`) will be ignored. -The levels `error_level`, `io_error_level`, and `text_error_level` -have the same severity. The default severity level is `information_level`. +The levels `error_level` and `io_error_level` have the same severity. +The default severity level is `information_level`. ## The derived type: logger_type diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index d41943017..2f9bfd62a 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -74,7 +74,7 @@ module stdlib_logger warning_level = 30, & error_level = 40, & io_error_level = 40, & - text_error_level = 40, & + text_error_level = 50, & all_level = -10 + min( & debug_level, & information_level, & From 8a3f31d2d81fffa0e1f5fad615b90bec9eda231e Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Fri, 18 Dec 2020 12:52:16 +0100 Subject: [PATCH 12/13] level_logger: correction of a typo mentioned by @ivan-pi --- src/stdlib_logger.f90 | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index 2f9bfd62a..70f83b94b 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -833,9 +833,9 @@ subroutine log_debug( self, message, module, procedure ) character(len=*), intent(in) :: message !! A string to be written to log_unit character(len=*), intent(in), optional :: module -!! The name of the module contining the current invocation of `log_information` +!! The name of the module containing the current invocation of `log_information` character(len=*), intent(in), optional :: procedure -!! The name of the procedure contining the current invocation of +!! The name of the procedure containing the current invocation of !! `log_information` if ( self % level > debug_level ) return @@ -897,9 +897,9 @@ subroutine log_error( self, message, module, procedure, stat, errmsg ) character(len=*), intent(in) :: message !! A string to be written to log_unit character(len=*), intent(in), optional :: module -!! The name of the module contining the current invocation of `log_error` +!! The name of the module containing the current invocation of `log_error` character(len=*), intent(in), optional :: procedure -!! The name of the procedure contining the current invocation of `log_error` +!! The name of the procedure containing the current invocation of `log_error` integer, intent(in), optional :: stat !! The value of the `stat` specifier returned by a Fortran statement character(len=*), intent(in), optional :: errmsg @@ -988,9 +988,9 @@ subroutine log_information( self, message, module, procedure ) character(len=*), intent(in) :: message !! A string to be written to log_unit character(len=*), intent(in), optional :: module -!! The name of the module contining the current invocation of `log_information` +!! The name of the module containing the current invocation of `log_information` character(len=*), intent(in), optional :: procedure -!! The name of the procedure contining the current invocation of +!! The name of the procedure containing the current invocation of !! `log_information` if ( self % level > information_level ) return @@ -1043,9 +1043,9 @@ subroutine log_io_error( self, message, module, procedure, iostat, & character(len=*), intent(in) :: message !! A string to be written to LOG_UNIT character(len=*), intent(in), optional :: module -!! The name of the module contining the current invocation of REPORT_ERROR +!! The name of the module containing the current invocation of REPORT_ERROR character(len=*), intent(in), optional :: procedure -!! The name of the procedure contining the current invocation of REPORT_ERROR +!! The name of the procedure containing the current invocation of REPORT_ERROR integer, intent(in), optional :: iostat !! The value of the IOSTAT specifier returned by a Fortran I/O statement character(len=*), intent(in), optional :: iomsg @@ -1131,9 +1131,9 @@ subroutine log_message( self, message, module, procedure, prefix ) character(len=*), intent(in) :: message !! A string to be written to log_unit character(len=*), intent(in), optional :: module -!! The name of the module contining the current invocation of `log_message` +!! The name of the module containing the current invocation of `log_message` character(len=*), intent(in), optional :: procedure -!! The name of the procedure contining the current invocation of `log_message` +!! The name of the procedure containing the current invocation of `log_message` character(len=*), intent(in), optional :: prefix !! To be prepended to message as `prefix // ': ' // message`. @@ -1468,9 +1468,9 @@ subroutine log_warning( self, message, module, procedure ) character(len=*), intent(in) :: message !! A string to be written to LOG_UNIT character(len=*), intent(in), optional :: module -!! The name of the module contining the current invocation of `log_warning` +!! The name of the module containing the current invocation of `log_warning` character(len=*), intent(in), optional :: procedure -!! The name of the procedure contining the current invocation of `log_warning` +!! The name of the procedure containing the current invocation of `log_warning` if ( self % level > warning_level ) return From 7e6ab33a7a6c171c326703688c7c3ee737ee71f7 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Fri, 18 Dec 2020 19:51:40 +0100 Subject: [PATCH 13/13] level_logger: changes as proposed by @ivan-pi --- doc/specs/stdlib_logger.md | 27 ++++++++++++++------------- 1 file changed, 14 insertions(+), 13 deletions(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index e949e41fb..60a823406 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -8,20 +8,20 @@ title: logger ## Introduction This module defines a derived type, its methods, a variable, and -constants to be used for the reporting of errors, for filtering the -log messages, and other information. The derived type, `logger_type`, -is to be used to define both global and local logger variables. The -`logger_type` methods serve to configure the loggers and use the logger -variables to report messages to a variable specific list of I/O units -termed `log_units`. The variable, `global_logger`, of type `logger_type`, -is intended to serve as the default global logger. The constants serve as -error flags returned by the optional integer `stat` argument. +constants to be used for the reporting of errors, displaying messages, +and other information. The derived type, `logger_type`, is to be used +to define both global and local logger variables. The `logger_type` +methods serve to configure the loggers and use the logger variables to +report messages to a variable specific list of I/O units termed +`log_units`. The variable, `global_logger`, of type `logger_type`, +is intended to serve as the default global logger. The constants serve +as error flags returned by the optional integer `stat` argument. The logger variables have the option to: * change which units receive the log messages; * report which units receive the log messages; -* change the level for filtering the log messages; +* select which types of messages are logged; * precede messages by a blank line; * precede messages by a time stamp of the form `yyyy-mm-dd hh:mm:ss.sss`; @@ -66,10 +66,11 @@ Error Code | Description `write_fault` | one of the writes to `log_units` failed The module also defines eight distinct public integer constants for -filtering the log messages. These constants, termed severity levels, are -(sorted following their increasing order of severity): `all_level`, -`debug_level`, `information_level`, `warning_level`, `error_level`, -`io_error_level`, `text_error_level`, and `none_level`. +selecting the messages that are logged. These constants, termed +severity levels, are (sorted following their increasing order of +severity): `all_level`, `debug_level`, `information_level`, +`warning_level`, `error_level`, `io_error_level`, `text_error_level`, +and `none_level`. All log messages with a level (e.g., `debug_level`) lower than a specified severity level (e.g., `information_level`) will be ignored. The levels `error_level` and `io_error_level` have the same severity.