From b5d8cc13dfa22e573566ee68e5106be83a922096 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Tue, 1 Sep 2020 16:50:44 -0600 Subject: [PATCH 001/121] New documentation for the proposed stdlib_logger.f90 module New documentation for the proposed stdlib_logger.f90 module. The documentation differs in style from that of the other modules in the following ways: 1. I thought it benefitted from an introduction giving an overview of the module 2. It has a section describing the constants used as error codes with a table summarizing the constants. The other modules do not appear to have significant public constants 3. It has a section summarizing the derived type. The other modules do not define a public derived type. 4. It has a section describing the `global_logger` variable. The other modules do not define a public variable. 5. It has a table summarizing the various procedures/methods in one place. I think using the module benefits from this summary 6. With the extra material the procedure/method description are one heading higher than in the other documentation. I don't think this is noticeable. 7. The "syntax" has the self argument at an awkward position. The other modules don't have the equivalent of the self argument, and I couldn't see another place to logically put it. 8. The "syntax" follows the standard in using a single pair of square brackets to delimit a run of optional arguments, rather than the other document's use of a pair of square brackets for each optional argument. This is easily changed. 9. The document follows the standard in identifying the class of each procedure. 10. I follow the standard in describing the intent of each argument. The other documentation omits that. This is easily changed. 11. I am wordier than the other documenters. This is hard to change. 12. I ended up upper casing only specifiers that are character strings. I can lower case those, upper case other specifiers or Fortran keywords easily. I just need specific guidance on how to upper/lower case. --- doc/specs/stdlib_logger.md | 934 +++++++++++++++++++++++++++++++++++++ 1 file changed, 934 insertions(+) create mode 100644 doc/specs/stdlib_logger.md diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md new file mode 100644 index 000000000..e8aebe5b0 --- /dev/null +++ b/doc/specs/stdlib_logger.md @@ -0,0 +1,934 @@ +--- +title: STDLIB_LOGGER +--- +# The module STDLIB_LOGGER + +[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_t`, is to be used to define +both global and local logger variables. The `logger_t` methods serve +to configure the loggers and use the logger variables to report +messages to a variable specific list of I/O units, to be termed +`log_units`. The variable, `global_logger`, of type `logger_t`, 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 `'INFORMATION: '`, `'WARNING: '`, + `'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_t` 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| +| `invalid_index_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_t + +### Status + +Experimental + +### Description + +Serves to define 'logger' variables to be used in reporting +significant events encountered during the execution of a program. + +### Syntax + +type(logger_t) :: variable + +### Private attributes + +| Attribute | Type | Description | Initial value | +|-----------|------|-------------|---------| +| `add_line` | Logical | Flag to precede output with a blank line |`.true.`| +|`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 | 80 | +|`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_t`. As might be guessed from its name, `global_logger` is +intended to serve as the default logger for use throughout an +application. + + +### Overview of the `logger_t` methods + +The module defines twelve public procedures: one function and eleven +subroutines. All are methods of the `logger_t` derived type. The +procedures are: + +|Procedure|Class|Description| +|---------|-----|-----------| +|`add_log_file`|Subroutine|opens a file using `newunit`, and adds the resulting unit to the `log_units` list| +|`add_log_unit`| Subroutine|adds an existing unit to the `log_units` list| +|`configure`|Subroutine| configures the details of the logging process| +|`configuration`|Subroutine| reports the details of the logging configuration| +|`log_error`| Subroutine|sends a message prepended by `'ERROR: '` optionally followed by a `stat` or `errmsg`| +|`log_information`|Subroutine| sends a message prepended by `'INFORMATION: '`| +|`log_io_error`|Subroutine|sends a message prepended by `'I/O ERROR: '` optionally followed by an `iostat` or `iomsg`| +|`log_message`|Subroutine| sends a message| +|`log_text_error`|Subroutine| sends a message describing an error found in a line of text| +|`log_units_assigned`|Function| returns the number of active I/O units in `log_units`| +|`log_warning`|Subroutine| sends a message prepended by `'WARNING: '`| +|`remove_log_unit`|Subroutine| removes the `unit` number from the `log_units` array| + +## Specification of the `logger_t` 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 [[stdlib_logger(module):self % add_log_file(interface)]]( filename, unit [, action, position, status, stat ] )` + +#### Class + +Subroutine + +#### Arguments + +`self`: shall be a scalar variable of type `logger_t`. 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`: 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 + + program main + 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 main + + +### 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 result cause `stat`, if present, to not be +`success` and `unit` not to be added to `log_units`, or, if `stat` is +not present, cause processing to stop with an informative string as +the stop code. + +#### Syntax + +`call [[stdlib_logger(module):self % add_log_unit(interface)]]( unit [, stat ] )` + +#### Class. + +Subroutine. + +#### Arguments + +`self`: shall be a scalar variable of type `logger_t`. 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 + + 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 + +### `configuration` - report a logger's configuration + +#### Status + +Experimental + +#### Description + +Reports the configuration of a logger. + +#### Syntax + +`call [[stdlib_logger(module):self % configuration(interface)]]( [ add_line, indent, max_width, time_stamp, log_units ] )` + +#### Class + +Pure subroutine + +#### Arguments + +`self`: shall be a scalar variable of type `logger_t`. It is an `intent(in)` argument. It shall be the logger whose configuration is reported. + +`add_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 + + module example_mod + use stdlib_logger + ... + type(logger_t) :: 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 [[stdlib_logger(module):self % configure(interface)]]( [ add_line, indent, max_width, time_stamp ] ) + +#### Class + +Pure subroutine. + +#### Arguments + +`self`: shall be a scalar variable of type `logger_t`. It is an `intent(in)` argument. It shall be the logger to be configured. + +`add_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 + + program main + use stdlib_logger, global => global_logger + ... + call global % configure( indent=.false., max_width=72 ) + ... + end program main + +### 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 [[stdlib_logger(module):self % log_error(interface)]]( message [, module, procedure, stat, errmsg ] ) + +#### Behavior + +If time stamps are active for `self`, a time stamp is written +first. Then if `module` or `procedure` are present, they are +written. Then `message` is written with the prefix `'ERROR: '`. Then +if `stat` or `errmsg` are present they are written. + +#### Class + +Subroutine + +#### Arguments + +`self`: shall be a scalar expression of type `logger_t`. 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 + + module example_mod + use stdlib_logger + ... + real, allocatable :: a(:) + ... + type(logger_t) :: 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 [[stdlib_logger(module):self % log_information(interface)]]( message [, module, procedure ] )` + +#### 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 +`'INFORMATION: '`. + +#### Class + +Subroutine. + +#### Arguments + +`self`: shall be a scalar expression of type `logger_t`. 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 + + module example_mod + use stdlib_logger + ... + real, allocatable :: a(:) + ... + type(logger_t) :: 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 [[stdlib_logger(module):self % log_io_error(interface)]]( message [, module, procedure, iostat, iomsg ] )` + +#### Class + +Subroutine + +#### Arguments +`self`: shall be a scalar expression of type `logger_t`. 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 + + program example + 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 example + +### `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 +first. Then if `module` or `procedure` are present, they are +written. Then `message` is written with no prefix. + +#### Syntax + +`call [[stdlib_logger(module):self % log_message(interface)]]( message [, module, procedure ] )` + +#### Class + +Subroutine + +#### Arguments + +`self`: shall be a scalar expression of type `logger_t`. 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. + +#### Example + + module example_mod + use stdlib_logger + ... + real, allocatable :: a(:) + ... + type(logger_t) :: 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' ) + 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 [[stdlib_logger(module):self % log_text_error(interface)]]( line, column, summary [, filename, line_number, caret, stat ] )` + +#### Class + +Subroutine + +#### Arguments + +`self`: shall be a scalar expression of type `logger_t`. 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 + + program example + 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 example + +### `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 = [[stdlib_logger(module):self % log_units_assigned(function)]]()` + +#### Class + +Elemental function + +#### Argument + +`self`: shall be a scalar expression of type `logger_t`. 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 + + module example_mod + use stdlib_logger + ... + type(logger_t) :: 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 +first. Then if `module` or `procedure` are present, they are +written. Then `message` is written with the prefix +`WARNING: '`. + +#### Syntax + +`call [[stdlib_logger(module):self % log_warning(interface)]]( message [, module, procedure ] )` + +#### Class + +Subroutine + +#### Arguments + +`self`: shall be a scalar expression of type `logger_t`. 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 + + module example_mod + use stdlib_logger + ... + real, allocatable :: a(:) + type(logger_t) :: 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 [[stdlib_logger(module):self % remove_log_unit(interface)]]( unit [, close_unit, stat ] ) + +#### Class + +Subroutine + +#### Arguments + +`self`: shall be a scalar expression of type `logger_t`. 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 + + 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 From adaa2d557caed79c90cbe4abf4904421df924a50 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Tue, 1 Sep 2020 17:05:45 -0600 Subject: [PATCH 002/121] The stdlib_logger.f90 module The source code for the stdlib_logger.f90 module. It defines one derived type, several constants and procedures/methods to implement loggers, and one variable intended to serve as a global logger. --- src/stdlib_logger.f90 | 1499 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1499 insertions(+) create mode 100644 src/stdlib_logger.f90 diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 new file mode 100644 index 000000000..4485f909e --- /dev/null +++ b/src/stdlib_logger.f90 @@ -0,0 +1,1499 @@ +module stdlib_logger +!!### Module STDLIB_LOGGER +!! +!! This module defines a derived type, procedures, a variable, and +!! constants to be used for reporting errors by the Fortran Standard +!! Library. +!! +!! The derived type, LOGGER_T, 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_T 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_T 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_UNIT 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_ERRROR, and LOG_WARNING send messages to the log units. +!! +!! The variable is the entity GLOBAL_LOGGER of type LOGGER_T, to serve +!! as its name suggests, as a global logger to be used as a default +!! 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. +!! INVALID_INDEX_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. SEQUENTIAL_ACCESS_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 + + implicit none + + private + + character(*), parameter, private :: module_name = 'STDLIB_LOGGER' + + public :: logger_t +! Public derived type + + type :: logger_t + + logical, private :: add_line = .TRUE. + logical, private :: indent_lines = .TRUE. + integer, allocatable, private :: log_units(:) + integer, private :: max_width = 80 + logical, private :: time_stamp = .TRUE. + integer, private :: units = 0 + + contains + +! procedure, pass(self) :: assert + procedure, pass(self) :: add_log_file + procedure, pass(self) :: add_log_unit + procedure, pass(self) :: configuration + procedure, pass(self) :: configure + procedure, pass(self) :: log_error + procedure, pass(self) :: log_information + procedure, pass(self) :: log_io_error + procedure, pass(self) :: log_message + procedure, pass(self) :: log_text_error + procedure, pass(self) :: log_units_assigned + procedure, pass(self) :: log_warning + procedure, pass(self) :: remove_log_unit + end type logger_t + + public :: & + add_log_file, & + add_log_unit, & +! assert, & + configuration, & + configure, & + log_error, & + log_information, & + log_io_error, & + log_message, & + log_text_error, & + log_units_assigned, & + log_warning, & + remove_log_unit +!! public procedures + + public :: & + close_failure, & + invalid_index_error, & + non_sequential_error, & + open_failure, & + read_only_error, & + success, & + unformatted_in_error, & + unopened_in_error, & + write_failure +!! public constants + + integer, parameter :: & + success = 0, & + close_failure = 1, & + invalid_index_error = 2, & + non_sequential_error = 3, & + open_failure = 4, & + read_only_error = 5, & + unformatted_in_error = 6, & + unopened_in_error = 7, & + write_failure = 8 +!! Constants used as error flags + + public :: global_logger +!! Variable of type LOGGER_T to be used as a global logger + type(logger_t) :: global_logger + + character(*), parameter, private :: & + invalid_column = 'COLUMN is not a valid index to LINE.' + +contains + + subroutine add_log_file( self, filename, unit, action, position, status, & + stat ) +!! Opens a formatted sequential access output file, `filename` using +!! `newunit` and adds the resulting unit number to the logger'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. + + class(logger_t), 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) :: 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 +!! * `READ_ONLY_ERROR` - file unopend as ACTION 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(128) :: iomsg + integer :: iostat + character(16) :: aaction, aposition, astatus + character(*), parameter :: procedure_name = 'ADD_LOG_FILE' + integer, allocatable :: dummy(:) + integer :: lun + integer :: i + + if ( present(action) ) then + aaction = action + + else + aaction = 'write' + + end if + + if ( present(position) ) then + aposition = position + + else + aposition = 'rewind' + + end if + + if ( present(status) ) then + astatus = status + + else + astatus = 'replace' + + end if + + 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=unit, 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 ) = unit + self % units = self % units + 1 + 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 ) +!! 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. + class(logger_t), 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 + + return + + 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 + + return + end subroutine validate_unit + + end subroutine add_log_unit + + +! subroutine assert( self, test, message, module, procedure ) +! Checks the value of TEST and if TEST is .FALSE. writes output to the +! I/O units in SELF % LOG_UNITS and stops processing, otherwise it returns +! with no effect. +! +! ##### Behavior +! If TEST is .FALSE. ASSERT will write to the files, otherwise +! nothing is written. If time stamps are actiVe then the time stamp will +! be written first. Then if MODULE and PROCEDURE are present then they will +! be written.Finally MESSAGE, will be written prepended by the +! string 'ASSERTION FAILURE: '. +! +! class(logger_t), intent(in) :: self +!! The logger variabl to report the error +! logical, intent(in) :: test +!! A logical condition whose failure indicates an error has occurred. +! character(len=*), intent(in) :: message +!! Typically the textual representation of TEST +! character(len=*), intent(in), optional :: module +!! The name of the module containing the call of ASSERT +! character(len=*), intent(in), optional :: procedure +!! The name of the procedure containing the call of ASSERT +! +!!##### Example +!! +!! function factorial( i ) +!! use stdlib_logger +!! real :: factorial +!! integer, intent(in) :: i +!! integer :: j +!! call assert( i >= 0, & +!! 'i >= 0.', & +!! procedure = "FACTORIAL" ) +!! factorial = 1.0 +!! do j=1, i +!! factorial = factorial * j +!! end do +!! +!! return +!! end function factorial +! +! +! integer :: status_code +! +! if ( test ) then +! return +! +! end if +! +! call self % log_message( 'ASSERTION FAILURE: ' // message, & +! module = module, & +! procedure = procedure ) +! +! error stop 'Failed assertion' +! +! return +! +! end subroutine assert + + pure subroutine configuration( self, add_line, indent, max_width, & + time_stamp, log_units ) +!! Reports the logging configuration of SELF. The following attributes are +!! reported: +!! 1. ADD_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 logical unit numbers to which log output +!! will be written + class(logger_t), intent(in) :: self +!! The logger variable whose configuration is being reported + logical, intent(out), optional :: add_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_line) ) add_line = self % add_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) + + return + end subroutine configuration + + + pure subroutine configure( self, add_line, indent, max_width, time_stamp ) +!! Configures the logging process for SELF. The following attributes are +!! configured: +!! 1. ADD_LINE is a logical flag with .TRUE. implying that output starts +!! with a blank line, and .FALSE. implying no blank line. ADD_LINE has a +!! default value of .TRUE.. +!! 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 default 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 default +!! value of 80. +!! 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 default value of .TRUE.. + +!!##### Example +!! +!! program main +!! use stdlib_logger +!! ... +!! call global_logger % configure( indent=.false., max_width=72 ) +!! ... + + class(logger_t), intent(inout) :: self + logical, intent(in), optional :: add_line + logical, intent(in), optional :: indent + integer, intent(in), optional :: max_width + logical, intent(in), optional :: time_stamp + + if ( present(add_line) ) self % add_line = add_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 + + return + end subroutine configure + + + subroutine format_output_string( self, unit, string, procedure_name, & + col_indent ) +!! 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_t), 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 + + return + + 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 ) +!! 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 ) +!! 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 'ERROR: '. Then if STAT or ERRMSG +!! are present they are written. +!! +!!##### Example +!! +!! module example_mod +!! use stdlib_logger +!! ... +!! real, allocatable :: a(:) +!! ... +!! type(logger_t) :: 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_t), 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 REPORT_ERR + character(len=*), intent(in), optional :: procedure +!! The name of the procedure contining the current invocation of REPORT_ERR + 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( 'ERROR: ' // message, & + module = module, & + procedure = procedure ) + + 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 ) +!! 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 'INFORMATION: '. +!! +!!##### Example +!! +!! module example_mod +!! use stdlib_logger +!! ... +!! real, allocatable :: a(:) +!! ... +!! type(logger_t) :: 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_t), 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 REPORT_ERR + character(len=*), intent(in), optional :: procedure +!! The name of the procedure contining the current invocation of REPORT_ERR + + call self % log_message( 'INFORMATION: ' // message, & + module = module, & + procedure = procedure ) + + return + end subroutine log_information + + + subroutine log_io_error( self, message, module, procedure, iostat, & + iomsg ) +!! Writes the string MESSAGE to the 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 a prefix 'I/O ERROR: '. 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_t), 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( 'I/O ERROR: ' // message, & + module = module, & + procedure = procedure ) + + 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 + + return + 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 ) +!! Writes the string MESSAGE to the 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. Finally MESSAGE is +!! written +!! +!!##### 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' ) +!! end subroutine example_sub +!! ... +!! end module example_mod +!! + + class(logger_t), 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 + + integer :: unit + integer :: iostat + character(*), parameter :: procedure_name = 'LOG_MESSAGE' + character(256) :: iomsg + + 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 + return + + contains + + subroutine write_log_message( unit ) + integer, intent(in) :: unit + + if ( self % add_line ) write( unit, *, err=999, iostat=iostat, & + iomsg=iomsg ) + + if ( self % time_stamp ) write( unit, '(a)', err=999, & + iostat=iostat, iomsg=iomsg ) time_stamp() + + if ( present(module) ) then + if ( present(procedure) ) then + write( unit, & + "('Module % Procedure: ', a, ' % ', a)", & + err=999, iostat=iostat, iomsg=iomsg) & + trim( module ), trim( procedure ) + + else + write( unit, "( 'Module: ', a)", err=999, iostat=iostat, & + iomsg=iomsg ) trim( module ) + + end if + + else if ( present(procedure) ) then + write( unit, "( 'Procedure: ', a)", err=999, iostat=iostat, & + iomsg=iomsg ) trim( procedure ) + + end if + + call format_output_string( self, unit, 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 ) +!! 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 or column are present they are written. +!! Then LINE is written. Then a 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_t), 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 occured, INVALID_INDEX 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' + + if ( present(caret) ) then + acaret = caret + + else + acaret = '^' + + end if + + if ( column < 0 .or. column > len( line ) + 1 ) then + if ( present(stat) ) then + stat = invalid_index_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 + + return + contains + + subroutine write_log_text_error( unit ) + integer, intent(in) :: unit + + if ( self % add_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) +!! Returns the number of units assigned to SELF % LOG_UNITS + class(logger_t), intent(in) :: self +!! The logger subject to the inquiry + integer :: log_units_assigned +!!##### Example +!! +!! module example_mod +!! use stdlib_logger +!! ... +!! type(logger_t) :: 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 + + return + end function log_units_assigned + + + subroutine log_warning( self, message, module, procedure ) +!! 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 'WARNING: '. +!! +!!##### Example +!! +!! module example_mod +!! use stdlib_logger +!! ... +!! real, allocatable :: a(:) +!! ... +!! type(logger_t) :: 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_t), 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 REPORT_ERR + character(len=*), intent(in), optional :: procedure +!! The name of the procedure contining the current invocation of REPORT_ERR + + call self % log_message( 'WARNING: ' // message, & + module = module, & + procedure = procedure ) + + return + end subroutine log_warning + + + 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. + class(logger_t), 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_t) :: 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) + + return + end function time_stamp + +end module stdlib_logger From 6b0cbce40ab05320c77946cbb523788eeccc4a4c Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Tue, 1 Sep 2020 18:21:14 -0600 Subject: [PATCH 003/121] The test code, test_stdlib_logger.f90, for the module stdlib_logger.f90 The test code is quite a bit of a mess. The procedures add_log_file, add_log_unit, and remove_log_unit have failure modes that are modified with a `stat` argument, and need to be tested to be sure the codes do not wrongly add/remove a unit when the stat argument is not success, and ensure that the stat stat argument returns the correct error code. Any suggestions you have to improve it would be appreciated. --- src/tests/logger/test_stdlib_logger.f90 | 612 ++++++++++++++++++++++++ 1 file changed, 612 insertions(+) create mode 100644 src/tests/logger/test_stdlib_logger.f90 diff --git a/src/tests/logger/test_stdlib_logger.f90 b/src/tests/logger/test_stdlib_logger.f90 new file mode 100644 index 000000000..47ad030b0 --- /dev/null +++ b/src/tests/logger/test_stdlib_logger.f90 @@ -0,0 +1,612 @@ +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_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 one 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_line=add_line, & + indent=indent, max_width=max_width, time_stamp=time_stamp, & + log_units=log_units ) + + if ( add_line ) then + write(*,*) 'ADD_LINE starts off as .TRUE. as expected.' + + else + error stop 'ADD_LINE starts off as .FALSE. 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 == 80 ) then + write(*,*) 'MAX_WIDTH starts off as 80 as expected.' + + else + error stop 'MAX_WIDTH starts off as not equal to 80 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, limited to 80 columns width, preceded by ' // & + 'one blank line, then by a time stamp, then by MODULE % ' // & + 'PROCEDURE, be prefixed by INFORMARION and be indented on ' // & + 'subsequent lines by 4 columns.', & + module = 'N/A', & + procedure = 'TEST_STDLIB_LOGGER' ) + + call global % configure( add_line=.false., indent=.false., & + max_width=72, time_stamp=.false. ) + + call global % configuration( add_line=add_line, indent=indent, & + max_width=max_width, time_stamp=time_stamp, log_units=log_units ) + + if ( .not. add_line ) then + write(*,*) 'ADD_LINE is now .FALSE. as expected.' + + else + error stop 'ADD_LINE is now .TRUE. 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 ' // & + 'no 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_line=.true., 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 a blank line, then by a time stamp, then by ' // & + 'MODULE % PROCEDURE, have a prefix of WARNING, 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 From e68f4e724e35d09ff61db5160930c1b3ee8cd98b Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Tue, 1 Sep 2020 18:23:43 -0600 Subject: [PATCH 004/121] The CMakeLists.txt and Makefile.manual files These won't overwrite existing files --- src/tests/logger/CMakeLists.txt | 1 + src/tests/logger/Makefile.manual | 4 ++++ 2 files changed, 5 insertions(+) create mode 100644 src/tests/logger/CMakeLists.txt create mode 100644 src/tests/logger/Makefile.manual 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 From 78b6f5c1f17a90f66777e670446779e3ecaaa20f Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Tue, 1 Sep 2020 18:31:39 -0600 Subject: [PATCH 005/121] Added stdlib_logger.f90 to the make list --- src/CMakeLists.txt | 1 + 1 file changed, 1 insertion(+) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 7c67c4efa..45aded40f 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -33,6 +33,7 @@ set(SRC stdlib_experimental_ascii.f90 stdlib_experimental_error.f90 stdlib_experimental_kinds.f90 + stdlib_logger.f90 stdlib_experimental_system.F90 ${outFiles} ) From 8bcc4d432510499eaa15e223d9577bee97ff7140 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Tue, 1 Sep 2020 18:33:38 -0600 Subject: [PATCH 006/121] Added stdlib_logger.f90 to the makefile --- src/Makefile.manual | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Makefile.manual b/src/Makefile.manual index 55f0352ed..fcfcb0025 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -5,6 +5,7 @@ SRC = f18estop.f90 \ stdlib_experimental_linalg.f90 \ stdlib_experimental_linalg_diag.f90 \ stdlib_experimental_kinds.f90 \ + stdlib_logger.f90 stdlib_experimental_optval.f90 \ stdlib_experimental_quadrature.f90 \ stdlib_experimental_quadrature_trapz.f90 \ From babc6602933ca5986370d7c526629158ca73cac1 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Tue, 1 Sep 2020 18:35:21 -0600 Subject: [PATCH 007/121] Update CMakeLists.txt to ad logger subdirectory --- src/tests/CMakeLists.txt | 1 + 1 file changed, 1 insertion(+) 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) From eebf913ff2599a6ac2243f4da4678a62e980796b Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Tue, 1 Sep 2020 18:39:09 -0600 Subject: [PATCH 008/121] Update Makefile.manual to add logger subdirectory --- src/tests/Makefile.manual | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/tests/Makefile.manual b/src/tests/Makefile.manual index d7c1fd8ad..41ec6b75a 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 From 26bea39b2844d653b99c6975207794a190031c0f Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sun, 6 Sep 2020 12:07:11 -0400 Subject: [PATCH 009/121] fix typo --- src/tests/Makefile.manual | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/tests/Makefile.manual b/src/tests/Makefile.manual index 41ec6b75a..c785de9de 100644 --- a/src/tests/Makefile.manual +++ b/src/tests/Makefile.manual @@ -3,7 +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=logger $(MAKE) -f Makefile.manual --directory=optval $(MAKE) -f Makefile.manual --directory=quadrature $(MAKE) -f Makefile.manual --directory=stats From c387a067a6dfb4f3a9e7946b06989fdace1dd4b1 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sun, 6 Sep 2020 12:33:55 -0400 Subject: [PATCH 010/121] another typo fix --- src/tests/Makefile.manual | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/tests/Makefile.manual b/src/tests/Makefile.manual index c785de9de..9b0227232 100644 --- a/src/tests/Makefile.manual +++ b/src/tests/Makefile.manual @@ -11,7 +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=logger test $(MAKE) -f Makefile.manual --directory=optval test $(MAKE) -f Makefile.manual --directory=quadrature test $(MAKE) -f Makefile.manual --directory=stats test From d9fe37dde5826b86a2cb541f19d5a891eacb2f7c Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sun, 6 Sep 2020 13:19:11 -0400 Subject: [PATCH 011/121] handle optional arguments in logger using optval --- src/Makefile.manual | 1 + src/stdlib_logger.f90 | 35 +++++------------------------------ 2 files changed, 6 insertions(+), 30 deletions(-) diff --git a/src/Makefile.manual b/src/Makefile.manual index 30052bd39..1c731b9bb 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -46,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 index 4485f909e..f6a1dec5c 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -49,6 +49,7 @@ module stdlib_logger output_unit use stdlib_ascii, only : to_lower + use stdlib_optval, only : optval implicit none @@ -188,29 +189,9 @@ subroutine add_log_file( self, filename, unit, action, position, status, & integer :: lun integer :: i - if ( present(action) ) then - aaction = action - - else - aaction = 'write' - - end if - - if ( present(position) ) then - aposition = position - - else - aposition = 'rewind' - - end if - - if ( present(status) ) then - astatus = status - - else - astatus = 'replace' - - end if + aaction = optval(action, 'write') + aposition = optval(position, 'rewind') + astatus = optval(status, 'replace') if ( len_trim(aaction) == 4 ) then do i=1, 4 @@ -1209,13 +1190,7 @@ subroutine log_text_error( self, line, column, summary, filename, & integer :: lun character(*), parameter :: procedure_name = 'LOG_TEXT_ERROR' - if ( present(caret) ) then - acaret = caret - - else - acaret = '^' - - end if + acaret = optval(caret, '^') if ( column < 0 .or. column > len( line ) + 1 ) then if ( present(stat) ) then From 028f1ebadfe9d12e7dd1284e3e511a13ee1b53d9 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sun, 6 Sep 2020 13:23:27 -0400 Subject: [PATCH 012/121] remove redundant return statements --- src/stdlib_logger.f90 | 15 --------------- 1 file changed, 15 deletions(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index f6a1dec5c..b7bf52986 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -338,8 +338,6 @@ subroutine add_log_unit( self, unit, stat ) self % log_units(self % units + 1 ) = unit self % units = self % units + 1 - return - contains subroutine validate_unit() @@ -418,7 +416,6 @@ subroutine validate_unit() if ( present(stat) ) stat = success - return end subroutine validate_unit end subroutine add_log_unit @@ -539,7 +536,6 @@ pure subroutine configuration( self, add_line, indent, max_width, & if ( present(time_stamp) ) time_stamp = self % time_stamp if ( present(log_units) ) log_units = self % log_units(1:self % units) - return end subroutine configuration @@ -587,7 +583,6 @@ pure subroutine configure( self, add_line, indent, max_width, time_stamp ) end if if ( present(time_stamp) ) self % time_stamp = time_stamp - return end subroutine configure @@ -623,8 +618,6 @@ subroutine format_output_string( self, unit, string, procedure_name, & end if - return - contains subroutine format_first_line() @@ -923,7 +916,6 @@ subroutine log_information( self, message, module, procedure ) module = module, & procedure = procedure ) - return end subroutine log_information @@ -991,7 +983,6 @@ subroutine log_io_error( self, message, module, procedure, iostat, & end if - return contains subroutine write_log_io_error( unit ) @@ -1080,7 +1071,6 @@ subroutine log_message( self, message, module, procedure ) end do end if - return contains @@ -1222,7 +1212,6 @@ subroutine log_text_error( self, line, column, summary, filename, & end if - return contains subroutine write_log_text_error( unit ) @@ -1313,10 +1302,8 @@ elemental function log_units_assigned(self) !! ... !! end module example_mod - log_units_assigned = self % units - return end function log_units_assigned @@ -1368,7 +1355,6 @@ subroutine log_warning( self, message, module, procedure ) module = module, & procedure = procedure ) - return end subroutine log_warning @@ -1468,7 +1454,6 @@ function time_stamp() time_stamp(17:17) = ':' time_stamp(18:23) = time(5:10) - return end function time_stamp end module stdlib_logger From 676d9d1f5594b773d5f4e919e8d066d938708891 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sun, 6 Sep 2020 13:45:35 -0400 Subject: [PATCH 013/121] clean up private attributes and move all public names to the top --- src/stdlib_logger.f90 | 76 ++++++++++++++----------------------------- 1 file changed, 24 insertions(+), 52 deletions(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index b7bf52986..2f50aee5a 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -54,20 +54,33 @@ module stdlib_logger implicit none private + public :: global_logger, logger_t - character(*), parameter, private :: module_name = 'STDLIB_LOGGER' + !! public constants used as error flags + integer, parameter, public :: & + success = 0, & + close_failure = 1, & + invalid_index_error = 2, & + non_sequential_error = 3, & + open_failure = 4, & + read_only_error = 5, & + unformatted_in_error = 6, & + unopened_in_error = 7, & + write_failure = 8 - public :: logger_t -! Public derived type + character(*), parameter :: module_name = 'STDLIB_LOGGER' + !! Public derived type type :: logger_t - logical, private :: add_line = .TRUE. - logical, private :: indent_lines = .TRUE. - integer, allocatable, private :: log_units(:) - integer, private :: max_width = 80 - logical, private :: time_stamp = .TRUE. - integer, private :: units = 0 + private + + logical :: add_line = .TRUE. + logical :: indent_lines = .TRUE. + integer, allocatable :: log_units(:) + integer :: max_width = 80 + logical :: time_stamp = .TRUE. + integer :: units = 0 contains @@ -86,51 +99,10 @@ module stdlib_logger procedure, pass(self) :: remove_log_unit end type logger_t - public :: & - add_log_file, & - add_log_unit, & -! assert, & - configuration, & - configure, & - log_error, & - log_information, & - log_io_error, & - log_message, & - log_text_error, & - log_units_assigned, & - log_warning, & - remove_log_unit -!! public procedures - - public :: & - close_failure, & - invalid_index_error, & - non_sequential_error, & - open_failure, & - read_only_error, & - success, & - unformatted_in_error, & - unopened_in_error, & - write_failure -!! public constants - - integer, parameter :: & - success = 0, & - close_failure = 1, & - invalid_index_error = 2, & - non_sequential_error = 3, & - open_failure = 4, & - read_only_error = 5, & - unformatted_in_error = 6, & - unopened_in_error = 7, & - write_failure = 8 -!! Constants used as error flags - - public :: global_logger -!! Variable of type LOGGER_T to be used as a global logger + !! Variable of type LOGGER_T to be used as a global logger type(logger_t) :: global_logger - character(*), parameter, private :: & + character(*), parameter :: & invalid_column = 'COLUMN is not a valid index to LINE.' contains From d59570f7438ecdb524cdaa9b7867a953ff22a7de Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sun, 6 Sep 2020 20:44:05 -0400 Subject: [PATCH 014/121] Update doc/specs/stdlib_logger.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_logger.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index e8aebe5b0..5bc522ce0 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -1,5 +1,5 @@ --- -title: STDLIB_LOGGER +title: stdlib_logger --- # The module STDLIB_LOGGER From a20daf7407068da1bc1a6d12bdfb6f6483de2b4b Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sun, 6 Sep 2020 20:48:21 -0400 Subject: [PATCH 015/121] Update doc/specs/stdlib_logger.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_logger.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 5bc522ce0..a8724c414 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -95,7 +95,7 @@ application. ### Overview of the `logger_t` methods The module defines twelve public procedures: one function and eleven -subroutines. All are methods of the `logger_t` derived type. The +subroutines. The procedures are: |Procedure|Class|Description| From 4d9850e808f69c33a4a4508972346a8a31589700 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sun, 6 Sep 2020 20:49:26 -0400 Subject: [PATCH 016/121] Update doc/specs/stdlib_logger.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_logger.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index a8724c414..8789b5caf 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -92,7 +92,7 @@ intended to serve as the default logger for use throughout an application. -### Overview of the `logger_t` methods +### Public `logger_t` methods The module defines twelve public procedures: one function and eleven subroutines. The From 7c99b91f1a9794e95ec3d2f5c44dcc8b35015e72 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sun, 6 Sep 2020 20:51:10 -0400 Subject: [PATCH 017/121] Update doc/specs/stdlib_logger.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_logger.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 8789b5caf..e6aeabc82 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -378,7 +378,7 @@ Pure subroutine. ... end program main -### log_error - Writes the string `message` to `self % log_units` +### `log_error` - Writes the string `message` to `self % log_units` #### Status From 16de6731df7000fc675a5f1f84e9e03f6335060f Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sun, 6 Sep 2020 20:51:50 -0400 Subject: [PATCH 018/121] Update src/stdlib_logger.f90 Co-authored-by: Jeremie Vandenplas --- src/stdlib_logger.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index 2f50aee5a..075ef31fd 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -68,7 +68,7 @@ module stdlib_logger unopened_in_error = 7, & write_failure = 8 - character(*), parameter :: module_name = 'STDLIB_LOGGER' + character(*), parameter :: module_name = 'stdlib_logger' !! Public derived type type :: logger_t From 02bea932580024cfc31f60674a815a4fd1a71eb4 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sun, 6 Sep 2020 20:52:43 -0400 Subject: [PATCH 019/121] Update src/stdlib_logger.f90 Co-authored-by: Jeremie Vandenplas --- src/stdlib_logger.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index 075ef31fd..4ee345967 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -72,7 +72,8 @@ module stdlib_logger !! Public derived type type :: logger_t - + !! version: experimental + private logical :: add_line = .TRUE. From 9a10995cb12401e68b4bd316d8d47688e822f53b Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sun, 6 Sep 2020 20:54:07 -0400 Subject: [PATCH 020/121] Update src/stdlib_logger.f90 Co-authored-by: Jeremie Vandenplas --- src/stdlib_logger.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index 4ee345967..b0cd785b4 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -135,7 +135,7 @@ 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 -!! * `READ_ONLY_ERROR` - file unopend as ACTION was 'READ' for an output file +!! * `READ_ONLY_ERROR` - file unopened as ACTION was 'READ' for an output file !! * `OPEN_FAILURE` - the OPEN statement failed From 9633146a74dd754bb355b3f1016c24beacf66b05 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sun, 6 Sep 2020 20:55:16 -0400 Subject: [PATCH 021/121] Update src/stdlib_logger.f90 Co-authored-by: Jeremie Vandenplas --- src/stdlib_logger.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index b0cd785b4..b60c511d2 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -157,7 +157,7 @@ subroutine add_log_file( self, filename, unit, action, position, status, & character(128) :: iomsg integer :: iostat character(16) :: aaction, aposition, astatus - character(*), parameter :: procedure_name = 'ADD_LOG_FILE' + character(*), parameter :: procedure_name = 'add_log_file' integer, allocatable :: dummy(:) integer :: lun integer :: i From 7b7f92b46557738343faea5a3a6676cd334aa103 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sun, 6 Sep 2020 20:56:11 -0400 Subject: [PATCH 022/121] Update src/stdlib_logger.f90 Co-authored-by: Jeremie Vandenplas --- src/stdlib_logger.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index b60c511d2..bdb4223de 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -1141,7 +1141,7 @@ subroutine log_text_error( self, line, column, summary, filename, & !! 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 occured, INVALID_INDEX if COLUMN is less than zero or +!! error hass occurred, INVALID_INDEX if COLUMN is less than zero or !! greater than LEN(LINE), and WRITE_FAILURE if any of the WRITE statements !! has failed. From f717917ed3901fa7e401de20e1b8fb28ac3f9ad6 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sun, 6 Sep 2020 21:30:10 -0400 Subject: [PATCH 023/121] Update src/stdlib_logger.f90 Co-authored-by: Jeremie Vandenplas --- src/stdlib_logger.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index bdb4223de..bd89f1e63 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -987,6 +987,8 @@ end subroutine log_io_error subroutine log_message( self, message, module, procedure ) +!! version: experimental + !! Writes the string MESSAGE to the SELF % LOG_UNITS with optional !! additional text. !! From 44870ea7e62389aa8808e3572ab2f99078c3234c Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sun, 6 Sep 2020 21:30:27 -0400 Subject: [PATCH 024/121] Update src/stdlib_logger.f90 Co-authored-by: Jeremie Vandenplas --- src/stdlib_logger.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index bd89f1e63..b08a4a7e8 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -703,6 +703,8 @@ 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. From 2e33fc0248510c6bd6950fa7db976de802532507 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sun, 6 Sep 2020 21:30:41 -0400 Subject: [PATCH 025/121] Update src/stdlib_logger.f90 Co-authored-by: Jeremie Vandenplas --- src/stdlib_logger.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index b08a4a7e8..601eb3587 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -561,6 +561,8 @@ end subroutine configure 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. From c17b1bf3a1aa718d1ea6ab37064bd3599c145251 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sun, 6 Sep 2020 21:31:05 -0400 Subject: [PATCH 026/121] Update src/stdlib_logger.f90 Co-authored-by: Jeremie Vandenplas --- src/stdlib_logger.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index 601eb3587..32b1c529c 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -110,6 +110,8 @@ module stdlib_logger 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 the logger's `log_units` !! array. `ACTION`, if present, is the `ACTION` specifier of the `OPEN` From 5d607580df3fab7ed37060f58bda98bf5df30731 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sun, 6 Sep 2020 21:31:25 -0400 Subject: [PATCH 027/121] Update src/stdlib_logger.f90 Co-authored-by: Jeremie Vandenplas --- src/stdlib_logger.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index 32b1c529c..a97e34b35 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -236,6 +236,8 @@ 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 From 947f2ef53c710b9d23f01395f948332289897184 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Mon, 7 Sep 2020 07:43:19 +0200 Subject: [PATCH 028/121] Update doc/specs/stdlib_logger.md --- doc/specs/stdlib_logger.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index e6aeabc82..498efb591 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -1,7 +1,7 @@ --- title: stdlib_logger --- -# The module STDLIB_LOGGER +# Loggers [TOC] From eda952d57c85f66d56f6578ea62c1706f374766b Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Mon, 7 Sep 2020 07:43:50 +0200 Subject: [PATCH 029/121] Update doc/specs/stdlib_logger.md --- doc/specs/stdlib_logger.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 498efb591..3cd7ec1f5 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -12,7 +12,7 @@ constants to be used for the reporting of errors and other information. The derived type, `logger_t`, is to be used to define both global and local logger variables. The `logger_t` methods serve to configure the loggers and use the logger variables to report -messages to a variable specific list of I/O units, to be termed +messages to a variable specific list of I/O units termed `log_units`. The variable, `global_logger`, of type `logger_t`, is intended to serve as the default global logger. The constants serve as error flags returned by the optional integer `stat` argument. From ffaf68d011e1ee76de070ec3e6d3e539553aaa63 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Mon, 7 Sep 2020 07:47:55 +0200 Subject: [PATCH 030/121] Update doc/specs/stdlib_logger.md --- doc/specs/stdlib_logger.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 3cd7ec1f5..b6eede768 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -186,7 +186,7 @@ an `intent(in)` argument. It shall be the name of the file to be opened. end program main -### add_log_unit - add a unit to the array `self % log_units` +### `add_log_unit` - add a unit to the array `self % log_units` #### Status From bc91d9a3ec39326cf7148d8c1ae2d8265b1823c5 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Mon, 7 Sep 2020 07:50:56 +0200 Subject: [PATCH 031/121] Update src/stdlib_logger.f90 --- src/stdlib_logger.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index a97e34b35..f85efc0d0 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -459,6 +459,8 @@ end subroutine add_log_unit pure subroutine configuration( self, add_line, indent, max_width, & time_stamp, log_units ) +!! version: experimental + !! Reports the logging configuration of SELF. The following attributes are !! reported: !! 1. ADD_LINE is a logical flag with .TRUE. implying that output starts From 5c4a62182d5605a97318ab6de09d35cb95be2319 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Mon, 7 Sep 2020 07:51:40 +0200 Subject: [PATCH 032/121] Update src/stdlib_logger.f90 --- src/stdlib_logger.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index f85efc0d0..3e31fa8ac 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -519,6 +519,8 @@ end subroutine configuration pure subroutine configure( self, add_line, indent, max_width, time_stamp ) +!! version: experimental + !! Configures the logging process for SELF. The following attributes are !! configured: !! 1. ADD_LINE is a logical flag with .TRUE. implying that output starts From c3d122103539bf8048d058a9db814cf1f1aded8a Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Mon, 7 Sep 2020 07:58:31 +0200 Subject: [PATCH 033/121] Update doc/specs/stdlib_logger.md --- doc/specs/stdlib_logger.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index b6eede768..bd194924d 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -340,7 +340,7 @@ Configures the logging process for self. #### Syntax -`call [[stdlib_logger(module):self % configure(interface)]]( [ add_line, indent, max_width, time_stamp ] ) +`call [[stdlib_logger(module):self % configure(interface)]]( [ add_line, indent, max_width, time_stamp ] )` #### Class From bebeacc6cafa87639a4b3f8a085f1e1d68a5b7e0 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Mon, 7 Sep 2020 07:59:47 +0200 Subject: [PATCH 034/121] Update doc/specs/stdlib_logger.md --- doc/specs/stdlib_logger.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index bd194924d..fec5d3e0a 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -888,7 +888,7 @@ closed. If `unit` is not in `self % log_units` then nothing is done. #### Syntax -`call [[stdlib_logger(module):self % remove_log_unit(interface)]]( unit [, close_unit, stat ] ) +`call [[stdlib_logger(module):self % remove_log_unit(interface)]]( unit [, close_unit, stat ] )` #### Class From 1c64fb71210096524bde7d30587f4dcdaf8f80ce Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Mon, 7 Sep 2020 12:28:59 -0400 Subject: [PATCH 035/121] Update doc/specs/stdlib_logger.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_logger.md | 42 +++++++++++++++++++------------------- 1 file changed, 21 insertions(+), 21 deletions(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index fec5d3e0a..abffbdd73 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -238,28 +238,28 @@ to `unit`. #### 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 - ... +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 main + ... +end program demo_add_log_unit ### `configuration` - report a logger's configuration From e86ed4091df6f7d9732bdb428e6210934e4df2c1 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Mon, 7 Sep 2020 12:29:31 -0400 Subject: [PATCH 036/121] Update doc/specs/stdlib_logger.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_logger.md | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index abffbdd73..3b8eaf167 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -371,12 +371,12 @@ Pure subroutine. #### Example - program main - use stdlib_logger, global => global_logger - ... - call global % configure( indent=.false., max_width=72 ) - ... - end program main +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` From 0513f881157e1b9811bc19094cc2d104ebb80353 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Mon, 7 Sep 2020 12:32:47 -0400 Subject: [PATCH 037/121] Update src/stdlib_logger.f90 Co-authored-by: Jeremie Vandenplas --- src/stdlib_logger.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index 3e31fa8ac..745040dc9 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -290,7 +290,7 @@ subroutine add_log_unit( self, unit, stat ) if ( stat /= success ) return end if - do lun=1, self % units + do lun = 1, self % units ! Check that unit is not already registered if (self % log_units(lun) == unit ) return From f2326ac5f0ce2eab424eae224a505288049e715a Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Mon, 7 Sep 2020 20:28:23 -0600 Subject: [PATCH 038/121] Self is intent(inout) in configure In `self % configure(...)` self must retain its state on entry, but be allowed to be modified so it is `intent(inout)`. The current documentation has `intent(in)`. --- doc/specs/stdlib_logger.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 3b8eaf167..80e268bef 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -348,7 +348,7 @@ Pure subroutine. #### Arguments -`self`: shall be a scalar variable of type `logger_t`. It is an `intent(in)` argument. It shall be the logger to be configured. +`self`: shall be a scalar variable of type `logger_t`. It is an `intent(inout)` argument. It shall be the logger to be configured. `add_line` (optional): shall be a scalar default logical expression. It is an `intent(in)` argument. Set to `.true.` to start From c6b1bd5382a285062fe0706054381d81d4da69a7 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Tue, 8 Sep 2020 07:44:06 +0200 Subject: [PATCH 039/121] Update doc/specs/stdlib_logger.md --- doc/specs/stdlib_logger.md | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 80e268bef..934431c50 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -172,18 +172,18 @@ an `intent(in)` argument. It shall be the name of the file to be opened. #### Example - program main - 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 main +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` From cc48191815d052152831f499ff175edaa5b5628a Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Tue, 8 Sep 2020 22:51:02 +0200 Subject: [PATCH 040/121] Update stdlib_logger.md Some formatting --- doc/specs/stdlib_logger.md | 31 +++++++++++++++++++++++++++---- 1 file changed, 27 insertions(+), 4 deletions(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 934431c50..8b00b8d21 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -172,6 +172,7 @@ an `intent(in)` argument. It shall be the name of the file to be opened. #### Example +```fortran program demo_global_logger use stdlib_logger, global => global_logger ... @@ -184,7 +185,7 @@ program demo_global_logger end if ... end program demo_global_logger - +``` ### `add_log_unit` - add a unit to the array `self % log_units` @@ -238,6 +239,7 @@ to `unit`. #### Example +```fortran program demo_add_log_unit use stdlib_logger, only: global_logger, read_only_error ... @@ -260,6 +262,7 @@ program demo_add_log_unit 999 error stop 'Unable to open "error_log.txt". ... end program demo_add_log_unit +``` ### `configuration` - report a logger's configuration @@ -308,6 +311,7 @@ Pure subroutine #### Example +```fortran module example_mod use stdlib_logger ... @@ -327,6 +331,7 @@ Pure subroutine end subroutine example_sub ... end module example_mod +``` ### `configure` - configure the logging process @@ -344,7 +349,7 @@ Configures the logging process for self. #### Class -Pure subroutine. +Pure subroutine #### Arguments @@ -371,12 +376,14 @@ Pure subroutine. #### 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` @@ -390,7 +397,7 @@ Writes the string `message` to `self % log_units` with optional additional text. #### Syntax -call [[stdlib_logger(module):self % log_error(interface)]]( message [, module, procedure, stat, errmsg ] ) +`call [[stdlib_logger(module):self % log_error(interface)]]( message [, module, procedure, stat, errmsg ] )` #### Behavior @@ -430,6 +437,7 @@ Subroutine #### Example +```fortran module example_mod use stdlib_logger ... @@ -456,6 +464,7 @@ Subroutine end subroutine example_sub ... end module example_mod +``` ### `log_information` - Writes the string `message` to `self % log_units` @@ -480,7 +489,7 @@ written. Then `message` is written with the prefix #### Class -Subroutine. +Subroutine #### Arguments @@ -500,6 +509,7 @@ Subroutine. #### Example +```fortran module example_mod use stdlib_logger ... @@ -522,6 +532,7 @@ Subroutine. end subroutine example_sub ... end module example_mod +``` ### `log_io_error` - Write the string `message` to `self % log_units` @@ -576,6 +587,7 @@ Subroutine #### Example +```fortran program example use stdlib_logger, global=>global_logger ... @@ -596,6 +608,7 @@ Subroutine end if ... end program example +``` ### `log_message` - write the string `message` to `self % log_units` @@ -640,6 +653,7 @@ Subroutine #### Example +```fortran module example_mod use stdlib_logger ... @@ -661,6 +675,7 @@ Subroutine end subroutine example_sub ... end module example_mod +``` ### `log_text_error` - send a message to `self % log_units` describing an error @@ -729,6 +744,7 @@ Subroutine #### Example +```fortran program example use stdlib_logger ... @@ -754,6 +770,7 @@ Subroutine 900 continue ... end program example +``` ### `log_units_assigned` - returns the number of active I/O units @@ -788,6 +805,7 @@ The result is the number of I/O units in #### Example +```fortran module example_mod use stdlib_logger ... @@ -806,6 +824,7 @@ The result is the number of I/O units in end subroutine example_sub ... end module example_mod +``` ### `log_warning` - write the string `message` to `log_units` @@ -851,6 +870,7 @@ Subroutine #### Example +```fortran module example_mod use stdlib_logger ... @@ -873,6 +893,7 @@ Subroutine end subroutine example_sub ... end module example_mod +``` ### `remove_log_unit` - remove `unit` from `self % log_units` @@ -919,6 +940,7 @@ modified. #### Example +```fortran module example_mod use stdlib_logger, global => global_logger ... @@ -932,3 +954,4 @@ modified. end subroutine example_sub ... end module example_mod +``` From 951a31575c3de29862770b859d56cbf61ceadf3a Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Thu, 10 Sep 2020 21:01:28 -0600 Subject: [PATCH 041/121] Added final_logger Added a finalization subroutine, `final_logger`, to the logger_t derived type. --- src/stdlib_logger.f90 | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index 745040dc9..9345d852a 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -90,6 +90,7 @@ module stdlib_logger procedure, pass(self) :: add_log_unit procedure, pass(self) :: configuration procedure, pass(self) :: configure + final :: final_logger procedure, pass(self) :: log_error procedure, pass(self) :: log_information procedure, pass(self) :: log_io_error @@ -567,6 +568,31 @@ pure subroutine configure( self, add_line, indent, max_width, time_stamp ) end subroutine configure + subroutine final_logger( self ) +!! finalizes the logger_t entity by flushing the units + type(logger_t), 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_t finalizer ' // & + 'an error occured 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 + + return + end subroutine final_logger + + subroutine format_output_string( self, unit, string, procedure_name, & col_indent ) !! version: experimental From 62d4ea596c8920095ee6219e76ebf8883dbb4176 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Fri, 11 Sep 2020 07:38:39 +0200 Subject: [PATCH 042/121] Update src/stdlib_logger.f90 Co-authored-by: Ian Giestas Pauli --- src/stdlib_logger.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index 9345d852a..aed737c07 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -580,7 +580,7 @@ subroutine final_logger( self ) flush( self % log_units(unit), iomsg=message, iostat=iostat ) if ( iostat /= 0 ) then write(error_unit, '(a, i0)' ) 'In the logger_t finalizer ' // & - 'an error occured in flushing UNIT = ', & + '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) From 7046da15b1be6f05c420e7a651e867382d624ab1 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Fri, 11 Sep 2020 10:07:11 -0600 Subject: [PATCH 043/121] Added version: experimental Added version: experimental to `finalize_logger`. --- src/stdlib_logger.f90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index aed737c07..73ed3b03f 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -569,7 +569,9 @@ end subroutine configure subroutine final_logger( self ) -!! finalizes the logger_t entity by flushing the units +!! version: experimental + +!! finalizes the logger_t entity sekf by flushing the units type(logger_t), intent(in) :: self integer :: iostat From e5ca2d838fafc3ad8a79035e021c0bd4eb848a20 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Fri, 11 Sep 2020 12:37:38 -0600 Subject: [PATCH 044/121] Lower cased heading Lower cased variable, constant, and procedure names in the heading to be consistent with the style guide. Also put them in enclosing `...`. --- src/stdlib_logger.f90 | 48 +++++++++++++++++++++---------------------- 1 file changed, 24 insertions(+), 24 deletions(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index 73ed3b03f..93da6c12f 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -5,42 +5,42 @@ module stdlib_logger !! constants to be used for reporting errors by the Fortran Standard !! Library. !! -!! The derived type, LOGGER_T, is to be used to define variables to +!! The derived type, `logger_t`, 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_T 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_T also maintains an internal state +!! For each entity of `logger_t` 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_t` 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_UNIT removes the specified logical unit from -!! the LOG_UNITS array and optionally closes the file. CONFIGURE -!! configures the details of the logging process. CONFIGURATION +!! `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_ERRROR, and LOG_WARNING send messages to the log units. +!! `log_error`, `log_information`, `log_io_error`, `log_message`, +!! `log_text_error`, and `log_warning` send messages to the log units. !! -!! The variable is the entity GLOBAL_LOGGER of type LOGGER_T, to serve +!! The variable is the entity `global_logger` of type `logger_t`, to serve !! as its name suggests, as a global logger to be used as a default !! 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 +!! 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. -!! INVALID_INDEX_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. SEQUENTIAL_ACCESS_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. +!! `invalid_index_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 : & From 5942835289e1eae523614738269db101874116f4 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Fri, 11 Sep 2020 12:48:15 -0600 Subject: [PATCH 045/121] Made unit optional Made the `intent(out) argument`, `unit`,` optional` for the subroutine `add_log_file`. --- src/stdlib_logger.f90 | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index 93da6c12f..3a2383713 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -127,7 +127,7 @@ subroutine add_log_file( self, filename, unit, action, position, status, & !! 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) :: unit + integer, intent(out), optional :: unit !! The resulting I/O unit number character(*), intent(in), optional :: action !! The `ACTION` specifier for the `OPEN` statement @@ -157,9 +157,10 @@ subroutine add_log_file( self, filename, unit, action, position, status, & !! ... !! end program main + character(16) :: aaction, aposition, astatus + integer :: aunit character(128) :: iomsg integer :: iostat - character(16) :: aaction, aposition, astatus character(*), parameter :: procedure_name = 'add_log_file' integer, allocatable :: dummy(:) integer :: lun @@ -189,7 +190,7 @@ subroutine add_log_file( self, filename, unit, action, position, status, & end if - open( newunit=unit, file=filename, form='formatted', action=aaction, & + open( newunit=aunit, file=filename, form='formatted', action=aaction, & position=aposition, status=astatus, iostat=iostat, iomsg=iomsg, & err=999 ) @@ -211,8 +212,9 @@ subroutine add_log_file( self, filename, unit, action, position, status, & end if - self % log_units(self % units + 1 ) = unit + self % log_units(self % units + 1 ) = aunit self % units = self % units + 1 + if ( present(unit) ) unit = aunit if ( present(stat) ) stat = success return From 85f240769c7ddf524206769c8b03cd073ed07351 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Fri, 11 Sep 2020 12:51:18 -0600 Subject: [PATCH 046/121] Documented unit change Documented the change of the `add_log_file` argument `unit` to an optional argument. --- doc/specs/stdlib_logger.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 8b00b8d21..a1d909323 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -129,7 +129,7 @@ Opens a formatted, sequential access, output file, `filename` using #### Syntax -`call [[stdlib_logger(module):self % add_log_file(interface)]]( filename, unit [, action, position, status, stat ] )` +`call [[stdlib_logger(module):self % add_log_file(interface)]]( filename [, unit, action, position, status, stat ] )` #### Class @@ -142,7 +142,7 @@ Subroutine `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`: shall be a scalar default integer variable. It is an +`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`. From 4c65175d431e77b7ff1b579fafea667ca19081c4 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Fri, 11 Sep 2020 13:54:36 -0600 Subject: [PATCH 047/121] Updated `add_log_file` comments Updated `add_log_file` comments to be more consistent in casing and the use of sourced code markers `...`. --- src/stdlib_logger.f90 | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index 3a2383713..609bca7e2 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -114,14 +114,14 @@ subroutine add_log_file( self, filename, unit, action, position, status, & !! version: experimental !! Opens a formatted sequential access output file, `filename` using -!! `newunit` and adds the resulting unit number to the logger'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. +!! `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. class(logger_t), intent(inout) :: self !! The logger variable to which the file is to be added @@ -130,16 +130,16 @@ subroutine add_log_file( self, filename, unit, action, position, status, & integer, intent(out), optional :: unit !! The resulting I/O unit number character(*), intent(in), optional :: action -!! The `ACTION` specifier for the `OPEN` statement +!! 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 -!! * `READ_ONLY_ERROR` - file unopened as ACTION was 'READ' for an output file -!! * `OPEN_FAILURE` - the OPEN statement failed +!! * `success` - no errors found +!! * `Rrea_only_error` - file unopened as `action1 was `"READ"` for an output file +!! * `open_failure` - the `OPEN` statement failed !!##### Example From 3589098ceeb43254fddbf5b31c57e7f167a1b8b5 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Fri, 11 Sep 2020 14:02:24 -0600 Subject: [PATCH 048/121] Updated comments for `add_log_unit` Updated comments for `add_log_unit` to be more consistent in casing and use of `...`. --- src/stdlib_logger.f90 | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index 609bca7e2..6486e0a63 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -241,22 +241,22 @@ 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. +!! 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 L`log_units`, +!! or, if `stat` is not presecn, processing stops. class(logger_t), 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 +!! * `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 !! From d6b86018d3f0e5c629bffb8ed1c52a7a9763f5ae Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Fri, 11 Sep 2020 22:32:29 +0200 Subject: [PATCH 049/121] Update src/stdlib_logger.f90 Co-authored-by: Ian Giestas Pauli --- src/stdlib_logger.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index 6486e0a63..332c20ff0 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -573,7 +573,7 @@ end subroutine configure subroutine final_logger( self ) !! version: experimental -!! finalizes the logger_t entity sekf by flushing the units +!! finalizes the logger_t entity self by flushing the units type(logger_t), intent(in) :: self integer :: iostat From 4d59e4517576d53d18d3ef3d7fec3f99f86534ef Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Fri, 11 Sep 2020 17:42:44 -0600 Subject: [PATCH 050/121] Updated comments to configure and configuration Updated the comments to the `configure` and `configuration` routines to: 1. Make the casing consistent with the usage in other codes 2. Use the source code markings accent "`" consistently 3. Change the term "default" to "startup" as better catching the semantics. --- src/stdlib_logger.f90 | 42 +++++++++++++++++++++--------------------- 1 file changed, 21 insertions(+), 21 deletions(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index 332c20ff0..9d7b24b58 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -464,18 +464,18 @@ pure subroutine configuration( self, add_line, indent, max_width, & time_stamp, log_units ) !! version: experimental -!! Reports the logging configuration of SELF. The following attributes are +!! Reports the logging configuration of `self`. The following attributes are !! reported: -!! 1. ADD_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 +!! 1. `add_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 logical unit numbers to which log output +!! 5. `log_units` is an array of the I/O unit numbers to which log output !! will be written class(logger_t), intent(in) :: self !! The logger variable whose configuration is being reported @@ -526,18 +526,18 @@ pure subroutine configure( self, add_line, indent, max_width, time_stamp ) !! Configures the logging process for SELF. The following attributes are !! configured: -!! 1. ADD_LINE is a logical flag with .TRUE. implying that output starts -!! with a blank line, and .FALSE. implying no blank line. ADD_LINE has a -!! default value of .TRUE.. -!! 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 default 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 default +!! 1. `add_line` is a logical flag with `.true.` implying that output starts +!! with a blank line, and `.false.` implying no blank line. `add_line` has a +!! startup value of `.true.`. +!! 2. `indent` is a logical flag with `.true.` implying that subsequent lines +!! will be indented 4 spaces and `.false.` implying no indentation. `indent` +!! has an startup value of `.true.`. +!! 3. `max_width` is the maximum number of columns of output text with +!! `max_wodth == 0` => no bounds on output width. `max_width` has an startup !! value of 80. -!! 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 default value of .TRUE.. +!! 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 an startup value of `.true.`. !!##### Example !! From ee8b39ed2b7b60fe4c1c07323bf3efb7a1c5da57 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Fri, 11 Sep 2020 17:49:18 -0600 Subject: [PATCH 051/121] Updated final_logger and handle_write_failure comments Updated final_logger and handle_write_failure comments to be more consistent in case and use of "`". --- src/stdlib_logger.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index 9d7b24b58..225b6c71c 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -573,7 +573,7 @@ end subroutine configure subroutine final_logger( self ) !! version: experimental -!! finalizes the logger_t entity self by flushing the units +!! finalizes the `logger_t` entity `self` by flushing the units type(logger_t), intent(in) :: self integer :: iostat @@ -745,8 +745,8 @@ 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 +!! 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 From 4e86ef2cc51534419c0c2c5e9065fa44f38317d7 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Fri, 11 Sep 2020 18:19:06 -0600 Subject: [PATCH 052/121] Update comments in the log_* routines Updated the comments in the `log_error`, `log_information`, `log_io_error`, `log_message`, `log_text_error`, and `log_warning` subroutines to: 1. Be more consistent in casings with respect to other standard library fortran files 2. Be more consistent in using "`" to mark names of arguments and procedures 3. Correct some copy and paste errors involving "REPORT_ERR", that should be `log_error` etc. --- src/stdlib_logger.f90 | 64 ++++++++++++++++++++++--------------------- 1 file changed, 33 insertions(+), 31 deletions(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index 225b6c71c..f043521cd 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -779,14 +779,14 @@ end subroutine handle_write_failure subroutine log_error( self, message, module, procedure, stat, errmsg ) -!! Writes the string MESSAGE to SELF %LOG_UNITS with optional additional +!! 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 'ERROR: '. Then if STAT or ERRMSG +!! `module` or `procedure` are present, they are written. Then `message` is +!! written with the prefix 'ERROR: '. Then if `stat` or `errmsg` !! are present they are written. !! !!##### Example @@ -824,13 +824,13 @@ subroutine log_error( self, message, module, procedure, stat, errmsg ) character(len=*), intent(in) :: message !! A string to be written to LOG_UNIT character(len=*), intent(in), optional :: module -!! The name of the module contining the current invocation of REPORT_ERR +!! 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 REPORT_ERR +!! 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 +!! 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 +!! The value of the `ERRMSG` specifier returned by a Fortran statement integer :: unit integer :: iostat @@ -882,13 +882,13 @@ end subroutine log_error subroutine log_information( self, message, module, procedure ) -!! Writes the string MESSAGE to SELF % LOG_UNITS with optional additional +!! 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 +!! `module` or `procedure` are present, they are written. Then `message` is !! written with the prefix 'INFORMATION: '. !! !!##### Example @@ -923,9 +923,9 @@ subroutine log_information( self, message, module, procedure ) character(len=*), intent(in) :: message !! A string to be written to LOG_UNIT character(len=*), intent(in), optional :: module -!! The name of the module contining the current invocation of REPORT_ERR +!! 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 REPORT_ERR +!! The name of the procedure contining the current invocation of `log_information` call self % log_message( 'INFORMATION: ' // message, & module = module, & @@ -936,14 +936,14 @@ end subroutine log_information subroutine log_io_error( self, message, module, procedure, iostat, & iomsg ) -!! Writes the string MESSAGE to the SELF % LOG_UNITS with optional +!! Writes the string `message to the `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 a prefix 'I/O ERROR: '. Then if IOSTAT or IOMSG +!! `module` or `procedure` are present, they are written. Then `message` is +!! written with a prefix 'I/O ERROR: '. Then if `iostat` or `iomsg` !! are present they are also written. !! !!##### Example @@ -1031,13 +1031,13 @@ end subroutine log_io_error subroutine log_message( self, message, module, procedure ) !! version: experimental -!! Writes the string MESSAGE to the SELF % LOG_UNITS with optional +!! Writes the string `message` to the `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. Finally MESSAGE is +!! `module` or `procedure` are present, they are written. Finally `message` is !! written !! !!##### Example @@ -1069,9 +1069,9 @@ subroutine log_message( self, message, module, procedure ) character(len=*), intent(in) :: message !! A string to be written to LOG_UNIT character(len=*), intent(in), optional :: module -!! The name of the module contining the current invocation of LOG_MESSAGE +!! 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 +!! The name of the procedure contining the current invocation of `log_message` integer :: unit integer :: iostat @@ -1133,15 +1133,17 @@ end subroutine log_message subroutine log_text_error( self, line, column, summary, filename, & line_number, caret, stat ) -!! LOG_TEXT_ERROR sends a message to SELF % LOG_UNITS describing an error found +!! version: experimental + +!! `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 or column are present they are written. -!! Then LINE is written. Then a caret, '^', is written below LINE at the -!! column indicated by COLUMN. Then SUMMARY is written. +!! `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 !! @@ -1180,13 +1182,13 @@ subroutine log_text_error( self, line, column, summary, filename, & 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. +!! 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, INVALID_INDEX if COLUMN is less than zero or -!! greater than LEN(LINE), and WRITE_FAILURE if any of the WRITE statements +!! Integer flag that an error has occurred. Has the value `success` if no +!! error hass occurred, `invalid_index` 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 @@ -1293,7 +1295,7 @@ end subroutine log_text_error elemental function log_units_assigned(self) -!! Returns the number of units assigned to SELF % LOG_UNITS +!! Returns the number of units assigned to `self % log_units` class(logger_t), intent(in) :: self !! The logger subject to the inquiry integer :: log_units_assigned @@ -1325,12 +1327,12 @@ end function log_units_assigned subroutine log_warning( self, message, module, procedure ) -!! Writes the string MESSAGE to SELF % LOG_UNITS with optional additional text. +!! 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 +!! `module` or `procedure` are present, they are written. Then `message` is !! written with the prefix 'WARNING: '. !! !!##### Example @@ -1364,9 +1366,9 @@ subroutine log_warning( self, message, module, procedure ) character(len=*), intent(in) :: message !! A string to be written to LOG_UNIT character(len=*), intent(in), optional :: module -!! The name of the module contining the current invocation of REPORT_ERR +!! 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 REPORT_ERR +!! The name of the procedure contining the current invocation of `log_warning` call self % log_message( 'WARNING: ' // message, & module = module, & From ca6cd28ea1f9da293910cd94991b835c1eda5547 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sat, 12 Sep 2020 12:01:52 -0400 Subject: [PATCH 053/121] remove commented out assert code --- src/stdlib_logger.f90 | 60 ------------------------------------------- 1 file changed, 60 deletions(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index f043521cd..38284d0d8 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -85,7 +85,6 @@ module stdlib_logger contains -! procedure, pass(self) :: assert procedure, pass(self) :: add_log_file procedure, pass(self) :: add_log_unit procedure, pass(self) :: configuration @@ -401,65 +400,6 @@ end subroutine validate_unit end subroutine add_log_unit -! subroutine assert( self, test, message, module, procedure ) -! Checks the value of TEST and if TEST is .FALSE. writes output to the -! I/O units in SELF % LOG_UNITS and stops processing, otherwise it returns -! with no effect. -! -! ##### Behavior -! If TEST is .FALSE. ASSERT will write to the files, otherwise -! nothing is written. If time stamps are actiVe then the time stamp will -! be written first. Then if MODULE and PROCEDURE are present then they will -! be written.Finally MESSAGE, will be written prepended by the -! string 'ASSERTION FAILURE: '. -! -! class(logger_t), intent(in) :: self -!! The logger variabl to report the error -! logical, intent(in) :: test -!! A logical condition whose failure indicates an error has occurred. -! character(len=*), intent(in) :: message -!! Typically the textual representation of TEST -! character(len=*), intent(in), optional :: module -!! The name of the module containing the call of ASSERT -! character(len=*), intent(in), optional :: procedure -!! The name of the procedure containing the call of ASSERT -! -!!##### Example -!! -!! function factorial( i ) -!! use stdlib_logger -!! real :: factorial -!! integer, intent(in) :: i -!! integer :: j -!! call assert( i >= 0, & -!! 'i >= 0.', & -!! procedure = "FACTORIAL" ) -!! factorial = 1.0 -!! do j=1, i -!! factorial = factorial * j -!! end do -!! -!! return -!! end function factorial -! -! -! integer :: status_code -! -! if ( test ) then -! return -! -! end if -! -! call self % log_message( 'ASSERTION FAILURE: ' // message, & -! module = module, & -! procedure = procedure ) -! -! error stop 'Failed assertion' -! -! return -! -! end subroutine assert - pure subroutine configuration( self, add_line, indent, max_width, & time_stamp, log_units ) !! version: experimental From 01924ba594d381340db0ec78e42df778df379442 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sat, 12 Sep 2020 12:02:46 -0400 Subject: [PATCH 054/121] remove redundant return statement from the finalizer --- src/stdlib_logger.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index 38284d0d8..243b0c6cb 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -533,7 +533,6 @@ subroutine final_logger( self ) end do - return end subroutine final_logger From e390ea150b31e0be6b3ffb0eab8c582db9bdf59b Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Sat, 12 Sep 2020 19:41:59 -0600 Subject: [PATCH 055/121] Changed `logger_t` to `logger_type` --- src/stdlib_logger.f90 | 90 +++++++++++++++++++++---------------------- 1 file changed, 45 insertions(+), 45 deletions(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index 243b0c6cb..c60eedd6a 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -5,14 +5,14 @@ module stdlib_logger !! constants to be used for reporting errors by the Fortran Standard !! Library. !! -!! The derived type, `logger_t`, is to be used to define variables to +!! 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_t` the reports go to a list of I/O units +!! 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_t` also maintains an internal state +!! Each entity of type `logger_type` also maintains an internal state !! controlling the formatting of output. !! !! The procedures are as follows. The logical function @@ -25,7 +25,7 @@ module stdlib_logger !! `log_error`, `log_information`, `log_io_error`, `log_message`, !! `log_text_error`, and `log_warning` send messages to the log units. !! -!! The variable is the entity `global_logger` of type `logger_t`, to serve +!! The variable is the entity `global_logger` of type `logger_type`, to serve !! as its name suggests, as a global logger to be used as a default !! anywhere in the source code. !! @@ -54,7 +54,7 @@ module stdlib_logger implicit none private - public :: global_logger, logger_t + public :: global_logger, logger_type !! public constants used as error flags integer, parameter, public :: & @@ -71,7 +71,7 @@ module stdlib_logger character(*), parameter :: module_name = 'stdlib_logger' !! Public derived type - type :: logger_t + type :: logger_type !! version: experimental private @@ -98,10 +98,10 @@ module stdlib_logger procedure, pass(self) :: log_units_assigned procedure, pass(self) :: log_warning procedure, pass(self) :: remove_log_unit - end type logger_t + end type logger_type - !! Variable of type LOGGER_T to be used as a global logger - type(logger_t) :: global_logger + !! 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.' @@ -122,7 +122,7 @@ subroutine add_log_file( self, filename, unit, action, position, status, & !! `success` if `filename` could be opened, `read_only_error` if `ACTION` is !! `"READ"`, and `open_failure` otherwise. - class(logger_t), intent(inout) :: self + 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 @@ -245,11 +245,11 @@ subroutine add_log_unit( self, unit, stat ) !! `"WRITE"` or `"READWRITE"`, otherwise either `stat`, if preseent, has a !! value other than `success` and `unit` is not entered into L`log_units`, !! or, if `stat` is not presecn, processing stops. - class(logger_t), intent(inout) :: self + class(logger_type), intent(inout) :: self !! The logger variable to which the I/O unit is to be added - integer, intent(in) :: unit + integer, intent(in) :: unit !! The input logical unit number - integer, intent(out), optional :: stat + 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 @@ -417,7 +417,7 @@ pure subroutine configuration( self, add_line, indent, max_width, & !! time stamp. !! 5. `log_units` is an array of the I/O unit numbers to which log output !! will be written - class(logger_t), intent(in) :: self + class(logger_type), intent(in) :: self !! The logger variable whose configuration is being reported logical, intent(out), optional :: add_line !! A logical flag to add a preceding blank line @@ -487,11 +487,11 @@ pure subroutine configure( self, add_line, indent, max_width, time_stamp ) !! call global_logger % configure( indent=.false., max_width=72 ) !! ... - class(logger_t), intent(inout) :: self - logical, intent(in), optional :: add_line - logical, intent(in), optional :: indent - integer, intent(in), optional :: max_width - logical, intent(in), optional :: time_stamp + class(logger_type), intent(inout) :: self + logical, intent(in), optional :: add_line + logical, intent(in), optional :: indent + integer, intent(in), optional :: max_width + logical, intent(in), optional :: time_stamp if ( present(add_line) ) self % add_line = add_line if ( present(indent) ) self % indent_lines = indent @@ -513,8 +513,8 @@ end subroutine configure subroutine final_logger( self ) !! version: experimental -!! finalizes the `logger_t` entity `self` by flushing the units - type(logger_t), intent(in) :: self +!! finalizes the `logger_type` entity `self` by flushing the units + type(logger_type), intent(in) :: self integer :: iostat character(256) :: message @@ -523,8 +523,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_t 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) @@ -543,11 +543,11 @@ subroutine format_output_string( self, unit, string, procedure_name, & !! 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_t), 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(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 @@ -735,7 +735,7 @@ subroutine log_error( self, message, module, procedure, stat, errmsg ) !! ... !! real, allocatable :: a(:) !! ... -!! type(logger_t) :: alogger +!! type(logger_type) :: alogger !! ... !! contains !! ... @@ -758,7 +758,7 @@ subroutine log_error( self, message, module, procedure, stat, errmsg ) !! end module example_mod !! - class(logger_t), intent(in) :: self + 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 @@ -837,7 +837,7 @@ subroutine log_information( self, message, module, procedure ) !! ... !! real, allocatable :: a(:) !! ... -!! type(logger_t) :: alogger +!! type(logger_type) :: alogger !! ... !! contains !! ... @@ -857,7 +857,7 @@ subroutine log_information( self, message, module, procedure ) !! end module example_mod !! - class(logger_t), intent(in) :: self + 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 @@ -905,7 +905,7 @@ subroutine log_io_error( self, message, module, procedure, iostat, & !! ... !! end program example - class(logger_t), intent(in) :: self + 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 @@ -1003,7 +1003,7 @@ subroutine log_message( self, message, module, procedure ) !! end module example_mod !! - class(logger_t), intent(in) :: self + 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 @@ -1110,7 +1110,7 @@ subroutine log_text_error( self, line, column, summary, filename, & !! ... !! end program example !! - class(logger_t), intent(in) :: self + 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. @@ -1235,15 +1235,15 @@ end subroutine log_text_error elemental function log_units_assigned(self) !! Returns the number of units assigned to `self % log_units` - class(logger_t), intent(in) :: self + class(logger_type), intent(in) :: self !! The logger subject to the inquiry - integer :: log_units_assigned + integer :: log_units_assigned !!##### Example !! !! module example_mod !! use stdlib_logger !! ... -!! type(logger_t) :: alogger +!! type(logger_type) :: alogger !! ... !! contains !! ... @@ -1281,7 +1281,7 @@ subroutine log_warning( self, message, module, procedure ) !! ... !! real, allocatable :: a(:) !! ... -!! type(logger_t) :: alogger +!! type(logger_type) :: alogger !! ... !! contains !! ... @@ -1300,7 +1300,7 @@ subroutine log_warning( self, message, module, procedure ) !! ... !! end module example_mod !! - class(logger_t), intent(in) :: self + 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 @@ -1323,13 +1323,13 @@ subroutine remove_log_unit( self, unit, close_unit, stat ) !! 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. - class(logger_t), intent(inout) :: self + class(logger_type), intent(inout) :: self !! The logger variable whose unit is to be removed - integer, intent(in) :: unit + integer, intent(in) :: unit !! The I/O unit to be removed from SELF - logical, intent(in), optional :: close_unit + 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 + integer, intent(out), optional :: stat !! An error status with the values !! * SUCCESS - no problems found !! * CLOSE_FAILURE - the CLOSE statement for UNIT failed @@ -1339,7 +1339,7 @@ subroutine remove_log_unit( self, unit, close_unit, stat ) !! module example_mod !! use stdlib_logger !! ... -!! type(logger_t) :: alogger +!! type(logger_type) :: alogger !! contains !! ... !! subroutine example_sub(unit, ...) From b51df68298cf6d6df4972fd94937d65f723ad442 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Sat, 12 Sep 2020 19:48:36 -0600 Subject: [PATCH 056/121] Changed `logger_t` to `logger_type` --- doc/specs/stdlib_logger.md | 59 +++++++++++++++++++++----------------- 1 file changed, 32 insertions(+), 27 deletions(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index a1d909323..26a19f506 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -9,11 +9,11 @@ title: stdlib_logger 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_t`, is to be used to define -both global and local logger variables. The `logger_t` methods serve +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_t`, is +`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. @@ -34,7 +34,7 @@ The logger variables have the option to: * indent subsequent lines of the messages; and * format the text to fit within a maximum column width. -Note: Loggers of type `logger_t` normally report their messages to I/O +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`. @@ -58,7 +58,7 @@ procedures. The constants, termed error codes, are as follows: |`unopened_in_error`| the unit was not opened| | `write_fault` | one of the writes to `log_units` failed| -## The derived type: logger_t +## The derived type: logger_type ### Status @@ -71,7 +71,7 @@ significant events encountered during the execution of a program. ### Syntax -type(logger_t) :: variable +type(logger_type) :: variable ### Private attributes @@ -87,12 +87,12 @@ type(logger_t) :: variable ## The `stdlib_logger` variable The module defines one public variable, `global_logger`, of type -`logger_t`. As might be guessed from its name, `global_logger` is +`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_t` methods +### Public `logger_type` methods The module defines twelve public procedures: one function and eleven subroutines. The @@ -113,7 +113,7 @@ procedures are: |`log_warning`|Subroutine| sends a message prepended by `'WARNING: '`| |`remove_log_unit`|Subroutine| removes the `unit` number from the `log_units` array| -## Specification of the `logger_t` methods +## Specification of the `logger_type` methods ### `add_log_file` - open a file and add its unit to `self % log_units` @@ -137,7 +137,8 @@ Subroutine #### Arguments -`self`: shall be a scalar variable of type `logger_t`. It is an `intent(inout)` argument. It shall be the logger to add the file to its `log_units`. +`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. @@ -213,7 +214,7 @@ Subroutine. #### Arguments -`self`: shall be a scalar variable of type `logger_t`. It is an +`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`. @@ -284,7 +285,8 @@ Pure subroutine #### Arguments -`self`: shall be a scalar variable of type `logger_t`. It is an `intent(in)` argument. It shall be the logger whose configuration is reported. +`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_line` (optional): shall be a scalar default logical variable. It is an `intent(out)` argument. A value of `.true.` @@ -315,7 +317,7 @@ Pure subroutine module example_mod use stdlib_logger ... - type(logger_t) :: logger + type(logger_type) :: logger contains ... subroutine example_sub(unit, ...) @@ -353,7 +355,8 @@ Pure subroutine #### Arguments -`self`: shall be a scalar variable of type `logger_t`. It is an `intent(inout)` argument. It shall be the logger to be configured. +`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_line` (optional): shall be a scalar default logical expression. It is an `intent(in)` argument. Set to `.true.` to start @@ -412,7 +415,8 @@ Subroutine #### Arguments -`self`: shall be a scalar expression of type `logger_t`. It is an `intent(in)` argument. It is the logger used to send the message. +`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. @@ -443,7 +447,7 @@ Subroutine ... real, allocatable :: a(:) ... - type(logger_t) :: logger + type(logger_type) :: logger ... contains ... @@ -493,7 +497,7 @@ Subroutine #### Arguments -`self`: shall be a scalar expression of type `logger_t`. It is an +`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 @@ -515,7 +519,7 @@ Subroutine ... real, allocatable :: a(:) ... - type(logger_t) :: logger + type(logger_type) :: logger contains ... subroutine example_sub( selection ) @@ -562,7 +566,8 @@ written. Subroutine #### Arguments -`self`: shall be a scalar expression of type `logger_t`. It is an `intent(in)` argument. It is the logger used to send the message. +`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. @@ -637,7 +642,7 @@ Subroutine #### Arguments -`self`: shall be a scalar expression of type `logger_t`. It is an +`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 @@ -659,7 +664,7 @@ Subroutine ... real, allocatable :: a(:) ... - type(logger_t) :: logger + type(logger_type) :: logger contains ... subroutine example_sub( selection ) @@ -706,7 +711,7 @@ Subroutine #### Arguments -`self`: shall be a scalar expression of type `logger_t`. It is an +`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 @@ -792,7 +797,7 @@ Elemental function #### Argument -`self`: shall be a scalar expression of type `logger_t`. It is an +`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 @@ -809,7 +814,7 @@ The result is the number of I/O units in module example_mod use stdlib_logger ... - type(logger_t) :: logger + type(logger_type) :: logger contains ... subroutine example_sub(unit, ...) @@ -854,7 +859,7 @@ Subroutine #### Arguments -`self`: shall be a scalar expression of type `logger_t`. It is an +`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 @@ -875,7 +880,7 @@ Subroutine use stdlib_logger ... real, allocatable :: a(:) - type(logger_t) :: logger + type(logger_type) :: logger ... contains ... @@ -917,7 +922,7 @@ Subroutine #### Arguments -`self`: shall be a scalar expression of type `logger_t`. It is an +`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. From a4bcf3afc8673fe2ad07cc5e24c02fed2794bcfd Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Sat, 12 Sep 2020 20:00:38 -0600 Subject: [PATCH 057/121] Changed `add_line` to `add_blank_line` Also changed its startup value to .false. --- src/stdlib_logger.f90 | 41 ++++++++++++++++++++++------------------- 1 file changed, 22 insertions(+), 19 deletions(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index c60eedd6a..48df156d7 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -76,7 +76,7 @@ module stdlib_logger private - logical :: add_line = .TRUE. + logical :: add_blank_line = .FALSE. logical :: indent_lines = .TRUE. integer, allocatable :: log_units(:) integer :: max_width = 80 @@ -400,14 +400,14 @@ end subroutine validate_unit end subroutine add_log_unit - pure subroutine configuration( self, add_line, indent, max_width, & - time_stamp, log_units ) + 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_line` is a logical flag with `.true.` implying that output starts -!! with a blank line, and `.false.` implying no blank line. +!! 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 @@ -419,7 +419,7 @@ pure subroutine configuration( self, add_line, indent, max_width, & !! will be written class(logger_type), intent(in) :: self !! The logger variable whose configuration is being reported - logical, intent(out), optional :: add_line + 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 @@ -452,7 +452,8 @@ pure subroutine configuration( self, add_line, indent, max_width, & !! end module example_mod - if ( present(add_line) ) add_line = self % add_line + 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 @@ -461,23 +462,24 @@ pure subroutine configuration( self, add_line, indent, max_width, & end subroutine configuration - pure subroutine configure( self, add_line, indent, max_width, time_stamp ) + 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_line` is a logical flag with `.true.` implying that output starts -!! with a blank line, and `.false.` implying no blank line. `add_line` has a -!! startup value of `.true.`. +!! 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 an startup value of `.true.`. +!! has a startup value of `.true.`. !! 3. `max_width` is the maximum number of columns of output text with -!! `max_wodth == 0` => no bounds on output width. `max_width` has an startup +!! `max_wodth == 0` => no bounds on output width. `max_width` has a startup !! value of 80. !! 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 an startup value of `.true.`. +!! time stamp. `time_stamp` has a startup value of `.true.`. !!##### Example !! @@ -488,12 +490,13 @@ pure subroutine configure( self, add_line, indent, max_width, time_stamp ) !! ... class(logger_type), intent(inout) :: self - logical, intent(in), optional :: add_line + 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_line) ) self % add_line = add_line + 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 @@ -1033,8 +1036,8 @@ subroutine log_message( self, message, module, procedure ) subroutine write_log_message( unit ) integer, intent(in) :: unit - if ( self % add_line ) write( unit, *, err=999, iostat=iostat, & - iomsg=iomsg ) + if ( self % add_blank_line ) write( unit, *, err=999, & + iostat=iostat, iomsg=iomsg ) if ( self % time_stamp ) write( unit, '(a)', err=999, & iostat=iostat, iomsg=iomsg ) time_stamp() @@ -1175,7 +1178,7 @@ subroutine log_text_error( self, line, column, summary, filename, & subroutine write_log_text_error( unit ) integer, intent(in) :: unit - if ( self % add_line ) write( unit, * ) + if ( self % add_blank_line ) write( unit, * ) if ( self % time_stamp ) write( unit, '(a)' ) time_stamp() From b26df7b2d6333ce0b00492edf5db3be3848b0110 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Sat, 12 Sep 2020 20:04:04 -0600 Subject: [PATCH 058/121] Changed `add_line` to `add_blank_line` --- doc/specs/stdlib_logger.md | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 26a19f506..66419bb28 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -77,7 +77,7 @@ type(logger_type) :: variable | Attribute | Type | Description | Initial value | |-----------|------|-------------|---------| -| `add_line` | Logical | Flag to precede output with a blank line |`.true.`| +| `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 | 80 | @@ -277,7 +277,7 @@ Reports the configuration of a logger. #### Syntax -`call [[stdlib_logger(module):self % configuration(interface)]]( [ add_line, indent, max_width, time_stamp, log_units ] )` +`call [[stdlib_logger(module):self % configuration(interface)]]( [ add_blankline, indent, max_width, time_stamp, log_units ] )` #### Class @@ -288,7 +288,7 @@ Pure subroutine `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_line` (optional): shall be a scalar default logical +`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. @@ -347,7 +347,7 @@ Configures the logging process for self. #### Syntax -`call [[stdlib_logger(module):self % configure(interface)]]( [ add_line, indent, max_width, time_stamp ] )` +`call [[stdlib_logger(module):self % configure(interface)]]( [ add_blank_line, indent, max_width, time_stamp ] )` #### Class @@ -358,7 +358,7 @@ Pure subroutine `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_line` (optional): shall be a scalar default logical +`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. From 470b6bfe79be09d4c1c036514c993ea057522128 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Sat, 12 Sep 2020 20:30:08 -0600 Subject: [PATCH 059/121] Changed `add_line` to `add_blank_line` Changed `add_line` to `add_blank_line` and tried to change the rest of the output to be consistent with the new initial value of .false. --- src/tests/logger/test_stdlib_logger.f90 | 31 +++++++++++++------------ 1 file changed, 16 insertions(+), 15 deletions(-) diff --git a/src/tests/logger/test_stdlib_logger.f90 b/src/tests/logger/test_stdlib_logger.f90 index 47ad030b0..dd91f2aaf 100644 --- a/src/tests/logger/test_stdlib_logger.f90 +++ b/src/tests/logger/test_stdlib_logger.f90 @@ -14,7 +14,7 @@ program test_stdlib_logger integer, allocatable :: log_units(:) integer :: max_width, stat integer :: unit1, unit2, unit3, unit4, unit5, unit6 - logical :: add_line, exist, indent, time_stamp + logical :: add_blank_line, exist, indent, time_stamp if ( global % log_units_assigned() == 0 ) then write(*,*) 'Start off with 0 LOG_UNITS as expected.' @@ -32,7 +32,7 @@ program test_stdlib_logger 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 one blank line, then by a time stamp, then by ' // & + '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.', & @@ -78,15 +78,15 @@ subroutine test_logging_configuration() print *, 'running test_logging_configuration' - call global % configuration( add_line=add_line, & + 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_line ) then - write(*,*) 'ADD_LINE starts off as .TRUE. as expected.' + if ( .not. add_blank_line ) then + write(*,*) 'ADD_BLANK_LINE starts off as .FALSE. as expected.' else - error stop 'ADD_LINE starts off as .FALSE. contrary to ' // & + error stop 'ADD_BLANK_LINE starts off as .TRUE. contrary to ' // & 'expectations.' end if @@ -134,17 +134,18 @@ subroutine test_logging_configuration() module = 'N/A', & procedure = 'TEST_STDLIB_LOGGER' ) - call global % configure( add_line=.false., indent=.false., & + call global % configure( add_blank_line=.true., indent=.false., & max_width=72, time_stamp=.false. ) - call global % configuration( add_line=add_line, indent=indent, & - max_width=max_width, time_stamp=time_stamp, log_units=log_units ) + 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_line ) then - write(*,*) 'ADD_LINE is now .FALSE. as expected.' + if ( add_blank_line ) then + write(*,*) 'ADD_BLANK_LINE is now .FALSE. as expected.' else - error stop 'ADD_LINE is now .TRUE. contrary to expectations.' + error stop 'ADD_BLANKLINE is now .FALSE. contrary to expectations.' end if @@ -184,18 +185,18 @@ subroutine test_logging_configuration() call global % log_message( 'This message should still be output ' // & 'to OUTPUT_UNIT, limited to 72 columns width, preceded by ' // & - 'no blank line, then by no time stamp, then by MODULE % ' // & + '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_line=.true., indent=.true., & + 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 a blank line, then by a time stamp, then by ' // & + 'preceded by no blank line, then by a time stamp, then by ' // & 'MODULE % PROCEDURE, have a prefix of WARNING, and be ' // & 'indented by 4 columns on subsequent lines.', & module = 'N/A', & From 666c5a6282e27765ae9696be4db57fe0afc9ea69 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Sun, 13 Sep 2020 07:45:57 -0600 Subject: [PATCH 060/121] Changed initial max_width to 0 --- src/stdlib_logger.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index 48df156d7..626a35d0e 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -79,7 +79,7 @@ module stdlib_logger logical :: add_blank_line = .FALSE. logical :: indent_lines = .TRUE. integer, allocatable :: log_units(:) - integer :: max_width = 80 + integer :: max_width = 0 logical :: time_stamp = .TRUE. integer :: units = 0 @@ -476,7 +476,7 @@ pure subroutine configure( self, add_blank_line, indent, max_width, & !! has a startup value of `.true.`. !! 3. `max_width` is the maximum number of columns of output text with !! `max_wodth == 0` => no bounds on output width. `max_width` has a startup -!! value of 80. +!! 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.`. From 867bab0d15c9ec7d961f8050c323864eed9c2b9d Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Sun, 13 Sep 2020 07:51:05 -0600 Subject: [PATCH 061/121] updated to be consistent with max_width==0 --- src/tests/logger/test_stdlib_logger.f90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/tests/logger/test_stdlib_logger.f90 b/src/tests/logger/test_stdlib_logger.f90 index dd91f2aaf..adddc6c45 100644 --- a/src/tests/logger/test_stdlib_logger.f90 +++ b/src/tests/logger/test_stdlib_logger.f90 @@ -99,11 +99,11 @@ subroutine test_logging_configuration() end if - if ( max_width == 80 ) then - write(*,*) 'MAX_WIDTH starts off as 80 as expected.' + 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 80 contrary ' // & + error stop 'MAX_WIDTH starts off as not equal to 0 contrary ' // & 'to expectations.' end if @@ -127,8 +127,8 @@ subroutine test_logging_configuration() end if call global % log_information( 'This message should be output ' // & - 'to OUTPUT_UNIT, limited to 80 columns width, preceded by ' // & - 'one blank line, then by a time stamp, then by MODULE % ' // & + 'to OUTPUT_UNIT, unlimited in width, not preceded by ' // & + 'a blank line, then by a time stamp, then by MODULE % ' // & 'PROCEDURE, be prefixed by INFORMARION and be indented on ' // & 'subsequent lines by 4 columns.', & module = 'N/A', & From 1adbc9519ef235f0c65545bb2d617e0453f89133 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Sun, 13 Sep 2020 08:04:47 -0600 Subject: [PATCH 062/121] Described initial `max_width` as 0 --- doc/specs/stdlib_logger.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 66419bb28..fa371fc92 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -80,7 +80,7 @@ type(logger_type) :: variable | `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 | 80 | +|`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 | From c171c4ffdfe91f648c19a0f14788d4004c4485c7 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Sun, 13 Sep 2020 10:39:13 -0600 Subject: [PATCH 063/121] Simplified module and procedure output --- src/stdlib_logger.f90 | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index 626a35d0e..484af8d9d 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -1044,19 +1044,18 @@ subroutine write_log_message( unit ) if ( present(module) ) then if ( present(procedure) ) then - write( unit, & - "('Module % Procedure: ', a, ' % ', a)", & - err=999, iostat=iostat, iomsg=iomsg) & + write( unit, "(a, ' % ', a)", err=999, & + iostat=iostat, iomsg=iomsg) & trim( module ), trim( procedure ) else - write( unit, "( 'Module: ', a)", err=999, iostat=iostat, & + write( unit, "(a)", err=999, iostat=iostat, & iomsg=iomsg ) trim( module ) end if else if ( present(procedure) ) then - write( unit, "( 'Procedure: ', a)", err=999, iostat=iostat, & + write( unit, "(a)", err=999, iostat=iostat, & iomsg=iomsg ) trim( procedure ) end if From 0cab191272f2ece1d3c157e2ae7f9b1af0312e57 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Wed, 16 Sep 2020 10:13:14 -0600 Subject: [PATCH 064/121] Aligned arguments Aligned one argument vertically that had been misaligned in changing `logger_t` to `logger_type`. --- src/stdlib_logger.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index 484af8d9d..c50cf7586 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -417,7 +417,7 @@ pure subroutine configuration( self, add_blank_line, indent, & !! time stamp. !! 5. `log_units` is an array of the I/O unit numbers to which log output !! will be written - class(logger_type), intent(in) :: self + 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 From 9d89e0869bbcda3936cb9c35de296565791e2c9f Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Wed, 16 Sep 2020 11:58:54 -0600 Subject: [PATCH 065/121] Added `prefix` argument to `log_message` Added `prefix` argument to `log_message` in preparation for adding color coding, and changing `WARNING` to `WARN` and `INFORMATION` to `INFO`. --- src/stdlib_logger.f90 | 28 ++++++++++++++++++++++------ 1 file changed, 22 insertions(+), 6 deletions(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index c50cf7586..7c788adfb 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -970,7 +970,7 @@ end subroutine write_log_io_error end subroutine log_io_error - subroutine log_message( self, message, module, procedure ) + subroutine log_message( self, message, module, procedure, prefix ) !! version: experimental !! Writes the string `message` to the `self % log_units` with optional @@ -978,9 +978,9 @@ subroutine log_message( self, message, module, procedure ) !! !!##### Behavior !! -!! If time stamps are active, a time stamp is written first. Then if -!! `module` or `procedure` are present, they are written. Finally `message` is -!! written +!! If time stamps are active, a time stamp is written, followed by `module` +!! or `procedure` if present, followed by `prefix // ': '`, and then +!! `message`. !! !!##### Example !! @@ -1000,7 +1000,8 @@ subroutine log_message( self, message, module, procedure ) !! "The user selected ", selection !! call global_logger % log_message( message, & !! module = 'EXAMPLE_MOD', & -!! procedure = 'EXAMPLE_SUB' ) +!! procedure = 'EXAMPLE_SUB', & +!! prefix = 'INFO' ) !! end subroutine example_sub !! ... !! end module example_mod @@ -1014,11 +1015,25 @@ subroutine log_message( self, message, module, procedure ) !! 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 :: pref + + write(*,*) 'Got to 2' + if ( present(prefix) ) then + allocate( character(len=len(prefix)+2):: pref ) + pref = prefix // ': ' + + else + allocate( character(len=0):: pref ) + pref = '' + + end if if ( self % units == 0 ) then call write_log_message( output_unit ) @@ -1060,7 +1075,8 @@ subroutine write_log_message( unit ) end if - call format_output_string( self, unit, trim( message ), & + call format_output_string( self, unit, & + pref // trim( message ), & procedure_name, ' ' ) return From c6a6711df23f4ee7a6330cafd1cd8913bf8f5206 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Wed, 16 Sep 2020 12:11:02 -0600 Subject: [PATCH 066/121] Documented `prefix` argument Documented `prefix` argument to `log_message` --- doc/specs/stdlib_logger.md | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index fa371fc92..d09a5cd90 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -628,13 +628,13 @@ Writes the string `message` to `self % log_units` with #### 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 no prefix. +If time stamps are active, a time stamp is written, +then `module` and `procedure` are written if prsent, +followed by `prefix`, if present, and finally `message`. #### Syntax -`call [[stdlib_logger(module):self % log_message(interface)]]( message [, module, procedure ] )` +`call [[stdlib_logger(module):self % log_message(interface)]]( message [, module, procedure, prefix ] )` #### Class @@ -655,6 +655,10 @@ Subroutine `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 preceed `message` with an +`': '` appended. #### Example @@ -676,7 +680,8 @@ Subroutine "The user selected ", selection call logger % log_message( message, & module = 'EXAMPLE_MOD', & - procedure = 'EXAMPLE_SUB' ) + procedure = 'EXAMPLE_SUB', & + prefix = `INFO' ) end subroutine example_sub ... end module example_mod From d77170750f1778ea994f8ae7e8346031d1c6910a Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Wed, 16 Sep 2020 12:28:51 -0600 Subject: [PATCH 067/121] Changed prefixes Changed 'WARNING' and 'INFORMATION' to 'WARN' and 'INFO'. Also changed description of `log_*` subroutines. --- src/stdlib_logger.f90 | 56 +++++++++++++++++++++++-------------------- 1 file changed, 30 insertions(+), 26 deletions(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index 7c788adfb..9a334b123 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -726,9 +726,9 @@ subroutine log_error( self, message, module, procedure, stat, errmsg ) !! !!##### 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 'ERROR: '. Then if `stat` or `errmsg` +!! 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 @@ -779,9 +779,10 @@ subroutine log_error( self, message, module, procedure, stat, errmsg ) character(*), parameter :: procedure_name = 'LOG_ERROR' character(256) :: iomsg - call self % log_message( 'ERROR: ' // message, & - module = module, & - procedure = procedure ) + call self % log_message( message, & + module = module, & + procedure = procedure, & + prefix = 'ERROR') if ( self % units == 0 ) then call write_log_error( output_unit ) @@ -829,9 +830,9 @@ subroutine log_information( self, message, module, procedure ) !! !!##### 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 'INFORMATION: '. +!! 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 !! @@ -869,9 +870,10 @@ subroutine log_information( self, message, module, procedure ) character(len=*), intent(in), optional :: procedure !! The name of the procedure contining the current invocation of `log_information` - call self % log_message( 'INFORMATION: ' // message, & - module = module, & - procedure = procedure ) + call self % log_message( message, & + module = module, & + procedure = procedure, & + prefix = 'INFO' ) end subroutine log_information @@ -883,9 +885,9 @@ subroutine log_io_error( self, message, module, procedure, iostat, & !! !!##### 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 a prefix 'I/O ERROR: '. Then if `iostat` or `iomsg` +!! 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 @@ -926,9 +928,10 @@ subroutine log_io_error( self, message, module, procedure, iostat, & character(*), parameter :: procedure_name = 'LOG_ERROR' character(256) :: iomsg2 - call self % log_message( 'I/O ERROR: ' // message, & - module = module, & - procedure = procedure ) + 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 ) @@ -979,8 +982,8 @@ subroutine log_message( self, message, module, procedure, prefix ) !!##### Behavior !! !! If time stamps are active, a time stamp is written, followed by `module` -!! or `procedure` if present, followed by `prefix // ': '`, and then -!! `message`. +!! and `procedure` if present, followed by `prefix // ': '` if present, +!! and then `message`. !! !!##### Example !! @@ -1288,9 +1291,9 @@ subroutine log_warning( self, message, module, procedure ) !! !!##### 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 'WARNING: '. +!! 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 !! @@ -1327,9 +1330,10 @@ subroutine log_warning( self, message, module, procedure ) character(len=*), intent(in), optional :: procedure !! The name of the procedure contining the current invocation of `log_warning` - call self % log_message( 'WARNING: ' // message, & - module = module, & - procedure = procedure ) + call self % log_message( message, & + module = module, & + procedure = procedure, & + prefix = 'WARN' ) end subroutine log_warning From bcf0f01bc79bff3f74f945ee5bc2f26ba72907a2 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Wed, 16 Sep 2020 12:38:03 -0600 Subject: [PATCH 068/121] Updated `log_*` descriptions Updated `log_*` descriptions to change WARNING and INFORMATION to WARN and INFO respectively and simplify the descriptions of some of the methods. --- doc/specs/stdlib_logger.md | 26 ++++++++++++-------------- 1 file changed, 12 insertions(+), 14 deletions(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index d09a5cd90..ea199109a 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -105,12 +105,12 @@ procedures are: |`configure`|Subroutine| configures the details of the logging process| |`configuration`|Subroutine| reports the details of the logging configuration| |`log_error`| Subroutine|sends a message prepended by `'ERROR: '` optionally followed by a `stat` or `errmsg`| -|`log_information`|Subroutine| sends a message prepended by `'INFORMATION: '`| +|`log_information`|Subroutine| sends a message prepended by `'INFO: '`| |`log_io_error`|Subroutine|sends a message prepended by `'I/O ERROR: '` optionally followed by an `iostat` or `iomsg`| |`log_message`|Subroutine| sends a message| |`log_text_error`|Subroutine| sends a message describing an error found in a line of text| |`log_units_assigned`|Function| returns the number of active I/O units in `log_units`| -|`log_warning`|Subroutine| sends a message prepended by `'WARNING: '`| +|`log_warning`|Subroutine| sends a message prepended by `'WARN: '`| |`remove_log_unit`|Subroutine| removes the `unit` number from the `log_units` array| ## Specification of the `logger_type` methods @@ -404,9 +404,9 @@ Writes the string `message` to `self % log_units` with optional additional text. #### Behavior -If time stamps are active for `self`, a time stamp is written -first. Then if `module` or `procedure` are present, they are -written. Then `message` is written with the prefix `'ERROR: '`. Then +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 @@ -486,10 +486,9 @@ 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 -`'INFORMATION: '`. +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 @@ -630,7 +629,7 @@ Writes the string `message` to `self % log_units` with If time stamps are active, a time stamp is written, then `module` and `procedure` are written if prsent, -followed by `prefix`, if present, and finally `message`. +followed by `prefix \\ ': '`, if present, and finally `message`. #### Syntax @@ -849,10 +848,9 @@ Writes the string `message` to `log_units` with #### 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 -`WARNING: '`. +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 From b6c63cd5fa20d04b6eb303422242a1b34be16694 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Wed, 16 Sep 2020 20:44:07 +0200 Subject: [PATCH 069/121] Update doc/specs/stdlib_logger.md Co-authored-by: Ian Giestas Pauli --- doc/specs/stdlib_logger.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index ea199109a..9f0d40d2c 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -656,7 +656,7 @@ Subroutine the procedure containing the `log_message` call. `prefix` (optional): shall be a scalar default character expression. -It is an `intent(in)` argument. It will preceed `message` with an +It is an `intent(in)` argument. It will precede `message` with an `': '` appended. #### Example From ba052404932a3a7eb5894f0b371451569fd90da3 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Wed, 16 Sep 2020 20:44:34 +0200 Subject: [PATCH 070/121] Update doc/specs/stdlib_logger.md Co-authored-by: Ian Giestas Pauli --- doc/specs/stdlib_logger.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 9f0d40d2c..71e67ffc1 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -628,7 +628,7 @@ Writes the string `message` to `self % log_units` with #### Behavior If time stamps are active, a time stamp is written, -then `module` and `procedure` are written if prsent, +then `module` and `procedure` are written if present, followed by `prefix \\ ': '`, if present, and finally `message`. #### Syntax From f4cd37d18488f62bc7653a1a9afe243523e8591f Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Wed, 16 Sep 2020 14:12:56 -0600 Subject: [PATCH 071/121] Updated to output one line Updated to output date and time, module and procedure, prefix and message all in one line and in that order. --- src/stdlib_logger.f90 | 63 ++++++++++++++++++++++++------------------- 1 file changed, 36 insertions(+), 27 deletions(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index 9a334b123..f3e41e843 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -972,7 +972,6 @@ end subroutine write_log_io_error end subroutine log_io_error - subroutine log_message( self, message, module, procedure, prefix ) !! version: experimental @@ -1025,9 +1024,8 @@ subroutine log_message( self, message, module, procedure, prefix ) integer :: iostat character(*), parameter :: procedure_name = 'LOG_MESSAGE' character(256) :: iomsg - character(:), allocatable :: pref + character(:), allocatable :: d_and_t, m_and_p, pref - write(*,*) 'Got to 2' if ( present(prefix) ) then allocate( character(len=len(prefix)+2):: pref ) pref = prefix // ': ' @@ -1038,6 +1036,38 @@ subroutine log_message( self, message, module, procedure, prefix ) end if + if ( self % time_stamp ) then + allocate( character(25) :: d_and_t ) + d_and_t = time_stamp() // ': ' + + else + allocate( character(0) :: d_and_t ) + d_and_t = '' + + end if + + if ( present(module) ) then + if ( present(procedure) ) then + allocate( character( len_trim(module) + & + len_trim(procedure) + 5 ) :: m_and_p ) + m_and_p = trim(module) // ' % ' // trim(procedure) // ': ' + + else + allocate( character( len_trim(module) + 2 ) :: m_and_p ) + m_and_p = trim(module) // ': ' + + end if + + else if ( present(procedure) ) then + allocate( character( len_trim(procedure) + 2 ) :: m_and_p ) + m_and_p = trim(procedure) // ': ' + + else + allocate( character( 0 ) :: m_and_p ) + m_and_p = '' + + end if + if ( self % units == 0 ) then call write_log_message( output_unit ) @@ -1057,29 +1087,9 @@ subroutine write_log_message( unit ) if ( self % add_blank_line ) write( unit, *, err=999, & iostat=iostat, iomsg=iomsg ) - if ( self % time_stamp ) write( unit, '(a)', err=999, & - iostat=iostat, iomsg=iomsg ) time_stamp() - - if ( present(module) ) then - if ( present(procedure) ) then - write( unit, "(a, ' % ', a)", err=999, & - iostat=iostat, iomsg=iomsg) & - trim( module ), trim( procedure ) - - else - write( unit, "(a)", err=999, iostat=iostat, & - iomsg=iomsg ) trim( module ) - - end if - - else if ( present(procedure) ) then - write( unit, "(a)", err=999, iostat=iostat, & - iomsg=iomsg ) trim( procedure ) - - end if - - call format_output_string( self, unit, & - pref // trim( message ), & + call format_output_string( self, unit, & + d_and_t // m_and_p // pref // & + trim( message ), & procedure_name, ' ' ) return @@ -1090,7 +1100,6 @@ end subroutine write_log_message end subroutine log_message - subroutine log_text_error( self, line, column, summary, filename, & line_number, caret, stat ) !! version: experimental From 811d969404a40369db6a2aa2eb87e101f96490e3 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Wed, 16 Sep 2020 14:23:57 -0600 Subject: [PATCH 072/121] Update test_stdlib_logger.f90 to new output Update test_stdlib_logger.f90 to report output prefixes as INFO and WARN instead of the original INFORMATION and WARNING. --- src/tests/logger/test_stdlib_logger.f90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/tests/logger/test_stdlib_logger.f90 b/src/tests/logger/test_stdlib_logger.f90 index adddc6c45..99c726e13 100644 --- a/src/tests/logger/test_stdlib_logger.f90 +++ b/src/tests/logger/test_stdlib_logger.f90 @@ -129,7 +129,7 @@ subroutine test_logging_configuration() 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 INFORMARION and be indented on ' // & + 'PROCEDURE, be prefixed by INFO and be indented on ' // & 'subsequent lines by 4 columns.', & module = 'N/A', & procedure = 'TEST_STDLIB_LOGGER' ) @@ -185,7 +185,7 @@ subroutine test_logging_configuration() 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 % ' // & + 'a blank line, then by no time stamp, then by MODULE % ' // & 'PROCEDURE, have no prefix, and be unindented on subsequent ' // & 'lines.', & module = 'N/A', & @@ -194,12 +194,12 @@ subroutine test_logging_configuration() 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 WARNING, and be ' // & - 'indented by 4 columns on subsequent lines.', & - module = 'N/A', & + 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 From 215b4a5ca88b09deca5ee81bba27506f4f0f8dba Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Thu, 17 Sep 2020 14:10:36 -0600 Subject: [PATCH 073/121] Updated INFORMATION and WARNING Found another spot where I should have changed `'INFORMATION: '` and `'WARNING: '` to `'INFO: '` and `'WARN: '` --- doc/specs/stdlib_logger.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 71e67ffc1..a2b92c7f9 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -29,7 +29,7 @@ The logger variables have the option to: 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 `'INFORMATION: '`, `'WARNING: '`, +* 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. From 86ef5769cea31b16e2710eb89cac8eb8bcd1b0eb Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Fri, 18 Sep 2020 08:15:05 +0200 Subject: [PATCH 074/121] Update doc/specs/stdlib_logger.md Co-authored-by: Ian Giestas Pauli --- doc/specs/stdlib_logger.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index a2b92c7f9..58e27a357 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -199,7 +199,7 @@ Experimental 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 result cause `stat`, if present, to not be +those requirements will cause `stat`, if present, to not be `success` and `unit` not to be added to `log_units`, or, if `stat` is not present, cause processing to stop with an informative string as the stop code. From 9aee491556ea3a0efc3c97c0cbceae7ab59b0407 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Fri, 18 Sep 2020 08:16:27 +0200 Subject: [PATCH 075/121] Update doc/specs/stdlib_logger.md Co-authored-by: Ian Giestas Pauli --- doc/specs/stdlib_logger.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 58e27a357..8b4d75448 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -200,7 +200,7 @@ 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` not to be added to `log_units`, or, if `stat` is +`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. From a00220f3e81b322fccb696f5008464f9d976c0a6 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Fri, 18 Sep 2020 08:17:20 +0200 Subject: [PATCH 076/121] Update doc/specs/stdlib_logger.md Co-authored-by: Ian Giestas Pauli --- doc/specs/stdlib_logger.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 8b4d75448..0fa767b86 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -40,7 +40,7 @@ is empty then the messages go to the `output_unit` of the intrinsic module `iso_fortran_env`. -## The `STDLIB_LOGGER` constants +## 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 From d0ba092c61cd962e758adb2715daa4666bea96eb Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sat, 19 Sep 2020 11:49:00 -0400 Subject: [PATCH 077/121] remove redundant string allocation and fix indentation level --- src/stdlib_logger.f90 | 23 +++++++---------------- 1 file changed, 7 insertions(+), 16 deletions(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index f3e41e843..c7131b22c 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -1027,46 +1027,37 @@ subroutine log_message( self, message, module, procedure, prefix ) character(:), allocatable :: d_and_t, m_and_p, pref if ( present(prefix) ) then - allocate( character(len=len(prefix)+2):: pref ) pref = prefix // ': ' else - allocate( character(len=0):: pref ) pref = '' end if if ( self % time_stamp ) then - allocate( character(25) :: d_and_t ) d_and_t = time_stamp() // ': ' else - allocate( character(0) :: d_and_t ) d_and_t = '' end if if ( present(module) ) then if ( present(procedure) ) then - allocate( character( len_trim(module) + & - len_trim(procedure) + 5 ) :: m_and_p ) m_and_p = trim(module) // ' % ' // trim(procedure) // ': ' - else - allocate( character( len_trim(module) + 2 ) :: m_and_p ) + else m_and_p = trim(module) // ': ' - end if + end if - else if ( present(procedure) ) then - allocate( character( len_trim(procedure) + 2 ) :: m_and_p ) - m_and_p = trim(procedure) // ': ' + else if ( present(procedure) ) then + m_and_p = trim(procedure) // ': ' - else - allocate( character( 0 ) :: m_and_p ) - m_and_p = '' + else + m_and_p = '' - end if + end if if ( self % units == 0 ) then call write_log_message( output_unit ) From c8a9e7f34c953cb62724cd2e3df17bdf265db775 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sat, 19 Sep 2020 12:07:48 -0400 Subject: [PATCH 078/121] prettify tables in the specs markdown --- doc/specs/stdlib_logger.md | 66 +++++++++++++++++++------------------- 1 file changed, 33 insertions(+), 33 deletions(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 0fa767b86..df301bfac 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -46,17 +46,17 @@ 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| -| `invalid_index_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| +Error Code | Description +-----------------------|------------ +`success` | no error was detected +`close_failure` | a `close` statement for an I/O unit failed +`invalid_index_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 @@ -75,14 +75,14 @@ type(logger_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 | +| 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 @@ -98,20 +98,20 @@ The module defines twelve public procedures: one function and eleven subroutines. The procedures are: -|Procedure|Class|Description| -|---------|-----|-----------| -|`add_log_file`|Subroutine|opens a file using `newunit`, and adds the resulting unit to the `log_units` list| -|`add_log_unit`| Subroutine|adds an existing unit to the `log_units` list| -|`configure`|Subroutine| configures the details of the logging process| -|`configuration`|Subroutine| reports the details of the logging configuration| -|`log_error`| Subroutine|sends a message prepended by `'ERROR: '` optionally followed by a `stat` or `errmsg`| -|`log_information`|Subroutine| sends a message prepended by `'INFO: '`| -|`log_io_error`|Subroutine|sends a message prepended by `'I/O ERROR: '` optionally followed by an `iostat` or `iomsg`| -|`log_message`|Subroutine| sends a message| -|`log_text_error`|Subroutine| sends a message describing an error found in a line of text| -|`log_units_assigned`|Function| returns the number of active I/O units in `log_units`| -|`log_warning`|Subroutine| sends a message prepended by `'WARN: '`| -|`remove_log_unit`|Subroutine| removes the `unit` number from the `log_units` array| +Procedure | Class | Description +---------------------|------------|------------ +`add_log_file` | Subroutine | Opens a file using `newunit`, and adds the resulting unit to the `log_units` list +`add_log_unit` | Subroutine | Adds an existing unit to the `log_units` list +`configure` | Subroutine | Configures the details of the logging process +`configuration` | Subroutine | Reports the details of the logging configuration +`log_error` | Subroutine | Sends a message prepended by `'ERROR: '` optionally followed by a `stat` or `errmsg` +`log_information` | Subroutine | Sends a message prepended by `'INFO: '` +`log_io_error` | Subroutine | Sends a message prepended by `'I/O ERROR: '` optionally followed by an `iostat` or `iomsg` +`log_message` | Subroutine | Sends a message +`log_text_error` | Subroutine | Sends a message describing an error found in a line of text +`log_units_assigned` | Function | Returns the number of active I/O units in `log_units` +`log_warning` | Subroutine | Sends a message prepended by `'WARN: '` +`remove_log_unit` | Subroutine | Removes the `unit` number from the `log_units` array ## Specification of the `logger_type` methods From be4a8d7da746856e5b832f3e31bee016b56002e5 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sat, 19 Sep 2020 12:39:54 -0400 Subject: [PATCH 079/121] clean up a few docstrings and use lowercase throughout --- src/stdlib_logger.f90 | 170 +++++++++++++++++++++--------------------- 1 file changed, 83 insertions(+), 87 deletions(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index c7131b22c..302da350b 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -1,9 +1,9 @@ module stdlib_logger -!!### Module STDLIB_LOGGER +!!### Module stdlib_logger !! !! This module defines a derived type, procedures, a variable, and -!! constants to be used for reporting errors by the Fortran Standard -!! Library. +!! constants to be used for logging information and reporting errors +!! in Fortran applications. !! !! 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 @@ -25,20 +25,19 @@ module stdlib_logger !! `log_error`, `log_information`, `log_io_error`, `log_message`, !! `log_text_error`, and `log_warning` send messages to the log units. !! -!! The variable is the entity `global_logger` of type `logger_type`, to serve -!! as its name suggests, as a global logger to be used as a default -!! anywhere in the source code. +!! 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. +!! indicates that a `close` statement for an I/O unit failed. !! `invalid_index_error` indicates that `column` was invalid for -!! the given `line`. `open_failure` indicates that an `OPEN` statement +!! 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"`. +!! `"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. @@ -76,11 +75,11 @@ module stdlib_logger private - logical :: add_blank_line = .FALSE. - logical :: indent_lines = .TRUE. + logical :: add_blank_line = .false. + logical :: indent_lines = .true. integer, allocatable :: log_units(:) integer :: max_width = 0 - logical :: time_stamp = .TRUE. + logical :: time_stamp = .true. integer :: units = 0 contains @@ -104,7 +103,7 @@ module stdlib_logger type(logger_type) :: global_logger character(*), parameter :: & - invalid_column = 'COLUMN is not a valid index to LINE.' + invalid_column = 'column is not a valid index to line.' contains @@ -114,13 +113,13 @@ subroutine add_log_file( self, filename, unit, action, position, status, & !! 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 +!! 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. +!! `success` if `filename` could be opened, `read_only_error` if `action` is +!! `"read"`, and `open_failure` otherwise. class(logger_type), intent(inout) :: self !! The logger variable to which the file is to be added @@ -129,16 +128,16 @@ subroutine add_log_file( self, filename, unit, action, position, status, & integer, intent(out), optional :: unit !! The resulting I/O unit number character(*), intent(in), optional :: action -!! The `ACTION` specifier for the `OPEN`` statement +!! The `action` specifier for the `open`` statement character(*), intent(in), optional :: position -!! The `POSITION` specifier for the `OPEN` statement +!! The `position` specifier for the `open` statement character(*), intent(in), optional :: status -!! The `STATUS` specifier for the `OPEN` statement +!! 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 +!! * `Rrea_only_error` - file unopened as `action1 was `"read"` for an output file +!! * `open_failure` - the `open` statement failed !!##### Example @@ -180,7 +179,7 @@ subroutine add_log_file( self, filename, unit, action, position, status, & else error stop 'In ' // module_name // ' % ' // & - procedure_name // ' ACTION is "READ" which ' // & + procedure_name // ' action is "read" which ' // & 'does not allow writes to the file.' end if @@ -240,10 +239,10 @@ 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 L`log_units`, +!! 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. class(logger_type), intent(inout) :: self !! The logger variable to which the I/O unit is to be added @@ -254,7 +253,7 @@ subroutine add_log_unit( self, unit, stat ) !! * `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 +!! * `unformatted_in_error` - `unit` was an `'unformatted'` file !! * `unopened_in_error` - `unit` was not opened !!##### Example @@ -282,7 +281,7 @@ subroutine add_log_unit( self, unit, stat ) !! end program main integer, allocatable :: dummy(:) - character(*), parameter :: procedure_name = 'SET_LOG_UNIT' + character(*), parameter :: procedure_name = 'set_log_unit' integer :: lun character(12) :: specifier logical :: question @@ -321,21 +320,21 @@ subroutine add_log_unit( self, unit, stat ) subroutine validate_unit() -! Check that UNIT is not INPUT_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.' + error stop 'unit in ' // module_name // ' % ' // & + procedure_name // ' must not be input_unit.' end if end if -! Check that UNIT is opened +! Check that unit is opened inquire( unit, opened=question ) if ( .not. question ) then if ( present(stat) ) then @@ -343,8 +342,8 @@ subroutine validate_unit() return else - error stop 'UNIT in ' // module_name // ' % ' // & - procedure_name // ' is not OPEN.' + error stop 'unit in ' // module_name // ' % ' // & + procedure_name // ' is not open.' end if @@ -372,8 +371,8 @@ subroutine validate_unit() return else - error stop 'UNIT in ' // module_name // ' % ' // & - procedure_name // ' is not "SEQUENTIAL".' + error stop 'unit in ' // module_name // ' % ' // & + procedure_name // ' is not "sequential".' end if @@ -386,8 +385,8 @@ subroutine validate_unit() return else - error stop 'UNIT in ' // module_name // ' % ' // & - procedure_name // ' is not "FORMATTED".' + error stop 'unit in ' // module_name // ' % ' // & + procedure_name // ' is not "formatted".' end if @@ -451,9 +450,7 @@ pure subroutine configuration( self, add_blank_line, indent, & !! ... !! end module example_mod - - if ( present(add_blank_line) ) & - add_blank_line = self % add_blank_line + 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 @@ -475,7 +472,7 @@ pure subroutine configure( self, add_blank_line, indent, max_width, & !! 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_wodth == 0` => no bounds on output width. `max_width` has a startup +!! `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 @@ -495,8 +492,7 @@ pure subroutine configure( self, add_blank_line, indent, max_width, & 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(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 @@ -527,10 +523,10 @@ subroutine final_logger( self ) 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 = ', & + '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) + write(error_unit, '(a, i0)') 'With iostat = ', iostat + write(error_unit, '(a)') 'With iomsg = ' // trim(message) end if @@ -699,23 +695,23 @@ subroutine handle_write_failure( unit, procedure_name, iostat, iomsg ) logical :: named character(10) :: action - write( output_unit, '(a)' ) 'WRITE failure in ' // module_name // & + write( output_unit, '(a)' ) 'write failure in ' // module_name // & ' % ' // trim(procedure_name) // '.' - write( output_unit, '(a, i0)' ) 'UNIT = ', unit + 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) + write( output_unit, '(a, a)' ) 'name = ', trim(name) else - write( output_unit, '(a)' ) 'UNIT is UNNAMED' + 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 // '.' + 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 @@ -764,19 +760,19 @@ subroutine log_error( self, message, module, procedure, stat, errmsg ) 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 +!! 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 +!! 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 +!! The value of the `errmsg` specifier returned by a Fortran statement integer :: unit integer :: iostat - character(*), parameter :: procedure_name = 'LOG_ERROR' + character(*), parameter :: procedure_name = 'log_error' character(256) :: iomsg call self % log_message( message, & @@ -800,14 +796,14 @@ subroutine write_log_error( unit ) integer, intent(in) :: unit if ( present(stat) ) then - write( unit, '("With STAT = ", i0)', err=999, & + 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 = "' // & + 'With errmsg = "' // & trim(errmsg) // '"', & procedure_name, & ' ' ) @@ -864,7 +860,7 @@ subroutine log_information( self, message, module, procedure ) 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 +!! 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 @@ -925,7 +921,7 @@ subroutine log_io_error( self, message, module, procedure, iostat, & integer :: unit integer :: iostat2 - character(*), parameter :: procedure_name = 'LOG_ERROR' + character(*), parameter :: procedure_name = 'log_error' character(256) :: iomsg2 call self % log_message( message, & @@ -949,14 +945,14 @@ subroutine write_log_io_error( unit ) integer, intent(in) :: unit if ( present(iostat) ) then - write( unit, '("With IOSTAT = ", i0)', err=999, & + 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 = "' // & + 'With iomsg = "' // & trim(iomsg) // '"', & procedure_name, & ' ' ) @@ -1001,9 +997,9 @@ subroutine log_message( self, message, module, procedure, prefix ) !! write( message, `(a, i0)' ) & !! "The user selected ", selection !! call global_logger % log_message( message, & -!! module = 'EXAMPLE_MOD', & -!! procedure = 'EXAMPLE_SUB', & -!! prefix = 'INFO' ) +!! module = 'example_mod', & +!! procedure = 'example_sub', & +!! prefix = 'info' ) !! end subroutine example_sub !! ... !! end module example_mod @@ -1012,7 +1008,7 @@ subroutine log_message( self, message, module, procedure, prefix ) 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 +!! 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 @@ -1022,7 +1018,7 @@ subroutine log_message( self, message, module, procedure, prefix ) integer :: unit integer :: iostat - character(*), parameter :: procedure_name = 'LOG_MESSAGE' + character(*), parameter :: procedure_name = 'log_message' character(256) :: iomsg character(:), allocatable :: d_and_t, m_and_p, pref @@ -1148,7 +1144,7 @@ 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, `invalid_index` if `column` is less than zero or -!! greater than `len(line)`, and `write_failure` if any of the `WRITE` statements +!! greater than `len(line)`, and `write_failure` if any of the `write` statements !! has failed. character(1) :: acaret @@ -1339,22 +1335,22 @@ end subroutine log_warning 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 +!! 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. 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 +!! 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 +!! * success - no problems found +!! * close_failure - the close statement for unit failed !! !!##### Example !! @@ -1404,9 +1400,9 @@ subroutine remove_log_unit( self, unit, close_unit, stat ) 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 // ' close_unit failed for unit = ', unit + write(*, '(a)' ) 'With iomsg = ' // trim(errmsg) + error stop 'close_unit failed in ' // module_name // ' % ' // & procedure_name // '.' end if From f86231fef3808a9a33dbff3bc5976f52ecb06f05 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sat, 19 Sep 2020 12:54:15 -0400 Subject: [PATCH 080/121] remove blank lines at the ends of if-blocks and do-loops --- src/stdlib_logger.f90 | 100 ++++++------------------------------------ 1 file changed, 13 insertions(+), 87 deletions(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index 302da350b..a72b40445 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -169,21 +169,20 @@ subroutine add_log_file( self, filename, unit, action, position, status, & 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 @@ -197,17 +196,12 @@ subroutine add_log_file( self, filename, unit, action, position, status, & 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 @@ -220,17 +214,14 @@ subroutine add_log_file( self, filename, unit, action, position, status, & 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 @@ -294,23 +285,18 @@ subroutine add_log_unit( self, unit, stat ) 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 @@ -325,13 +311,10 @@ subroutine validate_unit() 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 @@ -340,28 +323,22 @@ subroutine validate_unit() 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 +! 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 // ' % ' // & + error stop 'unit in ' // module_name // ' % ' // & procedure_name // ' is not writeable.' - end if - end if inquire( unit, sequential=specifier ) @@ -369,13 +346,10 @@ subroutine validate_unit() 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 ) @@ -383,13 +357,10 @@ subroutine validate_unit() 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 @@ -497,12 +468,9 @@ pure subroutine configure( self, add_blank_line, indent, max_width, & 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 @@ -527,9 +495,7 @@ subroutine final_logger( self ) 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 @@ -558,15 +524,11 @@ subroutine format_output_string( self, unit, string, procedure_name, & 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 @@ -578,26 +540,24 @@ subroutine format_first_line() 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 @@ -614,25 +574,24 @@ subroutine format_subsequent_line() 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 @@ -649,11 +608,12 @@ subroutine indent_format_subsequent_line() 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 // & @@ -661,14 +621,12 @@ subroutine indent_format_subsequent_line() 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 @@ -699,14 +657,14 @@ subroutine handle_write_failure( unit, procedure_name, iostat, iomsg ) ' % ' // 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 @@ -782,12 +740,10 @@ subroutine log_error( self, message, module, procedure, stat, errmsg ) 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 @@ -808,7 +764,6 @@ subroutine write_log_error( unit ) procedure_name, & ' ' ) end if - end if return @@ -931,12 +886,10 @@ subroutine log_io_error( self, message, module, procedure, iostat, & 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 @@ -957,7 +910,6 @@ subroutine write_log_io_error( unit ) procedure_name, & ' ' ) end if - end if return @@ -1024,46 +976,34 @@ subroutine log_message( self, message, module, procedure, prefix ) 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 @@ -1161,16 +1101,13 @@ subroutine log_text_error( self, line, column, summary, filename, & if ( present(stat) ) then stat = invalid_index_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 @@ -1178,13 +1115,11 @@ subroutine log_text_error( self, line, column, summary, filename, & 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 @@ -1201,13 +1136,11 @@ subroutine write_log_text_error( unit ) 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 @@ -1219,9 +1152,7 @@ subroutine write_log_text_error( unit ) else write( unit, '("Error found in line at column:", i0)' ) & column - end if - end if write( unit, * ) @@ -1376,19 +1307,16 @@ subroutine remove_log_unit( self, unit, close_unit, stat ) 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 @@ -1397,14 +1325,12 @@ subroutine remove_log_unit( self, unit, close_unit, stat ) 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 From de8d91e8b6d8128125141eb0e8a977bb65d0785e Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 19 Sep 2020 21:51:47 +0200 Subject: [PATCH 081/121] Update doc/specs/stdlib_logger.md --- doc/specs/stdlib_logger.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index df301bfac..6a6d365fd 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -1,5 +1,5 @@ --- -title: stdlib_logger +title: logger --- # Loggers From 7a674d39a4f1cd483b8d261cfff8733fb371bf3d Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 19 Sep 2020 21:54:59 +0200 Subject: [PATCH 082/121] Update doc/specs/stdlib_logger.md --- doc/specs/stdlib_logger.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 6a6d365fd..744968136 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -917,7 +917,7 @@ closed. If `unit` is not in `self % log_units` then nothing is done. #### Syntax -`call [[stdlib_logger(module):self % remove_log_unit(interface)]]( unit [, close_unit, stat ] )` +`call self % [[logger_type(type):remove_log_unit(bound)]]( unit [, close_unit, stat ] )` #### Class From af50fbed2aaade973a39b9653b73cd8f23db6a9f Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 19 Sep 2020 21:56:24 +0200 Subject: [PATCH 083/121] Update doc/specs/stdlib_logger.md --- doc/specs/stdlib_logger.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 744968136..7c0b7af5f 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -854,7 +854,7 @@ then `module` and `procedure` if present, then #### Syntax -`call [[stdlib_logger(module):self % log_warning(interface)]]( message [, module, procedure ] )` +`call self % [[logger_type(type):log_warning(bound)]]( message [, module, procedure ] )` #### Class From 761d92a70422bb8758e339b5c8390c8ba426f28a Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 19 Sep 2020 21:56:45 +0200 Subject: [PATCH 084/121] Update doc/specs/stdlib_logger.md --- doc/specs/stdlib_logger.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 7c0b7af5f..1234b5957 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -206,7 +206,7 @@ the stop code. #### Syntax -`call [[stdlib_logger(module):self % add_log_unit(interface)]]( unit [, stat ] )` +`call self % [[logger_type(type):add_log_unit(bound)]]( unit [, stat ] )` #### Class. From dad7d29d65cb3ca966f3aace828ea89ae9b55653 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 19 Sep 2020 21:57:12 +0200 Subject: [PATCH 085/121] Update doc/specs/stdlib_logger.md --- doc/specs/stdlib_logger.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 1234b5957..735b6a48d 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -129,7 +129,7 @@ Opens a formatted, sequential access, output file, `filename` using #### Syntax -`call [[stdlib_logger(module):self % add_log_file(interface)]]( filename [, unit, action, position, status, stat ] )` +`call self % [[logger_type(type):add_log_file(bound)]]( filename [, unit, action, position, status, stat ] )` #### Class From 126b71c6e61b282a405695d5d22ae86f4a6b9e23 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 19 Sep 2020 21:57:38 +0200 Subject: [PATCH 086/121] Update doc/specs/stdlib_logger.md --- doc/specs/stdlib_logger.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 735b6a48d..d8151f63e 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -71,7 +71,7 @@ significant events encountered during the execution of a program. ### Syntax -type(logger_type) :: variable +`type([[stdlib_logger(module):logger_type(type)]]) :: variable` ### Private attributes From 5c64da9aa0af113fd4e4b72a1002e8169ae85506 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 19 Sep 2020 21:58:25 +0200 Subject: [PATCH 087/121] Update doc/specs/stdlib_logger.md --- doc/specs/stdlib_logger.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index d8151f63e..d6eeede0c 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -277,7 +277,7 @@ Reports the configuration of a logger. #### Syntax -`call [[stdlib_logger(module):self % configuration(interface)]]( [ add_blankline, indent, max_width, time_stamp, log_units ] )` +`call self % [[logger_type(type):configuration(bound)]]( [ add_blankline, indent, max_width, time_stamp, log_units ] )` #### Class From 6d4e99ed460398286330832744a1890e16112490 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 19 Sep 2020 22:01:07 +0200 Subject: [PATCH 088/121] Update doc/specs/stdlib_logger.md --- doc/specs/stdlib_logger.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index d6eeede0c..30370d554 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -347,7 +347,7 @@ Configures the logging process for self. #### Syntax -`call [[stdlib_logger(module):self % configure(interface)]]( [ add_blank_line, indent, max_width, time_stamp ] )` +`call self % [[logger_type(type):configure(bound)]]( [ add_blank_line, indent, max_width, time_stamp ] )` #### Class From 5fd7fc44ba9be6f40ed6e9d6e756a5329aba5ed9 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 19 Sep 2020 22:02:13 +0200 Subject: [PATCH 089/121] Update doc/specs/stdlib_logger.md --- doc/specs/stdlib_logger.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 30370d554..13c74595b 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -400,7 +400,7 @@ Writes the string `message` to `self % log_units` with optional additional text. #### Syntax -`call [[stdlib_logger(module):self % log_error(interface)]]( message [, module, procedure, stat, errmsg ] )` +`call self % [[logger_type(type):log_error(bound)]]( message [, module, procedure, stat, errmsg ] )` #### Behavior From 639c39118d2d98b16a755b5d51edf5e97fb8e237 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 19 Sep 2020 22:03:14 +0200 Subject: [PATCH 090/121] Update doc/specs/stdlib_logger.md --- doc/specs/stdlib_logger.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 13c74595b..e2e2f7706 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -381,9 +381,9 @@ Pure subroutine ```fortran program demo_configure - use stdlib_logger, only: global => global_logger + use stdlib_logger, only: global => global_logger - call global % configure( indent=.false., max_width=72 ) + call global % configure( indent=.false., max_width=72 ) end program demo_configure ``` From f7333650aeb9aa9dd766ec0d4f10431c30f85a96 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 19 Sep 2020 22:04:23 +0200 Subject: [PATCH 091/121] Update doc/specs/stdlib_logger.md --- doc/specs/stdlib_logger.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index e2e2f7706..c42826a4b 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -482,7 +482,7 @@ Writes the string `message` to `self % log_units` with optional additional text. #### Syntax -`call [[stdlib_logger(module):self % log_information(interface)]]( message [, module, procedure ] )` +`call self % [[logger_type(type):log_information(bound)]]( message [, module, procedure ] )` #### Behavior From 9b260997bb7affad84bb523bdb0f69d126b3ea24 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 19 Sep 2020 22:05:48 +0200 Subject: [PATCH 092/121] Update doc/specs/stdlib_logger.md --- doc/specs/stdlib_logger.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index c42826a4b..ef8b19292 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -558,7 +558,7 @@ written. #### Syntax -`call [[stdlib_logger(module):self % log_io_error(interface)]]( message [, module, procedure, iostat, iomsg ] )` +`call self % [[logger_type(type):log_io_error(bound)]]( message [, module, procedure, iostat, iomsg ] )` #### Class From 6997c774fcf9495304187d8692ebe92869b21c52 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 19 Sep 2020 22:07:09 +0200 Subject: [PATCH 093/121] Update doc/specs/stdlib_logger.md --- doc/specs/stdlib_logger.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index ef8b19292..8e7387a90 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -793,7 +793,7 @@ Returns the number of active I/O units in `self % log_units` #### Syntax -`Result = [[stdlib_logger(module):self % log_units_assigned(function)]]()` +`result = self % [[logger_type(type):log_units_assigned(bound)]]()` #### Class From eedb80a8254d83a8a02db1a9d09e98235b854102 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 19 Sep 2020 22:09:04 +0200 Subject: [PATCH 094/121] Update doc/specs/stdlib_logger.md --- doc/specs/stdlib_logger.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 8e7387a90..14659da7d 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -633,7 +633,7 @@ followed by `prefix \\ ': '`, if present, and finally `message`. #### Syntax -`call [[stdlib_logger(module):self % log_message(interface)]]( message [, module, procedure, prefix ] )` +`call self % [[logger_type(type):log_message(bound)]]( message [, module, procedure, prefix ] )` #### Class From 70471ae81accd5bec3ef511482d7dc36afc87f7d Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 19 Sep 2020 22:11:10 +0200 Subject: [PATCH 095/121] Update doc/specs/stdlib_logger.md --- doc/specs/stdlib_logger.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 14659da7d..1f85ad437 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -707,7 +707,7 @@ written below `line` at the column indicated by `column`. Then #### Syntax -`call [[stdlib_logger(module):self % log_text_error(interface)]]( line, column, summary [, filename, line_number, caret, stat ] )` +`call self % [[logger_type(bound):log_text_error(bound)]]( line, column, summary [, filename, line_number, caret, stat ] )` #### Class From 01d5e2e2cecbb2f89599d775ec0280240e60de46 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 19 Sep 2020 22:24:23 +0200 Subject: [PATCH 096/121] Update doc/specs/stdlib_logger.md --- doc/specs/stdlib_logger.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 1f85ad437..c868cc7c9 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -707,7 +707,7 @@ written below `line` at the column indicated by `column`. Then #### Syntax -`call self % [[logger_type(bound):log_text_error(bound)]]( line, column, summary [, filename, line_number, caret, stat ] )` +`call self % [[logger_type(type):log_text_error(bound)]]( line, column, summary [, filename, line_number, caret, stat ] )` #### Class From e0bcedc1e90d954e406ce015ac68b611fc322370 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 19 Sep 2020 22:30:22 +0200 Subject: [PATCH 097/121] Update src/stdlib_logger.f90 --- src/stdlib_logger.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index a72b40445..0a1e06e4f 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -831,7 +831,7 @@ end subroutine log_information subroutine log_io_error( self, message, module, procedure, iostat, & iomsg ) -!! Writes the string `message to the `self % log_units` with optional +!! Writes the string `message` to the `self % log_units` with optional !! additional text. !! !!##### Behavior From 07f7cbd3034d22b121ed47a3f54f5002d1e902ae Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 19 Sep 2020 22:32:18 +0200 Subject: [PATCH 098/121] Update src/stdlib_logger.f90 --- src/stdlib_logger.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index 0a1e06e4f..8ba73fb10 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -1031,7 +1031,7 @@ subroutine log_text_error( self, line, column, summary, filename, & line_number, caret, stat ) !! version: experimental -!! `log_text_error` sends a message to `self % log_units` describing an error found +!! Sends a message to `self % log_units` describing an error found !! in a line of text. !! !!##### Behavior From 5d3dd46f3114559e6464ebb027f1b4408af0e5b5 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 19 Sep 2020 23:05:19 +0200 Subject: [PATCH 099/121] Apply suggestions from code review --- src/stdlib_logger.f90 | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index 8ba73fb10..465884902 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -73,6 +73,7 @@ module 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. @@ -120,7 +121,7 @@ subroutine add_log_file( self, filename, unit, action, position, status, & !! 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 @@ -235,6 +236,8 @@ subroutine add_log_unit( self, unit, stat ) !! `"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 @@ -386,7 +389,9 @@ pure subroutine configuration( self, add_blank_line, indent, & !! 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 +!! 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 @@ -448,7 +453,7 @@ pure subroutine configure( self, add_blank_line, indent, max_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. `time_stamp` has a startup value of `.true.`. - +!!([Specification])(../page/specs/stdlib_logger.html#configure-configure-the-logging-process)) !!##### Example !! !! program main From 7998a9c4035c696aa408d5b417d50bf105fc4771 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 19 Sep 2020 23:12:20 +0200 Subject: [PATCH 100/121] Apply suggestions from code review --- src/stdlib_logger.f90 | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index 465884902..e0e0bbf1f 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -485,7 +485,7 @@ end subroutine configure subroutine final_logger( self ) !! version: experimental -!! finalizes the `logger_type` entity `self` by flushing the units +!! Finalizes the `logger_type` entity `self` by flushing the units type(logger_type), intent(in) :: self integer :: iostat @@ -682,7 +682,8 @@ end subroutine handle_write_failure subroutine log_error( self, message, module, procedure, stat, errmsg ) !! 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 @@ -783,6 +784,7 @@ end subroutine log_error subroutine log_information( self, message, module, procedure ) !! 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 !! @@ -930,6 +932,7 @@ subroutine log_message( self, message, module, procedure, prefix ) !! 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 !! @@ -1038,7 +1041,8 @@ subroutine log_text_error( self, line, column, summary, filename, & !! 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 @@ -1188,6 +1192,8 @@ end subroutine log_text_error elemental function log_units_assigned(self) !! 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 @@ -1220,7 +1226,8 @@ end function log_units_assigned subroutine log_warning( self, message, module, procedure ) !! 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 @@ -1277,6 +1284,8 @@ subroutine remove_log_unit( self, unit, close_unit, stat ) !! 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 From abc83c7e1933d73f50f9839a720ef78d9844242c Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 19 Sep 2020 23:18:23 +0200 Subject: [PATCH 101/121] Apply suggestions from code review --- src/stdlib_logger.f90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index e0e0bbf1f..98850f179 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -453,7 +453,7 @@ pure subroutine configure( self, add_blank_line, indent, max_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. `time_stamp` has a startup value of `.true.`. -!!([Specification])(../page/specs/stdlib_logger.html#configure-configure-the-logging-process)) +!!([Specification](../page/specs/stdlib_logger.html#configure-configure-the-logging-process)) !!##### Example !! !! program main @@ -932,7 +932,7 @@ subroutine log_message( self, message, module, procedure, prefix ) !! 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)) +!!([Specification](../page/specs/stdlib_logger.html#log_message-write-the-string-message-to-self-log_units)) !! !!##### Behavior !! @@ -1041,7 +1041,7 @@ subroutine log_text_error( self, line, column, summary, filename, & !! 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)) +!!([Specification](../page/specs/stdlib_logger.html#log_text_error-send-a-message-to-self-log_units-describing-an-error)) !!##### Behavior !! @@ -1226,7 +1226,7 @@ end function log_units_assigned subroutine log_warning( self, message, module, procedure ) !! 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) +!!([Specification](../page/specs/stdlib_logger.html#log_warning-write-the-string-message-to-log_units)) !!##### Behavior !! @@ -1284,7 +1284,7 @@ subroutine remove_log_unit( self, unit, close_unit, stat ) !! 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)) +!!([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 From e6c8f816cc56fc145686c34eb7e2dc405709b9a7 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 19 Sep 2020 23:26:49 +0200 Subject: [PATCH 102/121] Apply suggestions from code review --- src/stdlib_logger.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index 98850f179..bb0adeb81 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -4,7 +4,8 @@ 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. From 466ace58103315ddcd7b0a1c5f91cf2ceb80bd13 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 19 Sep 2020 23:36:34 +0200 Subject: [PATCH 103/121] Apply suggestions from code review --- src/stdlib_logger.f90 | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index bb0adeb81..d18fee746 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -681,6 +681,8 @@ 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)) @@ -783,6 +785,8 @@ 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)) @@ -839,8 +843,11 @@ 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 !! @@ -1192,6 +1199,8 @@ 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)) @@ -1226,6 +1235,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. !!([Specification](../page/specs/stdlib_logger.html#log_warning-write-the-string-message-to-log_units)) @@ -1279,6 +1290,8 @@ 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, From 6eb9fea568d9b5d93ac505743beca7a1b27fbee5 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sun, 20 Sep 2020 11:42:03 -0400 Subject: [PATCH 104/121] Update doc/specs/stdlib_logger.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_logger.md | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index c868cc7c9..570a4cce6 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -100,18 +100,18 @@ procedures are: Procedure | Class | Description ---------------------|------------|------------ -`add_log_file` | Subroutine | Opens a file using `newunit`, and adds the resulting unit to the `log_units` list -`add_log_unit` | Subroutine | Adds an existing unit to the `log_units` list -`configure` | Subroutine | Configures the details of the logging process -`configuration` | Subroutine | Reports the details of the logging configuration -`log_error` | Subroutine | Sends a message prepended by `'ERROR: '` optionally followed by a `stat` or `errmsg` -`log_information` | Subroutine | Sends a message prepended by `'INFO: '` -`log_io_error` | Subroutine | Sends a message prepended by `'I/O ERROR: '` optionally followed by an `iostat` or `iomsg` -`log_message` | Subroutine | Sends a message -`log_text_error` | Subroutine | Sends a message describing an error found in a line of text -`log_units_assigned` | Function | Returns the number of active I/O units in `log_units` -`log_warning` | Subroutine | Sends a message prepended by `'WARN: '` -`remove_log_unit` | Subroutine | Removes the `unit` number from the `log_units` array +[`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 From 088861c9c8810c8a21fe26f508e4107653e9fdab Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sun, 20 Sep 2020 11:42:40 -0400 Subject: [PATCH 105/121] Update src/stdlib_logger.f90 Co-authored-by: Jeremie Vandenplas --- src/stdlib_logger.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index d18fee746..1bfb7979d 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -70,7 +70,6 @@ module stdlib_logger character(*), parameter :: module_name = 'stdlib_logger' - !! Public derived type type :: logger_type !! version: experimental From 43122303da65bd6f6bd48d1001013e268716b58a Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sun, 20 Sep 2020 11:44:07 -0400 Subject: [PATCH 106/121] Update doc/specs/stdlib_logger.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_logger.md | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 570a4cce6..5520c7699 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -879,28 +879,28 @@ Subroutine #### Example ```fortran - module example_mod - use stdlib_logger - ... - real, allocatable :: a(:) - type(logger_type) :: logger - ... +module example_mod + use stdlib_logger + + real, allocatable :: a(:) + type(logger_type) :: logger + contains - ... - subroutine example_sub( size, stat ) + + subroutine example_sub( size, stat ) integer, intent(in) :: size integer, intent(out) :: stat allocate( a(size) ) if ( stat /= 0 ) then - write( message, '(a, i0)' ) & + write( message, '(a, i0)' ) & "Allocation of A failed with SIZE = ", size - call logger % log_warning( message, & + call logger % log_warning( message, & module = 'EXAMPLE_MOD', & procedure = 'EXAMPLE_SUB' ) - end if - end subroutine example_sub - ... - end module example_mod + end if + end subroutine example_sub + +end module example_mod ``` ### `remove_log_unit` - remove `unit` from `self % log_units` From 87006f63d24fec0faad595b4dc4449df22c88906 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sun, 20 Sep 2020 11:44:45 -0400 Subject: [PATCH 107/121] Update doc/specs/stdlib_logger.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_logger.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 5520c7699..a9bc5f72d 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -96,7 +96,7 @@ application. The module defines twelve public procedures: one function and eleven subroutines. The -procedures are: +methods are: Procedure | Class | Description ---------------------|------------|------------ From 4995d0053e1e762ec26b24e4a6b62fe762cf7197 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sun, 20 Sep 2020 11:48:04 -0400 Subject: [PATCH 108/121] Update doc/specs/stdlib_logger.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_logger.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index a9bc5f72d..73e5c1dcd 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -176,15 +176,15 @@ an `intent(in)` argument. It shall be the name of the file to be opened. ```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 ``` From 75291b57da92d9ab719bfaae4e0271d8a745ae5b Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sun, 20 Sep 2020 11:51:59 -0400 Subject: [PATCH 109/121] Update doc/specs/stdlib_logger.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_logger.md | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 73e5c1dcd..317fd1982 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -243,25 +243,25 @@ to `unit`. ```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 ``` From e0da69166987058a8589461c9c2ec31741324fc6 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sun, 20 Sep 2020 12:00:59 -0400 Subject: [PATCH 110/121] Update doc/specs/stdlib_logger.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_logger.md | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 317fd1982..343713484 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -314,25 +314,25 @@ Pure subroutine #### Example ```fortran - module example_mod - use stdlib_logger - ... - type(logger_type) :: logger +module example_mod + use stdlib_logger + + type(logger_type) :: logger contains - ... - subroutine example_sub(unit, ...) + + 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 + + end subroutine example_sub + +end module example_mod ``` ### `configure` - configure the logging process From 99dd85ee1738c83065a1293ee6e6d6e1e9793dfb Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sun, 20 Sep 2020 12:26:58 -0400 Subject: [PATCH 111/121] mark methods explictly as public --- src/stdlib_logger.f90 | 30 +++++++++++++++++------------- 1 file changed, 17 insertions(+), 13 deletions(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index 1bfb7979d..d53939bba 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -85,19 +85,23 @@ module stdlib_logger contains - procedure, pass(self) :: add_log_file - procedure, pass(self) :: add_log_unit - procedure, pass(self) :: configuration - procedure, pass(self) :: configure - final :: final_logger - procedure, pass(self) :: log_error - procedure, pass(self) :: log_information - procedure, pass(self) :: log_io_error - procedure, pass(self) :: log_message - procedure, pass(self) :: log_text_error - procedure, pass(self) :: log_units_assigned - procedure, pass(self) :: log_warning - procedure, pass(self) :: remove_log_unit + 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 From 3874e87caf13a5cb5e2a9c49cba0b3054c3b60c1 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sun, 20 Sep 2020 12:28:04 -0400 Subject: [PATCH 112/121] apply suggestion by @jvdp1 --- doc/specs/stdlib_logger.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 343713484..330a9e512 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -98,7 +98,7 @@ The module defines twelve public procedures: one function and eleven subroutines. The methods are: -Procedure | Class | Description +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 From 30573caf31b24fa9a406c25e598707ea4525d712 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sun, 20 Sep 2020 12:32:07 -0400 Subject: [PATCH 113/121] Update doc/specs/stdlib_logger.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_logger.md | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 330a9e512..be2e7c8d6 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -442,32 +442,32 @@ Subroutine #### Example ```fortran - module example_mod - use stdlib_logger - ... - real, allocatable :: a(:) - ... - type(logger_type) :: logger - ... +module example_mod + use stdlib_logger + + real, allocatable :: a(:) + + type(logger_type) :: logger + contains - ... - subroutine example_sub( size ) + + 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, & + 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 + end if + end subroutine example_sub + +end module example_mod ``` ### `log_information` - Writes the string `message` to `self % log_units` From f870c70b5cccea76b0a3ba03955ce1185078fb38 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sun, 20 Sep 2020 12:33:05 -0400 Subject: [PATCH 114/121] Update doc/specs/stdlib_logger.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_logger.md | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index be2e7c8d6..6e179fb2b 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -815,24 +815,24 @@ The result is the number of I/O units in #### Example ```fortran - module example_mod - use stdlib_logger - ... - type(logger_type) :: logger +module example_mod + use stdlib_logger + + type(logger_type) :: logger contains - ... - subroutine example_sub(unit, ...) + + 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 + + end subroutine example_sub + +end module example_mod ``` ### `log_warning` - write the string `message` to `log_units` From a669617f53c3868f9723c74ad9c2336893ef0392 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sun, 20 Sep 2020 12:35:18 -0400 Subject: [PATCH 115/121] Update doc/specs/stdlib_logger.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_logger.md | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 6e179fb2b..503ebe572 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -513,15 +513,15 @@ Subroutine #### Example ```fortran - module example_mod - use stdlib_logger - ... - real, allocatable :: a(:) - ... - type(logger_type) :: logger +module example_mod + use stdlib_logger + + real, allocatable :: a(:) + + type(logger_type) :: logger contains - ... - subroutine example_sub( selection ) + + subroutine example_sub( selection ) integer, intent(out) :: selection character(128) :: errmsg, message integer :: stat @@ -531,10 +531,10 @@ Subroutine "The user selected ", selection call logger % log_information( message, & module = 'EXAMPLE_MOD', procedure = 'EXAMPLE_SUB' ) - ... - end subroutine example_sub - ... - end module example_mod + + end subroutine example_sub + +end module example_mod ``` ### `log_io_error` - Write the string `message` to `self % log_units` From 7fa7312799dd581634a6527bfd5ebc5e53003f22 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sun, 20 Sep 2020 12:36:21 -0400 Subject: [PATCH 116/121] Update doc/specs/stdlib_logger.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_logger.md | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 503ebe572..9470f417d 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -949,17 +949,17 @@ modified. #### Example ```fortran - module example_mod - use stdlib_logger, global => global_logger - ... +module example_mod + use stdlib_logger, global => global_logger + contains - ... - subroutine example_sub(unit, ...) + + subroutine example_sub(unit, ...) integer, intent(in) :: unit - ... + call global % remove_log_unit( unit ) - ... - end subroutine example_sub - ... - end module example_mod + + end subroutine example_sub + +end module example_mod ``` From cf3221f246f78fc77663e8a317224f207365a26d Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sun, 20 Sep 2020 12:39:12 -0400 Subject: [PATCH 117/121] Update doc/specs/stdlib_logger.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_logger.md | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 9470f417d..9f1829de7 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -592,26 +592,26 @@ Subroutine #### Example ```fortran - program example - use stdlib_logger, global=>global_logger - ... - character(*), parameter :: filename = 'dummy.txt' - integer :: iostat, lun - character(128) :: iomsg - character(*), parameter :: message = & +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', & + open( newunit=lun, file = filename, form='formatted', & status='old', iostat=iostat, iomsg=iomsg ) - if ( iostat /= 0 ) then + 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 example + 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` From f7ab13fa6e04dff2e97514cba47d40ebf99dd148 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sun, 20 Sep 2020 12:41:43 -0400 Subject: [PATCH 118/121] Update doc/specs/stdlib_logger.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_logger.md | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index 9f1829de7..f2285a6cd 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -662,15 +662,15 @@ It is an `intent(in)` argument. It will precede `message` with an #### Example ```fortran - module example_mod - use stdlib_logger - ... - real, allocatable :: a(:) - ... - type(logger_type) :: logger +module example_mod + use stdlib_logger + + real, allocatable :: a(:) + + type(logger_type) :: logger contains - ... - subroutine example_sub( selection ) + + subroutine example_sub( selection ) integer, intent(out) :: selection integer :: stat write(*,'(a)') "Enter an integer to select a widget" @@ -681,9 +681,9 @@ It is an `intent(in)` argument. It will precede `message` with an module = 'EXAMPLE_MOD', & procedure = 'EXAMPLE_SUB', & prefix = `INFO' ) - end subroutine example_sub - ... - end module example_mod + end subroutine example_sub + +end module example_mod ``` ### `log_text_error` - send a message to `self % log_units` describing an error From 1ed887210c101d5c0ff80ce13e7671f8de657257 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Sun, 20 Sep 2020 12:42:46 -0400 Subject: [PATCH 119/121] Update doc/specs/stdlib_logger.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_logger.md | 43 +++++++++++++++++++------------------- 1 file changed, 21 insertions(+), 22 deletions(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index f2285a6cd..ec15122b9 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -754,31 +754,30 @@ Subroutine #### Example ```fortran - program example - 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', & +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, & + 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 + error stop 'Error in reading ' // filename + end if + end do 900 continue - ... - end program example + +end program demo_log_text_error ``` ### `log_units_assigned` - returns the number of active I/O units From a33085daad347f60c6be9ab56bd7c702992b3a61 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Sun, 27 Sep 2020 15:39:31 -0600 Subject: [PATCH 120/121] Changed invalid_index_error to index_invalid_error Made the error code name consistent with that used for my bitsets and error_codes modules, where for ease of lookup I put what is invalid before the invalid. --- src/stdlib_logger.f90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/stdlib_logger.f90 b/src/stdlib_logger.f90 index d53939bba..4ffd85c13 100644 --- a/src/stdlib_logger.f90 +++ b/src/stdlib_logger.f90 @@ -33,7 +33,7 @@ module stdlib_logger !! 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. -!! `invalid_index_error` indicates that `column` was invalid for +!! `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 @@ -60,7 +60,7 @@ module stdlib_logger integer, parameter, public :: & success = 0, & close_failure = 1, & - invalid_index_error = 2, & + index_invalid_error = 2, & non_sequential_error = 3, & open_failure = 4, & read_only_error = 5, & @@ -1103,7 +1103,7 @@ subroutine log_text_error( self, line, column, summary, filename, & !! 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, `invalid_index` if `column` is less than zero or +!! 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. @@ -1119,7 +1119,7 @@ subroutine log_text_error( self, line, column, summary, filename, & if ( column < 0 .or. column > len( line ) + 1 ) then if ( present(stat) ) then - stat = invalid_index_error + stat = index_invalid_error return else call self % log_error( invalid_column, & From fae31b90fe3da0406bec19434a61cd007b31bb70 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" <65470906+wclodius2@users.noreply.github.com> Date: Sun, 27 Sep 2020 18:36:48 -0600 Subject: [PATCH 121/121] Changed invalid_index_error to index_invalid_error --- doc/specs/stdlib_logger.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_logger.md b/doc/specs/stdlib_logger.md index ec15122b9..83ed7f2cf 100644 --- a/doc/specs/stdlib_logger.md +++ b/doc/specs/stdlib_logger.md @@ -50,7 +50,7 @@ Error Code | Description -----------------------|------------ `success` | no error was detected `close_failure` | a `close` statement for an I/O unit failed -`invalid_index_error` | the `column` was invalid for the given `line` +`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'`