diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md new file mode 100644 index 000000000..83ed7f2cf --- /dev/null +++ b/doc/specs/stdlib_logger.md @@ -0,0 +1,964 @@ +--- +title: logger +--- +# Loggers + +[TOC] + +## 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 +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; +* precede messages by a blank line; +* precede messages by a time stamp of the form + `yyyy-mm-dd hh:mm:ss.sss`; +* precede messages with the names of a module and procedure; +* follow a message with the `stat` and `errmsg` of the error report + that prompted the log message; +* follow a message with the `iostat` and `iomsg` of the I/O error + report that prompted the log message; +* label a message with one of `'INFO: '`, `'WARN: '`, + `'ERROR: '`, or `'I/O ERROR: '`; +* indent subsequent lines of the messages; and +* format the text to fit within a maximum column width. + +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 +module `iso_fortran_env`. + + +## The `stdlib_logger` constants + +The module defines nine distinct public integer constants for +reporting errors in the `stat` arguments of some of the module's +procedures. The constants, termed error codes, are as follows: + +Error Code | Description +-----------------------|------------ +`success` | no error was detected +`close_failure` | a `close` statement for an I/O unit failed +`index_invalid_error` | the `column` was invalid for the given `line` +`non_sequential_error` | the I/O unit did not have `SEQUENTIAL` access +`open_failure` | an `open` statement failed +`read_only_error` | an output unit did not have an `access` specifier of `'WRITE'` or `'READWRITE'` +`unformatted_in_error` | the unit did not have a `form` of `'FORMATTED'` +`unopened_in_error` | the unit was not opened +`write_fault` | one of the writes to `log_units` failed + +## The derived type: logger_type + +### Status + +Experimental + +### Description + +Serves to define 'logger' variables to be used in reporting +significant events encountered during the execution of a program. + +### Syntax + +`type([[stdlib_logger(module):logger_type(type)]]) :: variable` + +### 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 + +## The `stdlib_logger` variable + +The module defines one public variable, `global_logger`, of type +`logger_type`. As might be guessed from its name, `global_logger` is +intended to serve as the default logger for use throughout an +application. + + +### Public `logger_type` methods + +The module defines twelve public procedures: one function and eleven +subroutines. The +methods are: + +Method | Class | Description +---------------------|------------|------------ +[`add_log_file`](./stdlib_logger.html#add_log_file-open-a-file-and-add-its-unit-to-self-log_units) | Subroutine | Opens a file using `newunit`, and adds the resulting unit to the `log_units` list +[`add_log_unit`](./stdlib_logger.html#add_log_unit-add-a-unit-to-the-array-self-log_units) | Subroutine | Adds an existing unit to the `log_units` list +[`configuration`](./stdlib_logger.html#configuration-report-a-loggers-configuration) | Subroutine | Reports the details of the logging configuration +[`configure`](./stdlib_logger.html#configure-configure-the-logging-process) | Subroutine | Configures the details of the logging process +[`log_error`](./stdlib_logger.html#log_error-writes-the-string-message-to-self-log_units) | Subroutine | Sends a message prepended by `'ERROR: '` optionally followed by a `stat` or `errmsg` +[`log_information`](./stdlib_logger.html#log_information-writes-the-string-message-to-self-log_units) | Subroutine | Sends a message prepended by `'INFO: '` +[`log_io_error`](./stdlib_logger.html#log_io_error-write-the-string-message-to-self-log_units) | Subroutine | Sends a message prepended by `'I/O ERROR: '` optionally followed by an `iostat` or `iomsg` +[`log_message`](./stdlib_logger.html#log_message-write-the-string-message-to-self-log_units) | Subroutine | Sends a message +[`log_text_error`](./stdlib_logger.html#log_text_error-send-a-message-to-self-log_units-describing-an-error) | Subroutine | Sends a message describing an error found in a line of text +[`log_units_assigned`](./stdlib_logger.html#log_units_assigned-returns-the-number-of-active-io-units) | Function | Returns the number of active I/O units in `log_units` +[`log_warning`](./stdlib_logger.html#log_warning-write-the-string-message-to-log_units) | Subroutine | Sends a message prepended by `'WARN: '` +[`remove_log_unit`](./stdlib_logger.html#remove_log_unit-remove-unit-from-self-log_units) | Subroutine | Removes the `unit` number from the `log_units` array + +## Specification of the `logger_type` methods + +### `add_log_file` - open a file and add its unit to `self % log_units` + +#### Status + +Experimental + +#### Description + +Opens a formatted, sequential access, output file, `filename` using +`newunit` and adds the resulting unit number to the logger's +`log_units` array. + +#### Syntax + +`call self % [[logger_type(type):add_log_file(bound)]]( filename [, unit, action, position, status, stat ] )` + +#### Class + +Subroutine + +#### Arguments + +`self`: shall be a scalar variable of type `logger_type`. It is an +`intent(inout)` argument. It shall be the logger to add the file to its `log_units`. + +`filename`: shall be a scalar default character expression. It is +an `intent(in)` argument. It shall be the name of the file to be opened. + +`unit` (optional): shall be a scalar default integer variable. It is an +`intent(out)` argument. It will be the unit number returned by the +`newunit` specifier of the `open` statement for `filename`. + +`action` (optional): shall be a scalar default character + expression. It is an `intent(in)` argument. It shall be the `action` + specifier of the `open` statement and must have one of the values + `'WRITE'` or `'READWRITE'`. It has the default value of `'WRITE'`. + +`position` (optional): shall be a scalar default character + expression. It is an `intent(in)` argument. It shall be the + `position` specifier of the `open` statement and must have one of + the values `'ASIS'`, `'REWIND'`, or `'APPEND'`. It has the default + value of `'REWIND'`. + +`status` (optional): shall be a scalar default character + expression. It is an `intent(in)` argument. It shall be the + `status` specifier of the `open` statement and must have one of + the values `'OLD'`, `'NEW'`, `'REPLACE'`, or `'UNKNOWN'`. It has the + default value of `'REPLACE'`. + +`stat` (optional): shall be a scalar default integer variable. It + is an `intent(out)` argument. If present, on return it will have the + value `success` if `filename` could be opened, the value + `read_only_error` if the `action` specifier is `"READ"`, or the value + `open_failure` if `filename` could not be opened. If absent and `filename` + could not be opened then processing will stop with an informative message as the stop code. + +#### Example + +```fortran +program demo_global_logger + use stdlib_logger, global => global_logger + + integer :: unit, stat + + call global % add_log_file( 'error_log.txt', unit, & + position='asis', stat=stat ) + if ( stat /= success ) then + error stop 'Unable to open "error_log.txt".' + end if + +end program demo_global_logger +``` + +### `add_log_unit` - add a unit to the array `self % log_units` + +#### Status + +Experimental + +#### Description + +Adds `unit` to the array of `self % log_units`. The `unit` shall +be the unit number for an opened, sequential, formatted file with an +`action` specifier of `'WRITE'` or `'READWRITE'`. Failure of `unit` to meet +those requirements will cause `stat`, if present, to not be +`success` and `unit` will not be added to `log_units`. In this case, if `stat` is +not present, cause processing to stop with an informative string as +the stop code. + +#### Syntax + +`call self % [[logger_type(type):add_log_unit(bound)]]( unit [, stat ] )` + +#### Class. + +Subroutine. + +#### Arguments + +`self`: shall be a scalar variable of type `logger_type`. It is an +`intent(inout)` argument. It shall be the logger to direct its output +to `unit`. + +`unit`: shall be a scalar default integer expression. It is an + `intent(in)` argument. It shall be the unit number for an opened, + sequential, formatted file with an action specifier of `'WRITE'` or + `'READWRITE'`. + +`stat` (optional): shall be a scalar default integer variable. It is + an `intent(out)` argument. If absent and `unit` could not be added + to self's `log_units` processing will stop with an informative + message as the stop code. If present it shall have the value of one + of the module's error codes indicating any errors found with + `unit`. The codes are + * `success` - no problem found + * `non_sequential_error` - `unit` did not have an `access` specifier of + `'SEQUENTIAL'` + * `read_only_error` - `unit` had an `action` specifier of `'READ'` + when it needs a specifier of `'WRITE'` or `'READWRITE'` + * `unformatted_in_error` - `unit` did not have a `form` specifier of + `'FORMATTED'` + * `unopened_in_error` - `unit` was not opened + +#### Example + +```fortran +program demo_add_log_unit + use stdlib_logger, only: global_logger, read_only_error + + character(256) :: iomsg + integer :: iostat, unit, stat + + open( newunit=unit, 'error_log.txt', & + form='formatted', status='replace', & + position='rewind', err=999, & + action='read', iostat=iostat, iomsg=iomsg ) + + call global_logger % add_log_unit( unit, stat ) + select case ( stat ) + + case ( read_only_error ) + error stop 'Unable to write to "error_log.txt".' + + end select + + 999 error stop 'Unable to open "error_log.txt". + +end program demo_add_log_unit +``` + +### `configuration` - report a logger's configuration + +#### Status + +Experimental + +#### Description + +Reports the configuration of a logger. + +#### Syntax + +`call self % [[logger_type(type):configuration(bound)]]( [ add_blankline, indent, max_width, time_stamp, log_units ] )` + +#### Class + +Pure subroutine + +#### Arguments + +`self`: shall be a scalar variable 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 + variable. It is an `intent(out)` argument. A value of `.true.` + starts output with a blank line, and `.false.` otherwise. + +`indent` (optional): shall be a scalar default logical variable. It + is an `intent(out)` argument. A value of `.true.` indents subsequent + lines by four spaces, and `.false.` otherwise. + +`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 + is no maximum width. + +`time_stamp` (optional): shall be a scalar default logical + variable. It is an `intent(out)` argument. A value of `.true.` + precedes output with a time stamp of the form 'yyyy-mm-dd + hh:mm:ss.sss', and `.false.` otherwise. + +`log_units` (optional): shall be a rank one allocatable array + variable of type default integer. It is an `intent(out)` + argument. On return it shall be the elements of the `self`'s `log_units` + array. + +#### Example + +```fortran +module example_mod + use stdlib_logger + + type(logger_type) :: logger + contains + + subroutine example_sub(unit, ...) + integer, intent(in) :: unit + + integer, allocatable :: log_units(:) + + call logger % configuration( log_units=log_units ) + if ( size(log_units) == 0 ) then + call add_logger_unit( unit ) + end if + + end subroutine example_sub + +end module example_mod +``` + +### `configure` - configure the logging process + +#### Status + +Experimental + +#### Description + +Configures the logging process for self. + +#### Syntax + +`call self % [[logger_type(type):configure(bound)]]( [ add_blank_line, indent, max_width, time_stamp ] )` + +#### Class + +Pure subroutine + +#### Arguments + +`self`: shall be a scalar variable of type `logger_type`. It is an +`intent(inout)` argument. It shall be the logger to be configured. + +`add_blank_line` (optional): shall be a scalar default logical + expression. It is an `intent(in)` argument. Set to `.true.` to start + output with a blank line, and to `.false.` otherwise. + +`indent` (optional): shall be a scalar default logical + expression. It is an `intent(in)` argument. Set to `.true.` to + indent subsequent lines by four spaces, and to `.false.` to + not indent. + +`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, + otherwise there is no maximum width. + +`time_stamp` (optional): shall be a scalar default logical + expression. It is an `intent(in)` argument. Set to `.true.` to + precede output with a time stamp of the form 'yyyy-mm-dd + hh:mm:ss.sss', and to `.false.` otherwise. + +#### Example + +```fortran +program demo_configure + use stdlib_logger, only: global => global_logger + + call global % configure( indent=.false., max_width=72 ) + +end program demo_configure +``` + +### `log_error` - Writes the string `message` to `self % log_units` + +#### Status + +Experimental + +#### Description + +Writes the string `message` to `self % log_units` with optional additional text. + +#### Syntax + +`call self % [[logger_type(type):log_error(bound)]]( message [, module, procedure, stat, errmsg ] )` + +#### Behavior + +If time stamps are active for `self`, a time stamp is written, +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. + +#### Class + +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. + +`message`: shall be a scalar default character expression. It is an + `intent(in)` argument. + +`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_error` call. + +`procedure` (optional): shall be a scalar default character + expression. It is an `intent(in)` argument. It should be the name of + the procedure containing the `log_error` call. + +`stat` (optional): shall be a scalar default integer expression. It + is an `intent(in)` argument. It should be the `stat` specifier of + the subroutine call or intrinsic statement that prompted the + `log_error` call. + +`errmsg` (optional): shall be a scalar default character + expression. It is an `intent(in)` argument. It should be the + `errmsg` specifier of the subroutine call or intrinsic statement + that prompted the `log_error` call. + +#### Example + +```fortran +module example_mod + use stdlib_logger + + real, allocatable :: a(:) + + type(logger_type) :: logger + + contains + + subroutine example_sub( size) + integer, intent(in) :: size + character(128) :: errmsg, message + integer :: stat + allocate( a(size), stat=stat, errmsg=errmsg ) + if ( stat /= 0 ) then + write( message, '(a, i0)' ) & + "Allocation of A failed with SIZE = ", size + call logger % log_error( message, & + module = 'EXAMPLE_MOD', & + procedure = 'EXAMPLE_SUB', & + stat = stat, & + errmsg = errmsg ) + end if + end subroutine example_sub + +end module example_mod +``` + +### `log_information` - Writes the string `message` to `self % log_units` + +#### Status + +Experimental + +#### Description + +Writes the string `message` to `self % log_units` with optional additional text. + +#### Syntax + +`call self % [[logger_type(type):log_information(bound)]]( message [, module, procedure ] )` + +#### Behavior + +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: '`. + +#### Class + +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. + +`message`: shall be a scalar default character expression. It is an + `intent(in)` argument. + +`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. + +`procedure` (optional): shall be a scalar default character + expression. It is an `intent(in)` argument. It should be the name of + the procedure containing the `log_information` call. + +#### Example + +```fortran +module example_mod + use stdlib_logger + + real, allocatable :: a(:) + + type(logger_type) :: logger + contains + + subroutine example_sub( selection ) + integer, intent(out) :: selection + character(128) :: errmsg, message + integer :: stat + write(*,'(a)') "Enter an integer to select a widget" + read(*,'(i0)') selection + write( message, '(a, i0)' ) & + "The user selected ", selection + call logger % log_information( message, & + module = 'EXAMPLE_MOD', procedure = 'EXAMPLE_SUB' ) + + end subroutine example_sub + +end module example_mod +``` + +### `log_io_error` - Write the string `message` to `self % log_units` + +#### Status + +Experimental + +#### Description + +Writes the string `message` to `self % log_units` with +optional additional text. + +#### Behavior + +If time stamps are active, a time stamp is written +first. Then if `module` or `procedure` are present, they are +written. Then `message` is written with the prefix +`'I/O ERROR: '`. Then if `iostat` or `iomsg` are present they are +written. + +#### Syntax + +`call self % [[logger_type(type):log_io_error(bound)]]( message [, module, procedure, iostat, iomsg ] )` + +#### Class + +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. + +`message`: shall be a scalar default character expression. It is an + `intent(in)` argument. + +`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. + +`procedure` (optional): shall be a scalar default character + expression. It is an `intent(in)` argument. It should be the name of + the procedure containing the `log_io_error` call. + +`iostat` (optional): shall be a scalar default integer + expression. It is an `intent(in)` argument. It should be the + `iostat` specifier of the subroutine call or intrinsic statement + that prompted the `log_io_error` call. + +`iomsg` (optional): shall be a scalar default character + expression. It is an `intent(in)` argument. It should be the + `iomsg` specifier of the subroutine call or intrinsic statement + that prompted the `log_io_error` call. + +#### Example + +```fortran +program demo_log_io_error + use stdlib_logger, global=>global_logger + + character(*), parameter :: filename = 'dummy.txt' + integer :: iostat, lun + character(128) :: iomsg + character(*), parameter :: message = & + 'Failure in opening "dummy.txt".' + + open( newunit=lun, file = filename, form='formatted', & + status='old', iostat=iostat, iomsg=iomsg ) + if ( iostat /= 0 ) then + call global % log_io_error( message, & + procedure = 'EXAMPLE', & + iostat=iostat, & + iomsg = iomsg ) + error stop 'Error on opening a file' + end if + +end program demo_log_io_error +``` + +### `log_message` - write the string `message` to `self % log_units` + +#### Status + +Experimental + +#### Description + +Writes the string `message` to `self % log_units` with + optional additional text. + +#### Behavior + +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`. + +#### Syntax + +`call self % [[logger_type(type):log_message(bound)]]( message [, module, procedure, prefix ] )` + +#### Class + +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. + +`message`: shall be a scalar default character expression. It is an + `intent(in)` argument. + +`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. + +`procedure` (optional): shall be a scalar default character + expression. It is an `intent(in)` argument. It should be the name of + the procedure containing the `log_message` call. + +`prefix` (optional): shall be a scalar default character expression. +It is an `intent(in)` argument. It will precede `message` with an +`': '` appended. + +#### Example + +```fortran +module example_mod + use stdlib_logger + + real, allocatable :: a(:) + + type(logger_type) :: logger + contains + + subroutine example_sub( selection ) + integer, intent(out) :: selection + integer :: stat + write(*,'(a)') "Enter an integer to select a widget" + read(*,'(i0)') selection + write( message, '(a, i0)' ) & + "The user selected ", selection + call logger % log_message( message, & + module = 'EXAMPLE_MOD', & + procedure = 'EXAMPLE_SUB', & + prefix = `INFO' ) + end subroutine example_sub + +end module example_mod +``` + +### `log_text_error` - send a message to `self % log_units` describing an error + +#### Status + +Experimental + +#### Description + +`log_text_error` sends a message to `self % log_units` +describing an error found in a line of text. + +#### Behavior + +If time stamps are active first a time stamp is +written. Then if `filename` or `line_number` are present they are +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. + +#### Syntax + +`call self % [[logger_type(type):log_text_error(bound)]]( line, column, summary [, filename, line_number, caret, stat ] )` + +#### Class + +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. + +`line`: shall be a scalar default character expression. It is an + `intent(in)` argument. It should be the line of text in which the + error was found. + +`column`: shall be a scalar default integer expression. It is an + `intent(in)` argument. It should be the one's based column at which + the error begins. + +`summary`: shall be a scalar default character expression. It is an + `intent(in)` argument. It should be a description of the error in + `line`. + +`filename` (optional): shall be a scalar default character + expression. It is an `intent(in)` argument. It should be the name of + the file, if any, in which `line` was found. + +`line_number` (optional): shall be a scalar default integer + expression. It is an `intent(in)` argument. It should be the line + number in `filename` associated with `line`. + +`caret` (optional): shall be a scalar default single character + expression. It is an `intent(in)` argument. If present it will be + placed below `line` on output to indicate the starting location of + the error. It has a default value of '^'. + +`stat` (optional): shall be a scalar default integer variable. It + is an `intent(out)` argument. If present it will have the value of + `success` if no errors were encountered, the value + `index_invalid_error` if `column` is less than one or greater than + `len(line)+1`, or the value `write_fault` if the writes to any of + `log_units` failed. If `stat` is absent and would not have the value + `success` then processing will stop with an informative stop code. + +#### Example + +```fortran +program demo_log_text_error + use stdlib_logger + + character(*), parameter :: filename = 'dummy.txt' + integer :: col_no, line_no, lun + character(128) :: line + character(*), parameter :: message = 'Bad text found.' + + open( newunit=lun, file = filename, statu='old', & + form='formatted' ) + line_no = 0 + do + read( lun, fmt='(a)', end=900 ) line + line_no = line_no + 1 + call check_line( line, status, col_no ) + if ( status /= 0 ) + call global_logger % log_text_error( line, & + col_no, message, filename, line_no ) + error stop 'Error in reading ' // filename + end if + end do + 900 continue + +end program demo_log_text_error +``` + +### `log_units_assigned` - returns the number of active I/O units + +#### Status + +Experimental + +#### Description + +Returns the number of active I/O units in `self % log_units` + +#### Syntax + +`result = self % [[logger_type(type):log_units_assigned(bound)]]()` + +#### Class + +Elemental function + +#### Argument + +`self`: shall be a scalar expression of type `logger_type`. It is an +`intent(in)` argument. It is the logger whose state is queried. + +#### Result character + +The result shall be a scalar of type default integer. + +#### Result value +The result is the number of I/O units in + `self % log_units`. + +#### Example + +```fortran +module example_mod + use stdlib_logger + + type(logger_type) :: logger + contains + + subroutine example_sub(unit, ...) + integer, intent(in) :: unit + + integer, allocatable :: log_units(:) + + if ( logger % log_units_assigned() == 0 ) then + call logger % add_log_unit( unit ) + end if + + end subroutine example_sub + +end module example_mod +``` + +### `log_warning` - write the string `message` to `log_units` + +#### Status + +Experimental + +#### Description + +Writes the string `message` to `log_units` with + optional additional text. + +#### Behavior + +If time stamps are active, a time stamp is written, +then `module` and `procedure` if present, then +`message` is written with the prefix `WARN: '`. + +#### Syntax + +`call self % [[logger_type(type):log_warning(bound)]]( message [, module, procedure ] )` + +#### Class + +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. + +`message`: shall be a scalar default character expression. It is an + `intent(in)` argument. + +`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. + +`procedure`: (optional) shall be a scalar default character + expression. It is an `intent(in)` argument. It should be the name of + the procedure containing the `log_warning` call. + +#### Example + +```fortran +module example_mod + use stdlib_logger + + real, allocatable :: a(:) + type(logger_type) :: logger + + contains + + subroutine example_sub( size, stat ) + integer, intent(in) :: size + integer, intent(out) :: stat + allocate( a(size) ) + if ( stat /= 0 ) then + write( message, '(a, i0)' ) & + "Allocation of A failed with SIZE = ", size + call logger % log_warning( message, & + module = 'EXAMPLE_MOD', & + procedure = 'EXAMPLE_SUB' ) + end if + end subroutine example_sub + +end module example_mod +``` + +### `remove_log_unit` - remove `unit` from `self % log_units` + +#### Status + +Experimental + +#### Description + +Remove `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 `self % log_units` then nothing is done. + +#### Syntax + +`call self % [[logger_type(type):remove_log_unit(bound)]]( unit [, close_unit, stat ] )` + +#### Class + +Subroutine + +#### Arguments + +`self`: shall be a scalar expression of type `logger_type`. It is an +`intent(inout)` argument. It is the logger whose `log_units` is to be +modified. + +`unit`: shall be a scalar default integer expression. It is an + `intent(in)` argument. It should be one of the I/O `unit` numbers + in `self % log_units`. If it is not, then nothing is done. + +`close_unit` (optional): shall be a scalar default logical + expression. It is an `intent(in)` argument. If `.true` and `unit` is + in `self % log_units` then `unit` will be closed, otherwise the I/O unit + will be unaffected. + +`stat` (optional): shall be a scalar default integer variable. It is + an `intent(out)` argument. If present it has the default value of + `success`, but has the value `close_failure` if `close_unit` is + present with the value `.true.`, and `unit` is initially in + `log_units`, and closing `unit` fails. If `stat` is absent and + closing the `unit` fails then processing stops with an informative + stop code. + +#### Example + +```fortran +module example_mod + use stdlib_logger, global => global_logger + + contains + + subroutine example_sub(unit, ...) + integer, intent(in) :: unit + + call global % remove_log_unit( unit ) + + end subroutine example_sub + +end module example_mod +``` diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index c081f7281..ea7403663 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -33,6 +33,7 @@ set(SRC stdlib_ascii.f90 stdlib_error.f90 stdlib_kinds.f90 + stdlib_logger.f90 stdlib_system.F90 ${outFiles} ) diff --git a/src/Makefile.manual b/src/Makefile.manual index 40d4619be..1c731b9bb 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -2,9 +2,10 @@ SRC = f18estop.f90 \ stdlib_ascii.f90 \ stdlib_error.f90 \ stdlib_io.f90 \ + stdlib_kinds.f90 \ stdlib_linalg.f90 \ stdlib_linalg_diag.f90 \ - stdlib_kinds.f90 \ + stdlib_logger.f90 \ stdlib_optval.f90 \ stdlib_quadrature.f90 \ stdlib_quadrature_trapz.f90 \ @@ -45,6 +46,7 @@ stdlib_io.o: \ stdlib_optval.o \ stdlib_kinds.o stdlib_linalg_diag.o: stdlib_kinds.o +stdlib_logger.o: stdlib_ascii.o stdlib_optval.o stdlib_optval.o: stdlib_kinds.o stdlib_quadrature.o: stdlib_kinds.o stdlib_stats_mean.o: \ diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 new file mode 100644 index 000000000..4ffd85c13 --- /dev/null +++ b/src/stdlib_logger.f90 @@ -0,0 +1,1392 @@ +module stdlib_logger +!!### Module stdlib_logger +!! +!! This module defines a derived type, procedures, a variable, and +!! constants to be used for logging information and reporting errors +!! in Fortran applications. +!!([Specification](../page/specs/stdlib_logger.html)) + +!! The derived type, `logger_type`, is to be used to define variables to +!! serve as both local and global loggers. A logger directs its messages +!! to selected I/O units so the user has a record (a log) of major events. +!! For each entity of `logger_type` the reports go to a list of I/O units +!! represented by the private internal array, `log_units`. If `log_units` is +!! empty then output by default goes to `output_unit`. Otherwise reports +!! go to `output_unit` only if it has been explicitly added to `log_units`. +!! Each entity of type `logger_type` also maintains an internal state +!! controlling the formatting of output. +!! +!! The procedures are as follows. The logical function +!! `log_units_assigned` returns the number of I/O units in `log_units`. The +!! subroutines `add_log_file` and `add_log_unit` include the specified file +!! in `log_units`. `remove_log_units` removes the specified logical unit from +!! the `log_units` array and optionally closes the file. `configure` +!! configures the details of the logging process. `configuration` +!! reports the details of that configuration. The subroutines +!! `log_error`, `log_information`, `log_io_error`, `log_message`, +!! `log_text_error`, and `log_warning` send messages to the log units. +!! +!! The variable `global_logger` of type `logger_type` can be used +!! as a default global logger anywhere in the source code. +!! +!! The constants are used to report errors by some of the subroutines +!! in their optional `stat` arguments. The constants are as follows. +!! `success` indicates that no error has occurred. `close_failure` +!! indicates that a `close` statement for an I/O unit failed. +!! `index_invalid_error` indicates that `column` was invalid for +!! the given `line`. `open_failure` indicates that an `open` statement +!! failed. `read_only_error` indicates that an output unit did not have a +!! `"write"` or `"readwrite"` action. `non_sequential_error` indicates +!! that the unit did not have `sequential` access. `unformatted_in_error` +!! indicates that the unit did not have a `form` of `"formatted"`. +!! `unopened_in_error` indicates that the unit was not opened. `write_failure` +!! indicates that at least one of the writes to `log_units` failed. + + use, intrinsic :: & + iso_fortran_env, only : & + error_unit, & + input_unit, & + output_unit + + use stdlib_ascii, only : to_lower + use stdlib_optval, only : optval + + implicit none + + private + public :: global_logger, logger_type + + !! public constants used as error flags + integer, parameter, public :: & + success = 0, & + close_failure = 1, & + index_invalid_error = 2, & + non_sequential_error = 3, & + open_failure = 4, & + read_only_error = 5, & + unformatted_in_error = 6, & + unopened_in_error = 7, & + write_failure = 8 + + character(*), parameter :: module_name = 'stdlib_logger' + + type :: logger_type + !! version: experimental + + !! 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 + + contains + + private + + procedure, public, pass(self) :: add_log_file + procedure, public, pass(self) :: add_log_unit + procedure, public, pass(self) :: configuration + procedure, public, pass(self) :: configure + procedure, public, pass(self) :: log_error + procedure, public, pass(self) :: log_information + procedure, public, pass(self) :: log_io_error + procedure, public, pass(self) :: log_message + procedure, public, pass(self) :: log_text_error + procedure, public, pass(self) :: log_units_assigned + procedure, public, pass(self) :: log_warning + procedure, public, pass(self) :: remove_log_unit + + final :: final_logger + + end type logger_type + + !! Variable of type `logger_type` to be used as a global logger + type(logger_type) :: global_logger + + character(*), parameter :: & + invalid_column = 'column is not a valid index to line.' + +contains + + subroutine add_log_file( self, filename, unit, action, position, status, & + stat ) +!! version: experimental + +!! Opens a formatted sequential access output file, `filename` using +!! `newunit` and adds the resulting unit number to `self`'s `log_units` +!! 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 +!! `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)) + class(logger_type), intent(inout) :: self +!! The logger variable to which the file is to be added + character(*), intent(in) :: filename +!! The name of the file to be added to the logger + integer, intent(out), optional :: unit +!! The resulting I/O unit number + character(*), intent(in), optional :: action +!! The `action` specifier for the `open`` statement + character(*), intent(in), optional :: position +!! The `position` specifier for the `open` statement + character(*), intent(in), optional :: status +!! The `status` specifier for the `open` statement + 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 +!! * `open_failure` - the `open` statement failed + + +!!##### Example +!! +!! program main +!! use stdlib_logger +!! ... +!! integer :: unit, stat +!! ... +!! call global_logger % add_log_file( 'error_log.txt', unit, & +!! position='asis', stat=stat ) +!! if ( stat /= success ) then +!! error stop 'Unable to open "error_log.txt".' +!! end if +!! ... +!! end program main + + character(16) :: aaction, aposition, astatus + integer :: aunit + character(128) :: iomsg + integer :: iostat + character(*), parameter :: procedure_name = 'add_log_file' + integer, allocatable :: dummy(:) + integer :: lun + integer :: i + + aaction = optval(action, 'write') + aposition = optval(position, 'rewind') + astatus = optval(status, 'replace') + + if ( len_trim(aaction) == 4 ) then + + do i=1, 4 + aaction(i:i) = to_lower(aaction(i:i)) + end do + + if ( aaction == 'read' ) then + if ( present( stat ) ) then + stat = read_only_error + return + else + error stop 'In ' // module_name // ' % ' // & + procedure_name // ' action is "read" which ' // & + 'does not allow writes to the file.' + end if + end if + + end if + + open( newunit=aunit, file=filename, form='formatted', action=aaction, & + position=aposition, status=astatus, iostat=iostat, iomsg=iomsg, & + err=999 ) + + if ( allocated( self % log_units ) ) then + if ( size(self % log_units) == self % units ) then + allocate( dummy(2*self % units) ) + do lun=1, self % units + dummy(lun) = self % log_units(lun) + end do + dummy(self % units+1:) = 0 + call move_alloc( dummy, self % log_units ) + end if + else + allocate( self % log_units(16) ) + end if + + self % log_units(self % units + 1 ) = aunit + self % units = self % units + 1 + if ( present(unit) ) unit = aunit + if ( present(stat) ) stat = success + + return + +999 if (present(stat) ) then + stat = open_failure + return + else + call self % log_io_error( 'Unable to open ' // trim(filename), & + module = module_name, & + procedure = procedure_name, & + iostat = iostat, & + iomsg = iomsg ) + error stop module_name // ' % ' // procedure_name // & + ': Unable to open file' + end if + + end subroutine add_log_file + + + 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 +!! 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)) + + class(logger_type), intent(inout) :: self +!! The logger variable to which the I/O unit is to be added + integer, intent(in) :: unit +!! The input logical unit number + integer, intent(out), optional :: stat +!! An error code with the possible values +!! * `success` - no problems were found +!! * `non_sequential_error` - `unit` did not have sequential access +!! * `read_only_error` - `unit` was not writeable +!! * `unformatted_in_error` - `unit` was an `'unformatted'` file +!! * `unopened_in_error` - `unit` was not opened + +!!##### Example +!! +!! program main +!! use stdlib_logger +!! ... +!! character(256) :: iomsg +!! integer :: iostat, unit, stat +!! ... +!! open( newunit=unit, 'error_log.txt', form='formatted', & +!! status='replace', position='rewind', err=999, & +!! action='read', iostat=iostat, iomsg=iomsg ) +!! ... +!! call global_logger % add_log_unit( unit, stat ) +!! select case ( stat ) +!! ... +!! case ( read_only_error ) +!! error stop 'Unable to write to "error_log.txt".' +!! ... +!! end select +!! ... +!! 999 error stop 'Unable to open "error_log.txt". +!! ... +!! end program main + + integer, allocatable :: dummy(:) + character(*), parameter :: procedure_name = 'set_log_unit' + integer :: lun + character(12) :: specifier + logical :: question + + call validate_unit() + if ( present(stat) ) then + if ( stat /= success ) return + end if + + do lun = 1, self % units +! Check that unit is not already registered + if (self % log_units(lun) == unit ) return + end do + + if ( allocated( self % log_units ) ) then + if ( size(self % log_units) == self % units ) then + allocate( dummy(2*self % units) ) + do lun=1, self % units + dummy(lun) = self % log_units(lun) + end do + call move_alloc( dummy, self % log_units ) + end if + else + allocate( self % log_units(16) ) + end if + + self % log_units(self % units + 1 ) = unit + self % units = self % units + 1 + + contains + + subroutine validate_unit() + +! Check that unit is not input_unit + if ( unit == input_unit ) then + if ( present(stat) ) then + stat = read_only_error + return + else + error stop 'unit in ' // module_name // ' % ' // & + procedure_name // ' must not be input_unit.' + end if + end if + +! Check that unit is opened + inquire( unit, opened=question ) + if ( .not. question ) then + if ( present(stat) ) then + stat = unopened_in_error + return + else + error stop 'unit in ' // module_name // ' % ' // & + procedure_name // ' is not open.' + end if + end if + +! Check that unit is writeable + inquire( unit, write=specifier ) + if ( specifier(1:1) /= 'Y' .and. specifier(1:1) /= 'y' ) then + if ( present(stat) ) then + stat = read_only_error + return + else + error stop 'unit in ' // module_name // ' % ' // & + procedure_name // ' is not writeable.' + end if + end if + + inquire( unit, sequential=specifier ) + if ( specifier(1:1) /= 'Y' .and. specifier(1:1) /= 'y' ) then + if ( present(stat) ) then + stat = non_sequential_error + return + else + error stop 'unit in ' // module_name // ' % ' // & + procedure_name // ' is not "sequential".' + end if + end if + + inquire( unit, formatted=specifier ) + if ( specifier(1:1) /= 'Y' .and. specifier(1:1) /= 'y' ) then + if ( present(stat) ) then + stat = unformatted_in_error + return + else + error stop 'unit in ' // module_name // ' % ' // & + procedure_name // ' is not "formatted".' + end if + end if + + if ( present(stat) ) stat = success + + end subroutine validate_unit + + end subroutine add_log_unit + + + pure subroutine configuration( self, add_blank_line, indent, & + max_width, time_stamp, log_units ) +!! version: experimental + +!! Reports the logging configuration of `self`. The following attributes are +!! reported: +!! 1. `add_blank_line` is a logical flag with `.true.` implying that output +!! 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 +!! `max_width` == 0 => no bounds on output width. +!! 4. `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 +!! will be written. +!!([Specification](../page/specs/stdlib_logger.html#configuration-report-a-loggers-configuration)) + + class(logger_type), intent(in) :: self +!! The logger variable whose configuration is being reported + logical, intent(out), optional :: add_blank_line +!! 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 :: max_width +!! The maximum number of columns for most outputs + logical, intent(out), optional :: time_stamp +!! A logical flag to add a time stamp + integer, intent(out), allocatable, optional :: log_units(:) +!! The I/O units used in output + +!!##### Example +!! +!! module example_mod +!! use stdlib_logger +!! ... +!! contains +!! ... +!! subroutine example_sub(unit, ...) +!! integer, intent(in) :: unit +!! ... +!! integer, allocatable :: log_units(:) +!! ... +!! call global_logger % configuration( log_units=log_units ) +!! if ( size(log_units) == 0 ) then +!! call add_logger_unit( unit ) +!! end if +!! .. +!! end subroutine example_sub +!! ... +!! end module example_mod + + if ( present(add_blank_line) ) add_blank_line = self % add_blank_line + if ( present(indent) ) indent = self % indent_lines + if ( present(max_width) ) max_width = self % max_width + if ( present(time_stamp) ) time_stamp = self % time_stamp + if ( present(log_units) ) log_units = self % log_units(1:self % units) + + end subroutine configuration + + + pure subroutine configure( self, add_blank_line, indent, max_width, & + time_stamp ) +!! version: experimental + +!! Configures the logging process for SELF. The following attributes are +!! configured: +!! 1. `add_blank_line` is a logical flag with `.true.` implying that output +!! starts with a blank line, and `.false.` implying no blank line. +!! `add_blank_line` has a startup value of `.false.`. +!! 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 +!! `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 +!! 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)) +!!##### Example +!! +!! program main +!! use stdlib_logger +!! ... +!! call global_logger % configure( indent=.false., max_width=72 ) +!! ... + + class(logger_type), intent(inout) :: self + logical, intent(in), optional :: add_blank_line + logical, intent(in), optional :: indent + 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(indent) ) self % indent_lines = indent + if ( present(max_width) ) then + if ( max_width <= 4 ) then + self % max_width = 0 + else + self % max_width = max_width + end if + end if + if ( present(time_stamp) ) self % time_stamp = time_stamp + + end subroutine configure + + + subroutine final_logger( self ) +!! version: experimental + +!! Finalizes the `logger_type` entity `self` by flushing the units + type(logger_type), intent(in) :: self + + integer :: iostat + character(256) :: message + integer :: unit + + 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 = ', & + self % log_units(unit) + write(error_unit, '(a, i0)') 'With iostat = ', iostat + write(error_unit, '(a)') 'With iomsg = ' // trim(message) + end if + end do + + end subroutine final_logger + + + subroutine format_output_string( self, unit, string, procedure_name, & + 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 + + integer :: count, indent_len, index, iostat, length, remain + character(256) :: iomsg + + length = len_trim(string) + indent_len = len(col_indent) + call format_first_line() + + if ( self % indent_lines ) then + do while( remain > 0 ) + call indent_format_subsequent_line() + end do + else + do while( remain > 0 ) + call format_subsequent_line() + end do + end if + + contains + + subroutine format_first_line() + + if ( length <= self % max_width .or. self % max_width == 0 ) then + write( unit, '(a)', err=999, iostat=iostat, iomsg=iomsg ) & + string(1:length) + remain = 0 + return + else + + do index=self % max_width, 1, -1 + if ( string(index:index) == ' ' ) exit + end do + + if ( index == 0 ) then + write( unit, '(a)', err=999, iostat=iostat, iomsg=iomsg ) & + string(1: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) + count = index + remain = length - count + return + end if + + end if + +999 call handle_write_failure( unit, procedure_name, iostat, iomsg ) + + end subroutine format_first_line + + subroutine format_subsequent_line() + + if ( remain <= self % max_width ) then + write( unit, '(a)', err=999, iostat=iostat, iomsg=iomsg ) & + string(count+1:length) + count = length + remain = 0 + return + else + + do index=count+self % max_width, count+1, -1 + if ( string(index:index) == ' ' ) exit + end do + + if ( index == count ) then + write( unit, '(a)', err=999, iostat=iostat, iomsg=iomsg ) & + string(count+1:count+self % max_width) + count = count + self % max_width + remain = length - count + return + else + write( unit, '(a)', err=999, iostat=iostat, iomsg=iomsg ) & + string(count+1:index) + count = index + remain = length - count + return + end if + + end if + +999 call handle_write_failure( unit, procedure_name, iostat, iomsg ) + + end subroutine format_subsequent_line + + subroutine indent_format_subsequent_line() + + if ( remain <= self % max_width - indent_len ) then + write( unit, '(a)', err=999, iostat=iostat, iomsg=iomsg ) & + col_indent // string(count+1:length) + count = length + remain = 0 + return + else + + do index=count+self % max_width-indent_len, count+1, -1 + if ( string(index:index) == ' ' ) exit + end do + + if ( index == count ) then + write( unit, '(a)', err=999, iostat=iostat, iomsg=iomsg ) & + col_indent // & + string(count+1:count+self % max_width-indent_len) + 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) + count = index + remain = length - count + return + end if + + end if + +999 call handle_write_failure( unit, procedure_name, iostat, iomsg ) + + end subroutine indent_format_subsequent_line + + end subroutine format_output_string + + + subroutine handle_write_failure( unit, procedure_name, iostat, iomsg ) +!! version: experimental + +!! Handles a failure to write to `unit` in `procedure_name` with `iostat` and +!! `iomsg` by writing a description of the failure to `output_unit` and +!! stopping. + integer, intent(in) :: unit + character(*), intent(in) :: procedure_name + integer, intent(in) :: iostat + character(*), intent(in) :: iomsg + + character(256) :: name + logical :: named + character(10) :: action + + 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) + else + write( output_unit, '(a)' ) 'unit is unnamed' + 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 // '.' + + end subroutine handle_write_failure + + + subroutine log_error( self, message, module, procedure, stat, errmsg ) +!! version: experimental + +!! Writes the string `message` to `self % log_units` with optional additional +!! text. +!! ([Specification](../specs/stdlib_logger.html#log_error-writes-the-string-message-to-self-log_units)) + +!!##### Behavior +!! +!! If time stamps are active, a time stamp is written, 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. +!! +!!##### Example +!! +!! module example_mod +!! use stdlib_logger +!! ... +!! real, allocatable :: a(:) +!! ... +!! type(logger_type) :: alogger +!! ... +!! contains +!! ... +!! subroutine example_sub( size ) +!! integer, intent(in) :: size +!! character(128) :: errmsg, message +!! integer :: stat +!! allocate( a(size), stat=stat, errmsg=errmsg ) +!! if ( stat /= 0 ) then +!! write( message, `(a, i0)' ) & +!! "Allocation of A failed with SIZE = ", size +!! alogger % call log_error( message, & +!! module = 'EXAMPLE_MOD', & +!! procedure = 'EXAMPLE_SUB', & +!! stat = stat, & +!! errmsg = errmsg ) +!! end if +!! end subroutine example_sub +!! ... +!! end module example_mod +!! + + class(logger_type), intent(in) :: self +!! The logger to be used in logging 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_error` + character(len=*), intent(in), optional :: procedure +!! The name of the procedure contining 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 +!! The value of the `errmsg` specifier returned by a Fortran statement + + integer :: unit + integer :: iostat + character(*), parameter :: procedure_name = 'log_error' + character(256) :: iomsg + + call self % log_message( message, & + module = module, & + procedure = procedure, & + prefix = 'ERROR') + + if ( self % units == 0 ) then + call write_log_error( output_unit ) + else + do unit=1, self % units + call write_log_error( self % log_units(unit) ) + end do + 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 + end if + + return + +999 call handle_write_failure( unit, procedure_name, iostat, iomsg ) + + end subroutine write_log_error + + end subroutine log_error + + + subroutine log_information( self, message, module, procedure ) +!! version: experimental + +!! Writes the string `message` to `self % log_units` with optional additional +!! text. +!!([Specification](../page/specs/stdlib_logger.html#log_information-writes-the-string-message-to-self-log_units)) +!! +!!##### Behavior +!! +!! 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: '. +!! +!!##### Example +!! +!! module example_mod +!! use stdlib_logger +!! ... +!! real, allocatable :: a(:) +!! ... +!! type(logger_type) :: alogger +!! ... +!! contains +!! ... +!! subroutine example_sub( selection ) +!! integer, intent(out) :: selection +!! integer :: stat +!! write(*,'(a)') "Enter an integer to select a widget" +!! read(*,'(i0)') selection +!! write( message, `(a, i0)' ) & +!! "The user selected ", selection +!! call alogger % log_information( message, & +!! module = 'EXAMPLE_MOD', & +!! procedure = 'EXAMPLE_SUB' ) +!! ... +!! end subroutine example_sub +!! ... +!! end module example_mod +!! + + class(logger_type), intent(in) :: 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` + + call self % log_message( message, & + module = module, & + procedure = procedure, & + prefix = 'INFO' ) + + end subroutine log_information + + + subroutine log_io_error( self, message, module, procedure, iostat, & + iomsg ) +!! version: experimental + +!! Writes the string `message` to the `self % log_units` with optional +!! additional text. +!!([Specification](../page/specs/stdlib_logger.html#log_io_error-write-the-string-message-to-self-log_units)) +!! +!!##### Behavior +!! +!! If time stamps are active, a time stamp is written, followed by +!! `module` and `procedure` if present, then `message` is +!! written with a prefix 'I/O ERROR: ', and then if `iostat` or `iomsg` +!! are present they are also written. +!! +!!##### Example +!! +!! program example +!! use stdlib_logger +!! ... +!! character(*), parameter :: filename = 'dummy.txt' +!! integer :: iostat, lun +!! character(128) :: iomsg +!! character(*), parameter :: message = 'Failure in opening "dummy.txt".' +!! +!! open( newunit=lun, file = filename, form='formatted', & +!! status='old', iostat=iostat, iomsg=iomsg ) +!! if ( iostat /= 0 ) then +!! call global_logger % log_io_error( message, procedure = 'EXAMPLE', & +!! iostat=iostat, iomsg = iomsg ) +!! error stop 'Error on opening ' // filename +!! end if +!! ... +!! end program example + + class(logger_type), intent(in) :: self +!! The logger variable to receivee 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 REPORT_ERROR + character(len=*), intent(in), optional :: procedure +!! The name of the procedure contining 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 +!! The value of the IOMSG specifier returned by a Fortran I/O statement + + integer :: unit + integer :: iostat2 + character(*), parameter :: procedure_name = 'log_error' + character(256) :: iomsg2 + + 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 ) + else + do unit=1, self % units + call write_log_io_error( self % log_units(unit) ) + end do + 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 + end if + + return + +999 call handle_write_failure( unit, procedure_name, iostat, iomsg ) + + end subroutine write_log_io_error + + end subroutine log_io_error + + subroutine log_message( self, message, module, procedure, prefix ) +!! version: experimental + +!! Writes the string `message` to the `self % log_units` with optional +!! additional text. +!!([Specification](../page/specs/stdlib_logger.html#log_message-write-the-string-message-to-self-log_units)) +!! +!!##### Behavior +!! +!! If time stamps are active, a time stamp is written, followed by `module` +!! and `procedure` if present, followed by `prefix // ': '` if present, +!! and then `message`. +!! +!!##### Example +!! +!! module example_mod +!! use stdlib_logger +!! ... +!! real, allocatable :: a(:) +!! ... +!! contains +!! ... +!! subroutine example_sub( selection ) +!! integer, intent(out) :: selection +!! integer :: stat +!! write(*,'(a)') "Enter an integer to select a widget" +!! read(*,'(i0)') selection +!! write( message, `(a, i0)' ) & +!! "The user selected ", selection +!! call global_logger % log_message( message, & +!! module = 'example_mod', & +!! procedure = 'example_sub', & +!! prefix = 'info' ) +!! end subroutine example_sub +!! ... +!! end module example_mod +!! + + class(logger_type), intent(in) :: self +!! The logger variable to receive 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_message` + character(len=*), intent(in), optional :: procedure +!! The name of the procedure contining the current invocation of `log_message` + character(len=*), intent(in), optional :: prefix +!! To be prepended to message as `prefix // ': ' // message`. + + integer :: unit + integer :: iostat + character(*), parameter :: procedure_name = 'log_message' + character(256) :: iomsg + character(:), allocatable :: d_and_t, m_and_p, pref + + if ( present(prefix) ) then + pref = prefix // ': ' + else + pref = '' + end if + + if ( self % time_stamp ) then + d_and_t = time_stamp() // ': ' + else + d_and_t = '' + end if + + if ( present(module) ) then + if ( present(procedure) ) then + m_and_p = trim(module) // ' % ' // trim(procedure) // ': ' + else + m_and_p = trim(module) // ': ' + end if + else if ( present(procedure) ) then + m_and_p = trim(procedure) // ': ' + else + m_and_p = '' + end if + + if ( self % units == 0 ) then + call write_log_message( output_unit ) + else + do unit=1, self % units + call write_log_message( self % log_units(unit) ) + end do + end if + + contains + + subroutine write_log_message( unit ) + integer, intent(in) :: unit + + 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 ) + + end subroutine write_log_message + + end subroutine log_message + + subroutine log_text_error( self, line, column, summary, filename, & + line_number, caret, stat ) +!! version: experimental + +!! Sends a message to `self % log_units` describing an error found +!! in a line of text. +!!([Specification](../page/specs/stdlib_logger.html#log_text_error-send-a-message-to-self-log_units-describing-an-error)) + +!!##### Behavior +!! +!! 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. +! +!!##### Example +!! +!! program example +!! ... +!! character(*), parameter :: filename = 'dummy.txt' +!! integer :: col_num, line_num, lun +!! character(128) :: line +!! character(*), parameter :: message = 'Bad text found.' +!! +!! open( newunit=lun, file = filename, statu='old', form='formatted' ) +!! line_num = 0 +!! do +!! read( lun, fmt='(a)', end=900 ) line +!! line_num = line_num + 1 +!! call check_line( line, status, col_num ) +!! if ( status /= 0 ) +!! call global_logger % log_text_error( line, col_num, message, & +!! filename, line_num ) +!! error stop 'Error in reading ' // filename +!! end if +!! ... +!! end do +!!900 continue +!! ... +!! end program example +!! + class(logger_type), intent(in) :: self +!! The logger variable to receive the message + character(*), intent(in) :: line +!! The line of text in which the error was found. + integer, intent(in) :: column +!! The one's based column in LINE at which the error starts. + character(*), intent(in) :: summary +!! A brief description of the error. + character(*), intent(in), optional :: filename +!! The name of the file, if any, in which the error was found. + integer, intent(in), optional :: line_number +!! The one's based line number in the file where `line` was found. + character(1), intent(in), optional :: caret +!! The symbol used to mark the column wher the error was first detected + 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. + + character(1) :: acaret + character(5) :: num + character(:), allocatable :: fmt + character(128) :: iomsg + integer :: iostat + integer :: lun + character(*), parameter :: procedure_name = 'LOG_TEXT_ERROR' + + acaret = optval(caret, '^') + + if ( column < 0 .or. column > len( line ) + 1 ) then + if ( present(stat) ) then + stat = index_invalid_error + return + else + call self % log_error( invalid_column, & + module = module_name, & + procedure = procedure_name ) + error stop module_name // ' % ' // procedure_name // ': ' // & + invalid_column + end if + end if + + write(num, '(i0)') column-1 + fmt = '(' // trim(num) // 'x, a)' + + if ( self % units == 0 ) then + call write_log_text_error( output_unit ) + else + do lun=1, self % units + call write_log_text_error( self % log_units(lun) ) + + end do + end if + + 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() + + if ( present(filename) ) then + if ( present(line_number) ) then + write( unit, '(a,":", i0, ":", i0)', err=999, & + iomsg=iomsg, iostat=iostat ) & + trim(filename) , line_number, column + else + write( unit, '(a, i0)', err=999, iomsg=iomsg, & + iostat=iostat ) & + "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 ) & + 'Error found at line number: ', line_number, & + ', and column: ', column + else + write( unit, '("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) + + if ( present(stat) ) stat = success + + return + +999 if ( present( stat ) ) then + stat = write_failure + return + + else + call handle_write_failure( unit, procedure_name, iostat, & + iomsg ) + + end if + + end subroutine write_log_text_error + + end subroutine log_text_error + + + elemental function log_units_assigned(self) +!! version: experimental + +!! Returns the number of units assigned to `self % log_units` +!!([Specification](../page/specs/stdlib_logger.html#log_units_assigned-returns-the-number-of-active-io-units)) + + class(logger_type), intent(in) :: self +!! The logger subject to the inquiry + integer :: log_units_assigned +!!##### Example +!! +!! module example_mod +!! use stdlib_logger +!! ... +!! type(logger_type) :: alogger +!! ... +!! contains +!! ... +!! subroutine example_sub(unit, ...) +!! integer, intent(in) :: unit +!! ... +!! integer, allocatable :: log_units(:) +!! ... +!! if ( alogger % log_units_assigned() == 0 ) then +!! call alogger % add_log_unit( unit ) +!! end if +!! ... +!! end subroutine example_sub +!! ... +!! end module example_mod + + log_units_assigned = self % units + + 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. +!!([Specification](../page/specs/stdlib_logger.html#log_warning-write-the-string-message-to-log_units)) + +!!##### Behavior +!! +!! If time stamps are active, a time stamp is written, followed by +!! `module` and `procedure` if present, then `message` is +!! written with the prefix 'WARN: '. +!! +!!##### Example +!! +!! module example_mod +!! use stdlib_logger +!! ... +!! real, allocatable :: a(:) +!! ... +!! type(logger_type) :: alogger +!! ... +!! contains +!! ... +!! subroutine example_sub( size, stat ) +!! integer, intent(in) :: size +!! integer, intent(out) :: stat +!! allocate( a(size) ) +!! if ( stat /= 0 ) then +!! write( message, `(a, i0)' ) & +!! "Allocation of A failed with SIZE = ", size +!! call alogger % log_warning( message, & +!! module = 'EXAMPLE_MOD', & +!! procedure = 'EXAMPLE_SUB' ) +!! end if +!! end subroutine example_sub +!! ... +!! end module example_mod +!! + class(logger_type), intent(in) :: self +!! The logger to which the message is written + 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` + character(len=*), intent(in), optional :: procedure +!! The name of the procedure contining the current invocation of `log_warning` + + call self % log_message( message, & + module = module, & + procedure = procedure, & + prefix = 'WARN' ) + + end subroutine log_warning + + + subroutine remove_log_unit( self, unit, close_unit, stat ) +!! version: experimental + +!! 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. +!!([Specification](../page/specs/stdlib_logger.html#remove_log_unit-remove-unit-from-self-log_units)) + + class(logger_type), intent(inout) :: self +!! The logger variable whose unit is to be removed + integer, intent(in) :: unit +!! The I/O unit to be removed from self + logical, intent(in), optional :: close_unit +!! A logical flag to close the unit while removing it from the SELF list + integer, intent(out), optional :: stat +!! An error status with the values +!! * success - no problems found +!! * close_failure - the close statement for unit failed +!! +!!##### Example +!! +!! module example_mod +!! use stdlib_logger +!! ... +!! type(logger_type) :: alogger +!! contains +!! ... +!! subroutine example_sub(unit, ...) +!! integer, intent(in) :: unit +!! ... +!! call alogger % remove_log_unit( unit ) +!! ... +!! end subroutine example_sub +!! ... +!! end module example_mod + + character(128) :: errmsg + integer :: lun, lun_old + character(*), parameter :: procedure_name = 'REMOVE_LOG_UNIT' + + if ( present(stat) ) stat = success + do lun=1, self % units + if ( unit == self % log_units(lun) ) exit + end do + + if ( lun == self % units + 1 ) return + + if ( present(close_unit) ) then + if ( close_unit ) close( unit, err=999, iomsg=errmsg ) + end if + + do lun_old=lun+1, self % units + self % log_units(lun_old-1) = self % log_units(lun_old) + end do + self % units = self % units - 1 + + return + +999 if ( present(stat) ) then + stat = close_failure + return + else + write(*, '(a, i0)') 'In ' // module_name // ' % ' // & + procedure_name // ' close_unit failed for unit = ', unit + write(*, '(a)' ) 'With iomsg = ' // trim(errmsg) + error stop 'close_unit failed in ' // module_name // ' % ' // & + procedure_name // '.' + end if + + end subroutine remove_log_unit + + + function time_stamp() +!! Creates a time stamp in the format 'yyyy-mm-dd hh:mm:ss.sss' + character(23) :: time_stamp + character(8) :: date + character(10) :: time + + call date_and_time( date, time ) + + time_stamp(1:4) = date(1:4) + time_stamp(5:5) = '-' + time_stamp(6:7) = date(5:6) + time_stamp(8:8) = '-' + time_stamp(9:10) = date(7:8) + time_stamp(11:11) = ' ' + time_stamp(12:13) = time(1:2) + time_stamp(14:14) = ':' + time_stamp(15:16) = time(3:4) + time_stamp(17:17) = ':' + time_stamp(18:23) = time(5:10) + + end function time_stamp + +end module stdlib_logger diff --git a/src/tests/CMakeLists.txt b/src/tests/CMakeLists.txt index 593d261b6..9e341d380 100644 --- a/src/tests/CMakeLists.txt +++ b/src/tests/CMakeLists.txt @@ -9,6 +9,7 @@ endmacro(ADDTEST) add_subdirectory(ascii) add_subdirectory(io) add_subdirectory(linalg) +add_subdirectory(logger) add_subdirectory(optval) add_subdirectory(stats) add_subdirectory(system) diff --git a/src/tests/Makefile.manual b/src/tests/Makefile.manual index d7c1fd8ad..9b0227232 100644 --- a/src/tests/Makefile.manual +++ b/src/tests/Makefile.manual @@ -3,6 +3,7 @@ all: $(MAKE) -f Makefile.manual --directory=ascii $(MAKE) -f Makefile.manual --directory=io + $(MAKE) -f Makefile.manual --directory=logger $(MAKE) -f Makefile.manual --directory=optval $(MAKE) -f Makefile.manual --directory=quadrature $(MAKE) -f Makefile.manual --directory=stats @@ -10,6 +11,7 @@ all: test: $(MAKE) -f Makefile.manual --directory=ascii test $(MAKE) -f Makefile.manual --directory=io test + $(MAKE) -f Makefile.manual --directory=logger test $(MAKE) -f Makefile.manual --directory=optval test $(MAKE) -f Makefile.manual --directory=quadrature test $(MAKE) -f Makefile.manual --directory=stats test @@ -17,5 +19,6 @@ test: clean: $(MAKE) -f Makefile.manual --directory=ascii clean $(MAKE) -f Makefile.manual --directory=io clean + $(MAKE) -f Makefile.manual --directory=logger clean $(MAKE) -f Makefile.manual --directory=optval clean $(MAKE) -f Makefile.manual --directory=stats clean diff --git a/src/tests/logger/CMakeLists.txt b/src/tests/logger/CMakeLists.txt new file mode 100644 index 000000000..7c25b384c --- /dev/null +++ b/src/tests/logger/CMakeLists.txt @@ -0,0 +1 @@ +ADDTEST(stdlib_logger) diff --git a/src/tests/logger/Makefile.manual b/src/tests/logger/Makefile.manual new file mode 100644 index 000000000..cea74fcd7 --- /dev/null +++ b/src/tests/logger/Makefile.manual @@ -0,0 +1,4 @@ +PROGS_SRC = test_stdlib_logger.f90 + + +include ../Makefile.manual.test.mk diff --git a/src/tests/logger/test_stdlib_logger.f90 b/src/tests/logger/test_stdlib_logger.f90 new file mode 100644 index 000000000..99c726e13 --- /dev/null +++ b/src/tests/logger/test_stdlib_logger.f90 @@ -0,0 +1,613 @@ +program test_stdlib_logger +!! A test code for most of stdlib_logger.f90. + + use, intrinsic :: & + iso_fortran_env, only : & + error_unit, & + input_unit, & + output_unit + + use stdlib_logger, global => global_logger + + implicit none + + integer, allocatable :: log_units(:) + integer :: max_width, stat + integer :: unit1, unit2, unit3, unit4, unit5, unit6 + logical :: add_blank_line, exist, indent, time_stamp + + if ( global % log_units_assigned() == 0 ) then + write(*,*) 'Start off with 0 LOG_UNITS as expected.' + + else + error stop 'Unexpected start off with non_zero LOG_UNITS.' + + end if + + call test_logging_configuration() + + call test_adding_log_files() + + print * + print *, 'running test of log_error' + call global % log_error( 'This message should be output to five ' // & + 'files and not to OUTPUT_UNIT, limited to 72 columns width, ' // & + 'preceded by no blank line, then by a time stamp, then by ' // & + 'MODULE % PROCEDURE, be prefixed by ERROR and be indented on ' // & + 'subsequent lines by 4 columns, and finish with STAT and.' // & + 'ERRMSG lines.', & + module = 'N/A', & + procedure = 'TEST_STDLIB_LOGGER', & + stat = 0, & + errmsg = 'This is a long ERRMSG intended to test formatting ' // & + 'of the ERRMSG when it is more than 72 columns wide.' ) + + call test_removing_log_units() + + 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.', & + column = 25, & + summary = 'There is no real error here.', & + filename = 'dummy.txt', & + line_number = 0, & + caret = '1', & + stat = stat ) + +! call global % assert( 1 < 0, '1 < 0 ; Test of ASSERT', module='N/A', & +! procedure = 'TEST_SDLIB_LOGGER' ) + + call test_adding_log_units() + + print * + print *, 'running log_text_error' + call global % log_text_error( 'This text should be written to ' // & + 'UNIT1, UNIT2, and OUTPUT_UNIT.', & + column = 25, & + summary = 'There is no real error here.', & + filename = 'dummy.txt', & + line_number = 0, & + caret = '^', & + stat = stat ) + + +contains + + subroutine test_logging_configuration() + + print *, 'running test_logging_configuration' + + call global % configuration( add_blank_line=add_blank_line, & + indent=indent, max_width=max_width, time_stamp=time_stamp, & + log_units=log_units ) + + if ( .not. add_blank_line ) then + write(*,*) 'ADD_BLANK_LINE starts off as .FALSE. as expected.' + + else + error stop 'ADD_BLANK_LINE starts off as .TRUE. contrary to ' // & + 'expectations.' + + end if + + if ( indent ) then + write(*,*) 'INDENT starts off as .TRUE. as expected.' + + else + error stop 'INDENT starts off as .FALSE. contrary to expectations.' + + end if + + if ( max_width == 0 ) then + write(*,*) 'MAX_WIDTH starts off as 0 as expected.' + + else + error stop 'MAX_WIDTH starts off as not equal to 0 contrary ' // & + 'to expectations.' + + end if + + if ( time_stamp ) then + write(*,*) 'TIME_STAMP starts off as .TRUE. as expected.' + + else + error stop 'TIME_STAMP starts off as .FALSE. contrary to ' // & + 'expectations.' + + end if + + if ( size(log_units) == 0 ) then + write(*,*) 'SIZE(LOG_UNITS) starts off as 0 as expected.' + + else + error stop 'SIZE(LOG_UNITS) starts off as non-zero contrary ' // & + 'to expectations.' + + end if + + call global % log_information( 'This message should be output ' // & + 'to OUTPUT_UNIT, unlimited in width, not preceded by ' // & + 'a blank line, then by a time stamp, then by MODULE % ' // & + 'PROCEDURE, be prefixed by INFO and be indented on ' // & + 'subsequent lines by 4 columns.', & + module = 'N/A', & + procedure = 'TEST_STDLIB_LOGGER' ) + + call global % configure( add_blank_line=.true., indent=.false., & + max_width=72, time_stamp=.false. ) + + call global % configuration( add_blank_line=add_blank_line, & + indent=indent, max_width=max_width, time_stamp=time_stamp, & + log_units=log_units ) + + if ( add_blank_line ) then + write(*,*) 'ADD_BLANK_LINE is now .FALSE. as expected.' + + else + error stop 'ADD_BLANKLINE is now .FALSE. contrary to expectations.' + + end if + + if ( .not. indent ) then + write(*,*) 'INDENT is now .FALSE. as expected.' + + else + error stop 'INDENT is now .TRUE. contrary to expectations.' + + end if + + if ( max_width == 72 ) then + write(*,*) 'MAX_WIDTH is now 72 as expected.' + + else + error stop 'MAX_WIDTH is not equal to 72 contrary to expectations.' + + end if + + if ( .not. time_stamp ) then + write(*,*) 'TIME_STAMP is now .FALSE. as expected.' + + else + error stop 'TIME_STAMP starts off as .FALSE. contrary to ' // & + 'expectations.' + + end if + + if ( size(log_units) == 0 ) then + write(*,*) 'SIZE(LOG_UNITS) is still 0 as expected.' + + else + error stop 'SIZE(LOG_UNITS) is now non-zero contrary to ' // & + 'expectations.' + + end if + + call global % log_message( 'This message should still be output ' // & + 'to OUTPUT_UNIT, limited to 72 columns width, preceded by ' // & + 'a blank line, then by no time stamp, then by MODULE % ' // & + 'PROCEDURE, have no prefix, and be unindented on subsequent ' // & + 'lines.', & + module = 'N/A', & + procedure = 'TEST_STDLIB_LOGGER' ) + + call global % configure( add_blank_line=.false., indent=.true., & + max_width=72, time_stamp=.true. ) + + call global % log_warning( 'This message should still be ' // & + 'output to OUTPUT_UNIT, limited to 72 columns width, ' // & + 'preceded by no blank line, then by a time stamp, then ' // & + 'by MODULE % PROCEDURE, have a prefix of WARN, and be ' // & + 'indented by 4 columns on subsequent lines.', & + module = 'N/A', & + procedure = 'TEST_STDLIB_LOGGER' ) + + end subroutine test_logging_configuration + + + subroutine test_adding_log_files() + + print * + print *, 'running test_adding_log_files' + + call global % add_log_file( 'first_log_file.txt', unit1, stat=stat ) + if ( stat == success ) then + write(*,*) 'Able to open "first_log_file.txt" as expected' + + else + error stop 'Unable to open "first_log_file.txt" contrary to ' // & + 'expectations.' + + end if + + if ( global % log_units_assigned() == 1 ) then + write(*,*) 'Incremented to 1 LOG_UNITS as expected.' + + else + error stop 'Unexpected increment to other than 1 LOG_UNITS.' + + end if + + call global % add_log_file( 'second_log_file.txt', unit2, & + action='readwrite', stat=stat ) + if ( stat == success ) then + write(*,*) 'Able to open "second_log_file.txt" as expected' + + else + error stop 'Unable to open "second_log_file.txt" contrary to ' // & + 'expectations.' + + end if + + if ( global % log_units_assigned() == 2 ) then + write(*,*) 'Incremented to 2 LOG_UNITS as expected.' + + else + error stop 'Unexpected increment to other than 2 LOG_UNITS.' + + end if + + call global %add_log_file( 'third_log_file.txt', unit3, & + position='asis', stat=stat ) + if ( stat == success ) then + write(*,*) 'Able to open "third_log_file.txt" as expected' + + else + error stop 'Unable to open "third_log_file.txt" as contrary ' // & + 'to expectations.' + + end if + + if ( global % log_units_assigned() == 3 ) then + write(*,*) 'Incremented to 3 LOG_UNITS as expected.' + + else + error stop 'Unexpected increment to other than 3 LOG_UNITS.' + + end if + + call global % add_log_file( 'fourth_log_file.txt', unit4, & + status='new', stat=stat ) + if ( stat /= success ) then + inquire( file='fourth_log_file.txt', exist=exist ) + write(*,*) 'Unable to OPEN "fourth_log_file.txt" as "NEW" ' // & + 'as it already exists, which is an expected result.' + call global % add_log_file( 'fourth_log_file.txt', unit4, & + status='old', position='rewind', stat=stat ) + + if ( stat /= success ) then + error stop 'Unable to open "fourth_log_file.txt" as "OLD".' + + end if + + end if + + if ( global % log_units_assigned() == 4 ) then + write(*,*) 'Incremented to 4 LOG_UNITS as expected.' + + else + error stop 'Unexpected increment to other than 4 LOG_UNITS.' + + end if + + call global % add_log_file( 'fifth_log_file.txt', unit5, & + action='READ', stat=stat ) + if ( stat /= success ) then + if ( stat == read_only_error ) then + write(*,*) 'Unable to OPEN "fifth_log_file.txt" as ' // & + '"READ", as it makes it read only, which is an ' // & + 'expected result.' + call global % add_log_file( 'fifth_log_file.txt', unit5, & + action='write', stat=stat ) + if ( stat /= success ) then + error stop 'Unable to open "fifth_log_file.txt" as "WRITE".' + + end if + + end if + + end if + + if ( global % log_units_assigned() == 5 ) then + write(*,*) 'Incremented to 5 LOG_UNITS as expected.' + + else + error stop 'Unexpected increment to other than 5 LOG_UNITS.' + + end if + + end subroutine test_adding_log_files + + subroutine test_removing_log_units() + + logical :: opened + + print * + print *, 'running test_removing_log_units' + call global % remove_log_unit( unit5 ) + if ( global % log_units_assigned() == 4 ) then + write(*,*) 'Decremented to 4 LOG_UNITS as expected.' + + else + error stop 'Unexpected change to other than 4 LOG_UNITS.' + + end if + + call global % remove_log_unit( unit5 ) +! Should do nothing as already removed + if ( global % log_units_assigned() == 4 ) then + write(*,*) 'Remained at 4 LOG_UNITS as expected.' + + else + error stop 'Unexpected change to other than 4 LOG_UNITS.' + + end if + + inquire( unit4, opened=opened ) + if ( opened ) then + write(*,*) 'UNIT4 is OPENED as expected.' + + else + error stop 'UNIT4 is not OPENED contrary to expectations.' + + end if + + call global % remove_log_unit( unit4, close_unit=.true., stat=stat ) + if ( stat /= success ) then + error stop 'Unable to close UNIT4 in REMOVE_LOG_UNIT.' + + end if + + if ( global % log_units_assigned() == 3 ) then + write(*,*) 'Decremented to 3 LOG_UNITS as expected.' + + else + error stop 'Unexpected change to other than 3 LOG_UNITS.' + + end if + + inquire( unit4, opened=opened ) + if ( opened ) then + error stop 'UNIT4 is opened contrary to expectations.' + + else + write(*,*) 'UNIT4 is not opened as expected.' + + end if + + call global % configuration( log_units=log_units ) + if ( unit1 == log_units(1) .and. unit2 == log_units(2) .and. & + unit3 == log_units(3) ) then + write(*,*) 'Units have retained their expected ordering' + + else + error stop 'Units have not retained their expected ordering' + + end if + + call global % remove_log_unit( unit4, close_unit=.true., stat=stat ) + if ( stat /= success ) then + error stop 'Attempted to close UNIT4 in REMOVE_LOG_UNIT and failed.' + + end if + + if ( global % log_units_assigned() == 3 ) then + write(*,*) 'Remained at 3 LOG_UNITS as expected.' + + else + error stop 'Unexpected change to other than 3 LOG_UNITS.' + + end if + + call global % configuration( log_units=log_units ) + if ( unit1 == log_units(1) .and. unit2 == log_units(2) .and. & + unit3 == log_units(3) ) then + write(*,*) 'Units have retained their expected ordering' + + else + error stop 'Units have not retained their expected ordering' + + end if + + call global % remove_log_unit( unit2 ) + + if ( global % log_units_assigned() == 2 ) then + write(*,*) 'Decremented to 2 LOG_UNITS as expected.' + + else + error stop 'Unexpected change to other than 2 LOG_UNITS.' + + end if + call global % configuration( log_units=log_units ) + if ( unit1 == log_units(1) .and. unit3 == log_units(2) ) then + write(*,*) 'Units have their expected placement' + + else + error stop 'Units do not have their expected placement' + + end if + + end subroutine test_removing_log_units + + subroutine test_adding_log_units() + + print * + print *, 'running test_adding_log_units' + call global % add_log_unit( unit2, stat ) + if ( stat == success ) then + if ( global % log_units_assigned() == 3 ) then + write(*,*) 'Successfully added unit2 as expected' + + else + error stop 'Adding unit2 failed to increase log_units to 3.' + + end if + + else + error stop 'Unexpected problem adding unit2.' + + end if + + call global % add_log_unit( output_unit, stat ) + if ( stat == success ) then + if ( global % log_units_assigned() == 4 ) then + write(*,*) 'Successfully added output_unit as expected' + + else + error stop 'Adding output_unit failed to increase ' // & + 'log_units to 4.' + + end if + + else + error stop 'Unexpected problem adding output_unit.' + + end if + + call global % add_log_unit( error_unit, stat ) + if ( stat == success ) then + if ( global % log_units_assigned() == 5 ) then + write(*,*) 'Successfully added error_unit as expected' + + else + error stop 'Adding error_unit failed to increase ' // & + 'log_units to 5.' + + end if + + else + error stop 'Unexpected problem adding error_unit.' + + end if + + call global % add_log_unit( input_unit, stat ) + if ( stat /= success ) then + if ( global % log_units_assigned() == 5 ) then + write(*,*) 'Failed at adding input_unit as expected' + + else + error stop 'Unsuccessfully adding input_unit failed to ' // & + 'keep log_units to 5.' + + end if + + else + error stop 'Unexpected success adding input_unit.' + + end if + + open( newunit=unit6, file='sixth_log_file.txt', form='formatted', & + action='read', status='replace', position='rewind' ) + call global % add_log_unit( unit6, stat ) + if ( stat == read_only_error ) then + write(*,*) 'Adding unit6 failed with a READ_ONLY_ERROR as expected' + + else + error stop 'Adding unit6 did not fail with a READ_ONLY_ERROR.' + + end if + close(unit6) + call global % add_log_unit( unit6, stat ) + if ( stat == unopened_in_error ) then + write(*,*) 'Adding unit6 failed with a UNOPENED_IN_ERROR as ' // & + 'expected' + + else + error stop 'Adding unit6 did not fail with a UNOPENED_IN_ERROR.' + + end if + open( newunit=unit6, file='sixth_log_file.txt', form='unformatted', & + action='write', status='replace', position='rewind' ) + call global % add_log_unit( unit6, stat ) + if ( stat == unformatted_in_error ) then + write(*,*) 'Adding unit6 failed with a UNFORMATTED_IN_ERROR ' // & + 'as expected' + + else + write(*, *) 'STAT = ', stat + error stop 'Adding unit6 did not fail with a UNFORMATTED_IN_ERROR.' + + end if + close(unit6) + open( newunit=unit6, file='sixth_log_file.txt', form='formatted', & + action='write', status='replace', access='direct', recl=100 ) + call global % add_log_unit( unit6, stat ) + if ( stat == non_sequential_error ) then + write(*,*) 'Adding unit6 failed with a ' // & + 'NON_SEQUENTIAL_ERROR as expected' + + else + error stop 'Adding unit6 did not fail with a ' // & + 'NON_SEQUENTIAL_ERROR.' + + end if + close(unit6) + open( newunit=unit6, file='sixth_log_file.txt', form='formatted', & + action='write', status='replace', position='rewind', & + access='sequential' ) + call global % add_log_unit( unit6, stat ) + if ( stat == success ) then + if ( global % log_units_assigned() == 6 ) then + write(*,*) 'Successfully added unit6 as expected' + + else + error stop 'Adding unit6 failed to increase log_units to 6.' + + end if + + else + error stop 'Unexpected problem adding unit6.' + + end if + + call global % remove_log_unit( unit6, stat=stat ) + if ( stat /= success ) then + error stop 'Unexpected problem removing unit6' + + else + if ( global % log_units_assigned() /= 5 ) then + error stop 'Removing unit6 did not decrement log_units to 5.' + + else + write(*,*) 'Successfully removed unit6 as expected.' + + end if + + end if + + call global % remove_log_unit( error_unit, stat=stat ) + if ( stat /= success ) then + error stop 'Unexpected problem removing error_unit' + + else + if ( global % log_units_assigned() /= 4 ) then + error stop 'Removing error_unit did not decrement ' // & + 'log_units to 4.' + + else + write(*,*) 'Successfully removed error_unit as expected.' + + end if + + end if + + call global % remove_log_unit( unit3, stat=stat ) + if ( stat /= success ) then + error stop 'Unexpected problem removing unit3' + + else + if ( global % log_units_assigned() /= 3 ) then + error stop 'Removing unit3 did not decrement ' // & + 'log_units to 3.' + + else + write(*,*) 'Successfully removed unit3 as expected.' + + end if + + end if + + return + end subroutine test_adding_log_units + +end program test_stdlib_logger