diff --git a/doc/specs/index.md b/doc/specs/index.md index c10818fa9..6ea78b52e 100644 --- a/doc/specs/index.md +++ b/doc/specs/index.md @@ -15,6 +15,7 @@ This is and index/directory of the specifications (specs) for each new module/fe - [error](./stdlib_error.html) - Catching and handling errors - [IO](./stdlib_io.html) - Input/output helper & convenience - [linalg](./stdlib_linalg.html) - Linear Algebra + - [logger](./stdlib_logger.html) - Runtime logging system - [optval](./stdlib_optval.html) - Fallback value for optional arguments - [quadrature](./stdlib_quadrature.html) - Numerical integration - [stats](./stdlib_stats.html) - Descriptive Statistics diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index d45fa560d..0a15b1675 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -34,6 +34,12 @@ The logger variables have the option to: * indent subsequent lines of the messages; and * format the text to fit within a maximum column width. +While every effort has been made to make the code process and +asynchronous I/O safe, it is always best to have each process write to +its own dedicated logger file. +For thread parallelism (e.g., with OpenMP), it is advised to put the +logger call in a guarding region (e.g., in an OpenMP critical region). + Note: Loggers of type `logger_type` normally report their messages to I/O units in the internal list termed `log_units`. However if `log_units` is empty then the messages go to the `output_unit` of the intrinsic @@ -75,14 +81,16 @@ 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 | empty -| `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.` | +| `buffer` | Character(:) | Buffer to build output string | Unallocated | +| `indent_lines` | Logical | Flag to indent subsequent lines by four columns | `.true.` | +| `len_buffer` | Integer | Number of valid characters in buffer | 0 | +| `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 @@ -285,7 +293,7 @@ Pure subroutine #### Arguments -`self`: shall be a scalar variable of type `logger_type`. It is an +`self`: shall be a scalar expression of type `logger_type`. It is an `intent(in)` argument. It shall be the logger whose configuration is reported. `add_blank_line` (optional): shall be a scalar default logical @@ -416,11 +424,13 @@ Subroutine #### Arguments -`self`: shall be a scalar expression of type `logger_type`. It is an -`intent(in)` argument. It is the logger used to send the message. +`self`: shall be a scalar variable of type `logger_type`. It is an +`intent(inout)` argument. It is the logger used to send the message. `message`: shall be a scalar default character expression. It is an - `intent(in)` argument. +`intent(in)` argument. + +* Note `message` may have embedded new_line calls. `module` (optional): shall be a scalar default character expression. It is an `intent(in)` argument. It should be the name of @@ -497,12 +507,14 @@ Subroutine #### Arguments -`self`: shall be a scalar expression of type `logger_type`. It is an -`intent(in)` argument. It is the logger used to send the message. +`self`: shall be a scalar variable of type `logger_type`. It is an +`intent(inout)` argument. It is the logger used to send the message. `message`: shall be a scalar default character expression. It is an `intent(in)` argument. +* Note `message` may have embedded new_line calls. + `module` (optional): shall be a scalar default character expression. It is an `intent(in)` argument. It should be the name of the module containing the `log_information` call. @@ -566,12 +578,14 @@ written. Subroutine #### Arguments -`self`: shall be a scalar expression of type `logger_type`. It is an -`intent(in)` argument. It is the logger used to send the message. +`self`: shall be a scalar variable of type `logger_type`. It is an +`intent(inout)` argument. It is the logger used to send the message. `message`: shall be a scalar default character expression. It is an `intent(in)` argument. +* Note `message` may have embedded new_line calls. + `module` (optional): shall be a scalar default character expression. It is an `intent(in)` argument. It should be the name of the module containing the `log_io_error` call. @@ -642,12 +656,14 @@ Subroutine #### Arguments -`self`: shall be a scalar expression of type `logger_type`. It is an -`intent(in)` argument. It is the logger used to send the message. +`self`: shall be a scalar variable of type `logger_type`. It is an +`intent(inout)` argument. It is the logger used to send the message. `message`: shall be a scalar default character expression. It is an `intent(in)` argument. +* Note `message` may have embedded new_line calls. + `module` (optional): shall be a scalar default character expression. It is an `intent(in)` argument. It should be the name of the module containing the `log_message` call. @@ -716,8 +732,8 @@ Subroutine #### Arguments -`self`: shall be a scalar expression of type `logger_type`. It is an -`intent(in)` argument. It is the logger used to send the message. +`self`: shall be a scalar variable of type `logger_type`. It is an +`intent(inout)` argument. It is the logger used to send the message. `line`: shall be a scalar default character expression. It is an `intent(in)` argument. It should be the line of text in which the @@ -862,12 +878,14 @@ Subroutine #### Arguments -`self`: shall be a scalar expression of type `logger_type`. It is an -`intent(in)` argument. It is the logger used to send the message. +`self`: shall be a scalar variable of type `logger_type`. It is an +`intent(inout)` argument. It is the logger used to send the message. `message`: shall be a scalar default character expression. It is an `intent(in)` argument. +* Note `message` may have embedded new_line calls. + `module`: (optional) shall be a scalar default character expression. It is an `intent(in)` argument. It should be the name of the module containing the `log_warning` call. @@ -925,7 +943,7 @@ Subroutine #### Arguments -`self`: shall be a scalar expression of type `logger_type`. It is an +`self`: shall be a scalar variable of type `logger_type`. It is an `intent(inout)` argument. It is the logger whose `log_units` is to be modified. diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index 2b8bf989e..87059c9fc 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -76,12 +76,14 @@ module stdlib_logger !! Public derived type ([Specification](../page/specs/stdlib_logger.html#the-derived-type-logger_type)) private - logical :: add_blank_line = .false. - logical :: indent_lines = .true. - integer, allocatable :: log_units(:) - integer :: max_width = 0 - logical :: time_stamp = .true. - integer :: units = 0 + logical :: add_blank_line = .false. + character(:), allocatable :: buffer + logical :: indent_lines = .true. + integer :: len_buffer = 0 + integer, allocatable :: log_units(:) + integer :: max_width = 0 + logical :: time_stamp = .true. + integer :: units = 0 contains @@ -121,8 +123,8 @@ subroutine add_log_file( self, filename, unit, action, position, status, & !! array. `action`, if present, is the `action` specifier of the `open` !! statement, and has the default value of `"write"`. `position`, if present, !! is the `position` specifier, and has the default value of `"REWIND"`. -!! `status`, if present, is the `status` specifier of the `open` statement, and -!! has the default value of `"REPLACE"`. `stat`, if present, has the value +!! `status`, if present, is the `status` specifier of the `open` statement, +!! and has the default value of `"REPLACE"`. `stat`, if present, has the value !! `success` if `filename` could be opened, `read_only_error` if `action` is !! `"read"`, and `open_failure` otherwise. !!([Specification](../page/specs/stdlib_logger.html#add_log_file-open-a-file-and-add-its-unit-to-self-log_units)) @@ -141,7 +143,8 @@ subroutine add_log_file( self, filename, unit, action, position, status, & integer, intent(out), optional :: stat !! The error status on exit with the possible values !! * `success` - no errors found -!! * `Rrea_only_error` - file unopened as `action1 was `"read"` for an output file +!! * `read_only_error` - file unopened as `action1 was `"read"` for an output +!! file !! * `open_failure` - the `open` statement failed @@ -236,8 +239,8 @@ subroutine add_log_unit( self, unit, stat ) !! version: experimental !! Adds `unit` to the log file units in `log_units`. `unit` must be an `open` -!! file, of `form` `"formatted"`, with `"sequential"` `access`, and an `action` of -!! `"write"` or `"readwrite"`, otherwise either `stat`, if preseent, has a +!! file, of `form` `"formatted"`, with `"sequential"` `access`, and an `action` +!! of `"write"` or `"readwrite"`, otherwise either `stat`, if present, has a !! value other than `success` and `unit` is not entered into `log_units`, !! or, if `stat` is not presecn, processing stops. !!([Specification](../page/specs/stdlib_logger.html#add_log_unit-add-a-unit-to-the-array-self-log_units)) @@ -263,7 +266,7 @@ subroutine add_log_unit( self, unit, stat ) !! integer :: iostat, unit, stat !! ... !! open( newunit=unit, 'error_log.txt', form='formatted', & -!! status='replace', position='rewind', err=999, & +!! status='replace', position='rewind', err=999, & !! action='read', iostat=iostat, iomsg=iomsg ) !! ... !! call global_logger % add_log_unit( unit, stat ) @@ -503,8 +506,8 @@ subroutine final_logger( self ) do unit=1, self % units flush( self % log_units(unit), iomsg=message, iostat=iostat ) if ( iostat /= 0 ) then - write(error_unit, '(a, i0)' ) 'In the logger_type finalizer ' // & - 'an error occurred in flushing unit = ', & + write(error_unit, '(a, i0)' ) 'In the logger_type ' // & + 'finalizer an error occurred in flushing unit = ', & self % log_units(unit) write(error_unit, '(a, i0)') 'With iostat = ', iostat write(error_unit, '(a)') 'With iomsg = ' // trim(message) @@ -514,23 +517,22 @@ subroutine final_logger( self ) end subroutine final_logger - subroutine format_output_string( self, unit, string, procedure_name, & - col_indent ) + subroutine format_output_string( self, string, col_indent ) !! version: experimental !! Writes the STRING to UNIT ensuring that the number of characters !! does not exceed MAX_WIDTH and that the lines after the first !! one are indented four characters. - class(logger_type), intent(in) :: self - integer, intent(in) :: unit - character(*), intent(in) :: string - character(*), intent(in) :: procedure_name - character(*), intent(in) :: col_indent + class(logger_type), intent(inout) :: self + character(*), intent(in) :: string + character(*), intent(in) :: col_indent - integer :: count, indent_len, index_, iostat, length, remain - character(256) :: iomsg + integer :: count, indent_len, index_, length, remain + integer, parameter :: new_len = len(new_line('a')) length = len_trim(string) + allocate( character(2*length) :: self % buffer ) + self % len_buffer = 0 indent_len = len(col_indent) call format_first_line() @@ -548,16 +550,17 @@ subroutine format_output_string( self, unit, string, procedure_name, & subroutine format_first_line() - if ( self % max_width == 0 .or. & - ( length <= self % max_width .and. & + if ( self % max_width == 0 .or. & + ( length <= self % max_width .and. & index( string(1:length), new_line('a')) == 0 ) ) then - write( unit, '(a)', err=999, iostat=iostat, iomsg=iomsg ) & - string(1:length) + self % buffer(1:length) = string(1:length) + self % len_buffer = length remain = 0 return else - index_ = index( string(1:min(length, self % max_width)), new_line('a')) + index_ = index( string(1:min(length, self % max_width)), & + new_line('a') ) if ( index_ == 0 ) then do index_=self % max_width, 1, -1 if ( string(index_:index_) == ' ' ) exit @@ -565,14 +568,15 @@ subroutine format_first_line() end if if ( index_ == 0 ) then - write( unit, '(a)', err=999, iostat=iostat, iomsg=iomsg ) & + self % buffer(1:self % max_width) = & string(1:self % max_width) + self % len_buffer = self % max_width count = self % max_width remain = length - count return else - write( unit, '(a)', err=999, iostat=iostat, iomsg=iomsg ) & - string(1:index_-1) + self % buffer(1:index_-1) = string(1:index_-1) + self % len_buffer = index_-1 count = index_ remain = length - count return @@ -580,21 +584,28 @@ subroutine format_first_line() end if -999 call handle_write_failure( unit, procedure_name, iostat, iomsg ) - end subroutine format_first_line subroutine format_subsequent_line() + integer :: new_len_buffer + character(:), allocatable :: dummy if ( remain <= self % max_width ) then - write( unit, '(a)', err=999, iostat=iostat, iomsg=iomsg ) & - string(count+1:length) + new_len_buffer = self % len_buffer + length - count + new_len + if ( new_len_buffer > len( self % buffer ) ) then + allocate( character( 2*len( self % buffer ) ) :: dummy ) + dummy = self % buffer + call move_alloc( dummy, self % buffer ) + end if + self % buffer( self % len_buffer+1:new_len_buffer ) = & + new_line('a') // string(count+1:length) + self % len_buffer = new_len_buffer count = length remain = 0 return else - index_ = count + index( string(count+1:count+self % max_width), & + index_ = count + index(string(count+1:count+self % max_width),& new_line('a')) if(index_ == count) then do index_=count+self % max_width, count+1, -1 @@ -603,14 +614,30 @@ subroutine format_subsequent_line() end if if ( index_ == count ) then - write( unit, '(a)', err=999, iostat=iostat, iomsg=iomsg ) & - string(count+1:count+self % max_width) + new_len_buffer = self % len_buffer + self % max_width + & + new_len + if ( new_len_buffer > len( self % buffer ) ) then + allocate( character( 2*len( self % buffer ) ) :: dummy ) + dummy = self % buffer + call move_alloc( dummy, self % buffer ) + end if + self % buffer( self % len_buffer+1:new_len_buffer ) = & + new_line('a') // string(count+1:count+self % max_width) + self % len_buffer = new_len_buffer count = count + self % max_width remain = length - count return else - write( unit, '(a)', err=999, iostat=iostat, iomsg=iomsg ) & - string(count+1:index_-1) + new_len_buffer = self % len_buffer + index_ - 1 & + - count + new_len + if ( new_len_buffer > len( self % buffer ) ) then + allocate( character( 2*len( self % buffer ) ) :: dummy ) + dummy = self % buffer + call move_alloc( dummy, self % buffer ) + end if + self % buffer( self % len_buffer+1:new_len_buffer ) = & + new_line('a') // string(count+1:index_-1) + self % len_buffer = new_len_buffer count = index_ remain = length - count return @@ -618,16 +645,24 @@ subroutine format_subsequent_line() end if -999 call handle_write_failure( unit, procedure_name, iostat, iomsg ) - end subroutine format_subsequent_line subroutine indent_format_subsequent_line() + integer :: new_len_buffer + character(:), allocatable :: dummy if ( index( string(count+1:length), new_line('a')) == 0 .and. & remain <= self % max_width - indent_len ) then - write( unit, '(a)', err=999, iostat=iostat, iomsg=iomsg ) & - col_indent // string(count+1:length) + new_len_buffer = self % len_buffer + length & + - count + new_len + indent_len + if ( new_len_buffer > len( self % buffer ) ) then + allocate( character( 2*len( self % buffer ) ) :: dummy ) + dummy = self % buffer + call move_alloc( dummy, self % buffer ) + end if + self % buffer( self % len_buffer+1:new_len_buffer ) = & + new_line('a') // col_indent // string(count+1:length) + self % len_buffer = new_len_buffer count = length remain = 0 return @@ -643,15 +678,31 @@ subroutine indent_format_subsequent_line() end if if ( index_ == count ) then - write( unit, '(a)', err=999, iostat=iostat, iomsg=iomsg ) & - col_indent // & + new_len_buffer = self % len_buffer + self % max_width & + + new_len + if ( new_len_buffer > len( self % buffer ) ) then + allocate( character( 2*len( self % buffer ) ) :: dummy ) + dummy = self % buffer + call move_alloc( dummy, self % buffer ) + end if + self % buffer( self % len_buffer+1: new_len_buffer ) = & + new_line('a') // col_indent // & string(count+1:count+self % max_width-indent_len) + self % len_buffer = new_len_buffer count = count + self % max_width - indent_len remain = length - count return else - write( unit, '(a)', err=999, iostat=iostat, iomsg=iomsg ) & - col_indent // string(count+1:index_-1) + new_len_buffer = self % len_buffer + index_ - count - 1 & + + new_len + indent_len + if ( new_len_buffer > len( self % buffer ) ) then + allocate( character( 2*len( self % buffer ) ) :: dummy ) + dummy = self % buffer + call move_alloc( dummy, self % buffer ) + end if + self % buffer( self % len_buffer+1: new_len_buffer ) = & + new_line('a') // col_indent // string(count+1:index_-1) + self % len_buffer = new_len_buffer count = index_ remain = length - count return @@ -659,8 +710,6 @@ subroutine indent_format_subsequent_line() end if -999 call handle_write_failure( unit, procedure_name, iostat, iomsg ) - end subroutine indent_format_subsequent_line end subroutine format_output_string @@ -683,18 +732,22 @@ subroutine handle_write_failure( unit, procedure_name, iostat, iomsg ) write( output_unit, '(a)' ) 'write failure in ' // module_name // & ' % ' // trim(procedure_name) // '.' - write( output_unit, '(a, i0)' ) 'unit = ', unit - inquire( unit, named=named ) - - if ( named ) then - inquire( unit, name=name ) - write( output_unit, '(a, a)' ) 'name = ', trim(name) + if ( unit == -999 ) then + write( output_unit, '(a, i0)' ) 'unit = internal file' else - write( output_unit, '(a)' ) 'unit is unnamed' + write( output_unit, '(a, i0)' ) 'unit = ', unit + inquire( unit, named=named ) + + if ( named ) then + inquire( unit, name=name ) + write( output_unit, '(a, a)' ) 'name = ', trim(name) + else + write( output_unit, '(a)' ) 'unit is unnamed' + end if + inquire( unit, action=action ) + write( output_unit, '(a, a)' ) 'action = ', trim(action) end if - inquire( unit, action=action ) - write( output_unit, '(a, a)' ) 'action = ', trim(action) write( output_unit, '(a, i0)' ) 'iostat = ', iostat write( output_unit, '(a, a )' ) 'iomsg = ', trim(iomsg) error stop 'write failure in ' // module_name // '.' @@ -746,7 +799,7 @@ subroutine log_error( self, message, module, procedure, stat, errmsg ) !! end module example_mod !! - class(logger_type), intent(in) :: self + class(logger_type), intent(inout) :: self !! The logger to be used in logging the message character(len=*), intent(in) :: message !! A string to be written to log_unit @@ -759,49 +812,38 @@ subroutine log_error( self, message, module, procedure, stat, errmsg ) character(len=*), intent(in), optional :: errmsg !! The value of the `errmsg` specifier returned by a Fortran statement - integer :: unit integer :: iostat - character(*), parameter :: procedure_name = 'log_error' + character(28) :: dummy character(256) :: iomsg + character(*), parameter :: procedure_name = 'log_error' + character(:), allocatable :: suffix - call self % log_message( message, & - module = module, & - procedure = procedure, & - prefix = 'ERROR') - - if ( self % units == 0 ) then - call write_log_error( output_unit ) + if ( present(stat) ) then + write( dummy, '(a, i0)', err=999, iostat=iostat, iomsg=iomsg ) & + new_line('a') // "With stat = ", stat else - do unit=1, self % units - call write_log_error( self % log_units(unit) ) - end do + dummy = ' ' end if - contains - - subroutine write_log_error( unit ) - integer, intent(in) :: unit - - if ( present(stat) ) then - write( unit, '("With stat = ", i0)', err=999, & - iostat=iostat, iomsg=iomsg ) stat - end if - - if ( present(errmsg) ) then - if ( len_trim(errmsg) > 0 ) then - call format_output_string( self, unit, & - 'With errmsg = "' // & - trim(errmsg) // '"', & - procedure_name, & - ' ' ) - end if + if ( present(errmsg) ) then + if ( len_trim(errmsg) > 0 ) then + suffix = trim(dummy) // & + new_line('a') // 'With errmsg = "' // trim(errmsg) // '"' + else + suffix = dummy end if + else + suffix = dummy + end if - return + call self % log_message( trim(message) // suffix, & + module = module, & + procedure = procedure, & + prefix = 'ERROR') -999 call handle_write_failure( unit, procedure_name, iostat, iomsg ) + return - end subroutine write_log_error +999 call handle_write_failure( -999, procedure_name, iostat, iomsg ) end subroutine log_error @@ -846,14 +888,15 @@ subroutine log_information( self, message, module, procedure ) !! end module example_mod !! - class(logger_type), intent(in) :: self + class(logger_type), intent(inout) :: self !! The logger used to send the message 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` character(len=*), intent(in), optional :: procedure -!! The name of the procedure contining the current invocation of `log_information` +!! The name of the procedure contining the current invocation of +!! `log_information` call self % log_message( message, & module = module, & @@ -898,7 +941,7 @@ subroutine log_io_error( self, message, module, procedure, iostat, & !! ... !! end program example - class(logger_type), intent(in) :: self + class(logger_type), intent(inout) :: self !! The logger variable to receivee the message character(len=*), intent(in) :: message !! A string to be written to LOG_UNIT @@ -911,49 +954,38 @@ subroutine log_io_error( self, message, module, procedure, iostat, & character(len=*), intent(in), optional :: iomsg !! The value of the IOMSG specifier returned by a Fortran I/O statement - integer :: unit - integer :: iostat2 - character(*), parameter :: procedure_name = 'log_error' + character(28) :: dummy character(256) :: iomsg2 + integer :: iostat2 + character(*), parameter :: procedure_name = 'log_io_error' + character(:), allocatable :: suffix - call self % log_message( message, & - module = module, & - procedure = procedure, & - prefix = 'I/O ERROR' ) - - if ( self % units == 0 ) then - call write_log_io_error( output_unit ) + if ( present(iostat) ) then + write( dummy, '(a, i0)', err=999, iostat=iostat2, iomsg=iomsg2 ) & + new_line('a') // "With iostat = ", iostat else - do unit=1, self % units - call write_log_io_error( self % log_units(unit) ) - end do + dummy = ' ' end if - contains - - subroutine write_log_io_error( unit ) - integer, intent(in) :: unit - - if ( present(iostat) ) then - write( unit, '("With iostat = ", i0)', err=999, & - iostat=iostat2, iomsg=iomsg2 ) iostat - end if - - if ( present(iomsg) ) then - if ( len_trim(iomsg) > 0 ) then - call format_output_string( self, unit, & - 'With iomsg = "' // & - trim(iomsg) // '"', & - procedure_name, & - ' ' ) - end if + if ( present(iomsg) ) then + if ( len_trim(iomsg) > 0 ) then + suffix = trim(dummy) // & + new_line('a') // 'With iomsg = "' // trim(iomsg) // '"' + else + suffix = trim(dummy) end if + else + suffix = trim(dummy) + end if - return + call self % log_message( trim(message) // suffix, & + module = module, & + procedure = procedure, & + prefix = 'I/O ERROR' ) -999 call handle_write_failure( unit, procedure_name, iostat, iomsg ) + return - end subroutine write_log_io_error +999 call handle_write_failure( -999, procedure_name, iostat2, iomsg2 ) end subroutine log_io_error @@ -995,7 +1027,7 @@ subroutine log_message( self, message, module, procedure, prefix ) !! end module example_mod !! - class(logger_type), intent(in) :: self + class(logger_type), intent(inout) :: self !! The logger variable to receive the message character(len=*), intent(in) :: message !! A string to be written to log_unit @@ -1036,32 +1068,43 @@ subroutine log_message( self, message, module, procedure, prefix ) m_and_p = '' end if + call format_output_string( self, & + d_and_t // m_and_p // pref // & + trim( message ), & + ' ' ) + if ( self % units == 0 ) then - call write_log_message( output_unit ) + if ( self % add_blank_line ) then + write( output_unit, '(a)', err=999, iostat=iostat, & + iomsg=iomsg) & + new_line('a') // self % buffer(1:self % len_buffer) + else + write( output_unit, '(a)', err=999, iostat=iostat, & + iomsg=iomsg ) & + self % buffer(1:self % len_buffer) + end if else - do unit=1, self % units - call write_log_message( self % log_units(unit) ) - end do + if ( self % add_blank_line ) then + do unit=1, self % units + write( self % log_units(unit), '(a)', err=999, iostat=iostat, & + iomsg=iomsg ) new_line('a') // & + self % buffer(1:self % len_buffer) + end do + else + do unit=1, self % units + write( self % log_units(unit), '(a)', err=999, iostat=iostat, & + iomsg=iomsg ) & + self % buffer(1:self % len_buffer) + end do + end if end if - contains - - subroutine write_log_message( unit ) - integer, intent(in) :: unit + deallocate( self % buffer ) + self % len_buffer = 0 - if ( self % add_blank_line ) write( unit, *, err=999, & - iostat=iostat, iomsg=iomsg ) - - call format_output_string( self, unit, & - d_and_t // m_and_p // pref // & - trim( message ), & - procedure_name, ' ' ) - - return - -999 call handle_write_failure( unit, procedure_name, iostat, iomsg ) + return - end subroutine write_log_message +999 call handle_write_failure( unit, procedure_name, iostat, iomsg ) end subroutine log_message @@ -1077,8 +1120,8 @@ subroutine log_text_error( self, line, column, summary, filename, & !! !! If time stamps are active first a time stamp is written. Then if !! `filename` or `line_number` or `column` are present they are written. -!! Then `line` is written. Then the symbol `caret` is written below `line` at the -!! column indicated by `column`. Then `summary` is written. +!! Then `line` is written. Then the symbol `caret` is written below `line` +!! at the column indicated by `column`. Then `summary` is written. ! !!##### Example !! @@ -1106,7 +1149,7 @@ subroutine log_text_error( self, line, column, summary, filename, & !! ... !! end program example !! - class(logger_type), intent(in) :: self + class(logger_type), intent(inout) :: self !! The logger variable to receive the message character(*), intent(in) :: line !! The line of text in which the error was found. @@ -1123,12 +1166,10 @@ subroutine log_text_error( self, line, column, summary, filename, & integer, intent(out), optional :: stat !! Integer flag that an error has occurred. Has the value `success` if no !! error hass occurred, `index_invalid_error` if `column` is less than zero or -!! greater than `len(line)`, and `write_failure` if any of the `write` statements -!! has failed. +!! greater than `len(line)`, and `write_failure` if any of the `write` +!! statements has failed. character(1) :: acaret - character(5) :: num - character(:), allocatable :: fmt character(128) :: iomsg integer :: iostat integer :: lun @@ -1149,57 +1190,84 @@ subroutine log_text_error( self, line, column, summary, filename, & end if end if - write(num, '(i0)') column-1 - fmt = '(' // trim(num) // 'x, a)' - + call write_log_text_error_buffer( ) if ( self % units == 0 ) then - call write_log_text_error( output_unit ) + write( output_unit, '(a)' ) self % buffer else do lun=1, self % units - call write_log_text_error( self % log_units(lun) ) - + write( self % log_units(lun), '(a)' ) self % buffer end do end if + deallocate( self % buffer ) + self % len_buffer = 0 contains - subroutine write_log_text_error( unit ) - integer, intent(in) :: unit - - if ( self % add_blank_line ) write( unit, * ) - - if ( self % time_stamp ) write( unit, '(a)' ) time_stamp() + subroutine write_log_text_error_buffer( ) + integer :: i + character(:), allocatable :: location, marker if ( present(filename) ) then if ( present(line_number) ) then - write( unit, '(a,":", i0, ":", i0)', err=999, & + allocate( character(len_trim(filename)+15) :: location ) + write( location, fmt='(a, ":", i0, ":", i0)', err=999, & iomsg=iomsg, iostat=iostat ) & trim(filename) , line_number, column else - write( unit, '(a, i0)', err=999, iomsg=iomsg, & + allocate( character(len_trim(filename)+45) :: location ) + write( location, fmt='(a, i0)', err=999, iomsg=iomsg, & iostat=iostat ) & - "Error found in file: '" // trim(filename) // "'" & - // ', at column: ', column + "Error found in file: '" // trim(filename) // & + "', at column: ", column end if else if ( present(line_number) ) then - write( unit, '(a, i0, a, i0)', err=999, iomsg=iomsg, & - iostat=iostat ) & + allocate( character(54) :: location ) + write( location, fmt='(a, i0, a, i0)', err=999, & + iomsg=iomsg, iostat=iostat ) & 'Error found at line number: ', line_number, & ', and column: ', column else - write( unit, '("Error found in line at column:", i0)' ) & + allocate( character(36) :: location ) + write( location, & + fmt='("Error found in line at column:", i0)' ) & column end if end if - write( unit, * ) - write( unit, '(a)', err=999, iomsg=iomsg, iostat=iostat ) line - write( unit, fmt, err=999, iomsg=iomsg, iostat=iostat ) & - acaret - write( unit, '(a)', err=999, iomsg=iomsg, iostat=iostat ) & - 'Error: ' // trim(summary) + allocate( character(column) :: marker ) + do i=1, column-1 + marker(i:i) = ' ' + end do + marker(column:column) = acaret + if ( self % add_blank_line ) then + if ( self % time_stamp ) then + self % buffer = new_line('a') // time_stamp() // & + new_line('a') // trim(location) // & + new_line('a') // new_line('a') // trim(line) // & + new_line('a') // marker // & + new_line('a') // 'Error: ' // trim(summary) + else + self % buffer = new_line('a') // trim(location) // & + new_line('a') // new_line('a') // trim(line) // & + new_line('a') // marker // & + new_line('a') // 'Error: ' // trim(summary) + end if + else + if ( self % time_stamp ) then + self % buffer = time_stamp() // & + new_line('a') // trim(location) // & + new_line('a') // new_line('a') // trim(line) // & + new_line('a') // marker // & + new_line('a') // 'Error: ' // trim(summary) + else + self % buffer = trim(location) // & + new_line('a') // new_line('a') // trim(line) // & + new_line('a') // marker // & + new_line('a') // 'Error: ' // trim(summary) + end if + end if if ( present(stat) ) stat = success @@ -1208,14 +1276,12 @@ subroutine write_log_text_error( unit ) 999 if ( present( stat ) ) then stat = write_failure return - else - call handle_write_failure( unit, procedure_name, iostat, & + call handle_write_failure( -999, procedure_name, iostat, & iomsg ) - end if - end subroutine write_log_text_error + end subroutine write_log_text_error_buffer end subroutine log_text_error @@ -1259,7 +1325,8 @@ end function log_units_assigned subroutine log_warning( self, message, module, procedure ) !! version: experimental -!! Writes the string `message` to `self % log_units` with optional additional text. +!! Writes the string `message` to `self % log_units` with optional additional +!! text. !!([Specification](../page/specs/stdlib_logger.html#log_warning-write-the-string-message-to-log_units)) !!##### Behavior @@ -1294,7 +1361,7 @@ subroutine log_warning( self, message, module, procedure ) !! ... !! end module example_mod !! - class(logger_type), intent(in) :: self + class(logger_type), intent(inout) :: self !! The logger to which the message is written character(len=*), intent(in) :: message !! A string to be written to LOG_UNIT @@ -1316,10 +1383,10 @@ subroutine remove_log_unit( self, unit, close_unit, stat ) !! Remove the I/O unit from the self % log_units list. If `close_unit` is !! present and `.true.` then the corresponding file is closed. If `unit` is -!! not in `log_units` then nothing is done. If `stat` is present it, by default, -!! has the value `success`. If closing the `unit` fails, then if `stat` is -!! present it has the value `close_failure`, otherwise processing stops -!! with an informative message. +!! not in `log_units` then nothing is done. If `stat` is present it, by +!! default, has the value `success`. If closing the `unit` fails, then if +!! `stat` is present it has the value `close_failure`, otherwise processing +!! stops with an informative message. !!([Specification](../page/specs/stdlib_logger.html#remove_log_unit-remove-unit-from-self-log_units)) class(logger_type), intent(inout) :: self diff --git a/src/tests/logger/test_stdlib_logger.f90 b/src/tests/logger/test_stdlib_logger.f90 index 53df6269e..9c7c9944e 100644 --- a/src/tests/logger/test_stdlib_logger.f90 +++ b/src/tests/logger/test_stdlib_logger.f90 @@ -47,7 +47,7 @@ program test_stdlib_logger print * print *, 'running log_text_error' call global % log_text_error( 'This text should be written to UNIT1' // & - 'and UNIT3 and not to OUTPUT_UNIT.', & + ' and UNIT3 and not to OUTPUT_UNIT.', & column = 25, & summary = 'There is no real error here.', & filename = 'dummy.txt', &