Reporting errors#

TOML data structures can record their origin in the original TOML document, which can be used to report errors with rich context information. The recipes here describe how to obtain the context for producing error messages and diagnostics using the origin information of the data structures.

Loading with rich context#

To make use of the origin information, the context from loading the document has to be preserved. This can be archived by passing the optional context argument to the loading interface to request the document context to be exported. To obtain the context object we have to request it when reading the TOML document.

app/main.f90#
call toml_load(table, filename, context=context, error=error)

We define a simple data type for a configuration for this recipe.

src/config.f90#
  !> Configuration data
  type :: config_type
    !> Time step for simulation
    real :: timestep
  end type config_type

To report errors, we now not only use the TOML data structure, but also a context object, which allows us to create the report.

src/config.f90#
  !> Load configuration data from TOML data structure
  subroutine load_config(config, table, context)
    !> Instance of the configuration data
    type(config_type), intent(out) :: config
    !> TOML data structure
    type(toml_table), intent(inout) :: table
    !> Context for reporting errors
    type(toml_context), intent(in) :: context

    integer :: stat, origin

    call get_value(table, "timestep", config%timestep, 0.5, stat=stat, origin=origin)
    if (stat /= 0) then
      print '(a)', context%report("Cannot read timestep", &
        & origin, "expected real value")
      stop 1
    end if

  end subroutine load_config

To provide the data structure we create a simple driver to read a TOML document.

app/main.f90#
program demo
  use tomlf, only : toml_table, toml_error, toml_context, toml_load
  use demo_config, only : config_type, load_config
  implicit none

  type(config_type) :: config
  character(128) :: arg

  call get_command_argument(1, arg)

  block
    type(toml_table), allocatable :: table
    type(toml_error), allocatable :: error
    type(toml_context) :: context

    call toml_load(table, trim(arg), context=context, error=error)
    if (allocated(error)) then
      print '(a)', error%message
      stop 1
    end if

    call load_config(config, table, context)
  end block
end program demo

Now we can try with an incorrect configuration file, where we pass a string instead of a float to our option.

config.toml#
timestep = "large"

The error message is produced and shows the exact origin of the value in the document.

error: Cannot read timestep
 --> config.toml:1:12-18
  |
1 | timestep = "large"
  |            ^^^^^^^ expected real value
  |

Now we also have to handle the case where the value can be read correctly, but is incorrect for our application, like a negative timestep.

src/config.f90#
    if (config%timestep <= 0) then
      print '(a)', context%report("Timestep must be positive", &
        & origin, "expected positive value")
      stop 1
    end if

The origin information will still be available and allow us to make a rich report about the error in the input.

config.toml#
timestep = -0.1

The resulting error message is shown below.

error: Timestep must be positive
 --> fpm.toml:1:12-15
  |
1 | timestep = -0.1
  |            ^^^^ expected positive real value
  |

Note

Each TOML data structure has an origin attribute, which can be used together with the report function of the context. In case the origin cannot be mapped to a single token, e.g. for the root table, the value of the origin will be zero. The report function will only produce labels for non-zero origins and gracefully ignore data without origin in the current context.

The reporting function is not limited to errors, it can also produce warnings or informational messages. For this purpose, we select the appropriate toml_level for the report.

src/config.f90#
    if (config%timestep > large_timestep) then
      print '(a)', context%report("Large timesteps can lead to instable simulations", &
        & origin, level=toml_level%warning)
    end if

Tip

The toml_level parameter provides a statically initialized derived type enumerating all available report levels. You can think of it as an enumerator with a proper namespace.

We can test this for the following example.

config.toml#
timestep = 100.0

The resulting warning is shown below.

warning: Large timesteps can lead to instable simulations
 --> config.toml:1:12-16
  |
1 | timestep = 100.0
  |            ^^^^^
  |
full source

The full demo_config module is given here.

src/dependency.f90#
!> Module for reading in configuration data
module demo_config
  use tomlf, only : toml_table, toml_context, toml_level, get_value
  implicit none

  !> Configuration data
  type :: config_type
    !> Time step for simulation
    real :: timestep
  end type config_type

  !> Threshold for warning on large time step
  real, parameter :: large_timestep = 10.0

contains

  !> Load configuration data from TOML data structure
  subroutine load_config(config, table, context)
    !> Instance of the configuration data
    type(config_type), intent(out) :: config
    !> TOML data structure
    type(toml_table), intent(inout) :: table
    !> Context for reporting errors
    type(toml_context), intent(in) :: context

    integer :: stat, origin

    call get_value(table, "timestep", config%timestep, 0.5, stat=stat, origin=origin)
    if (stat /= 0) then
      print '(a)', context%report("Cannot read timestep", &
        & origin, "expected real value")
      stop 1
    end if

    if (config%timestep <= 0) then
      print '(a)', context%report("Timestep must be positive", &
        & origin, "expected positive value")
      stop 1
    end if

    if (config%timestep > large_timestep) then
      print '(a)', context%report("Large timesteps can lead to instable simulations", &
        & origin, level=toml_level%warning)
    end if

  end subroutine load_config

end module demo_config

The driver for running the examples is given below.

app/main.f90#
program demo
  use tomlf, only : toml_table, toml_error, toml_context, toml_load
  use demo_config, only : config_type, load_config
  implicit none

  type(config_type) :: config
  character(128) :: arg

  call get_command_argument(1, arg)

  block
    type(toml_table), allocatable :: table
    type(toml_error), allocatable :: error
    type(toml_context) :: context

    call toml_load(table, trim(arg), context=context, error=error)
    if (allocated(error)) then
      print '(a)', error%message
      stop 1
    end if

    call load_config(config, table, context)
  end block
end program demo

Multiline reports#

In some cases, multiple labels are required to express the context of the report correctly. This feature is available with the context object, by providing the origin of the two data structures in the reporting function.

An example of this is the dependency table in fpm, where we can either provide a local dependency using the path key or a remote dependency using the git key, but not both at the same time.

We declare a simple dummy dependency storing only the dependency name for demonstration purposes.

src/dependency.f90#
  !> Dummy dependency type storing only the name of the dependency
  type :: dependency_type
    !> The name of the dependency
    character(:), allocatable :: name
  end type dependency_type

We iterate over the list of all subtables in the dependency table and read the actual dependency. In case an entry is not a subtable we will raise an error, since a package manifest can contain multiple dependency tables, we will report which table we are currently in as additional context.

src/dependency.f90#
  !> Load a list of dependencies from a table
  subroutine load_dependencies(dependencies, table, context)
    !> List of dependencies
    type(dependency_type), allocatable, intent(out) :: dependencies(:)
    !> TOML data structure
    type(toml_table), intent(inout) :: table
    !> Context for error messages
    type(toml_context), intent(in) :: context

    integer :: it, origin
    type(toml_key), allocatable :: list(:)
    type(toml_table), pointer :: child

    call table%get_keys(list)
    allocate(dependencies(size(list)))

    do it = 1, size(list)
      call get_value(table, list(it), child, origin=origin)
      if (.not.associated(child)) then
        print '(a)', context%report("All entries must be subtables", &
          & origin, table%origin, "must be a subtable", "required for this table")
        stop 1
      end if
      call load_dependency(dependencies(it), list(it), child, context)
    end do
  end subroutine load_dependencies

To provide the dependencies table we create a simple driver to read a TOML document.

app/main.f90#
program demo
  use tomlf, only : toml_table, toml_error, toml_context, toml_load, get_value
  use demo_dependency, only : dependency_type, load_dependencies
  implicit none

  type(dependency_type), allocatable :: deps(:)
  character(128) :: arg

  call get_command_argument(1, arg)

  block
    type(toml_table), allocatable :: table
    type(toml_error), allocatable :: error
    type(toml_context) :: context

    type(toml_table), pointer :: child

    call toml_load(table, trim(arg), context=context, error=error)
    if (allocated(error)) then
      print '(a)', error%message
      stop 1
    end if

    call get_value(table, "dependencies", child)
    if (associated(child)) then
      call load_dependencies(deps, child, context)
    end if
  end block
end program demo

An example triggering the error is shown below.

fpm.toml#
[dependencies]
json-fortran.git = "https://github.com/jacobwilliams/json-fortran.git"
toml-f = "^0.3.0"

Running this example will produce the following error showing lines 1 and 3 of our example input.

error: All entries must be subtables
 --> fpm.toml:3:1-6
  |
1 | [dependencies]
  |  ------------ required for this table
  :
3 | toml-f = "^0.3.0"
  | ^^^^^^ must be a subtable
  |

Now we want to implement the actual conflicting case described above. Here we just read the two strings from the git and path entry. Note that the get_value interface will not allocate the string if no value is present, which allows to conveniently check for success via allocation status of the strings.

src/dependency.f90#
  !> Load a single dependency from a table
  subroutine load_dependency(dependency, name, table, context)
    !> Information about the dependency
    type(dependency_type), intent(out) :: dependency
    !> Name of the dependency
    type(toml_key), intent(in) :: name
    !> TOML data structure
    type(toml_table), intent(inout) :: table
    !> Context for error messages
    type(toml_context), intent(in) :: context

    integer :: git_origin, path_origin
    character(:), allocatable :: git, path
    type(toml_key), allocatable :: list(:)

    dependency%name = name%key

    call table%get_keys(list)

    call get_value(table, "git", git, origin=git_origin)
    call get_value(table, "path", path, origin=path_origin)

    if (allocated(git) .and. allocated(path)) then
      if (git_origin < path_origin) then
        print '(a)', context%report("Remote dependency cannot have local path", &
          & path_origin, git_origin, &
          & "cannot have local path", "remote dependency already defined")
      else
        print '(a)', context%report("Local dependency cannot have remote repository", &
          & git_origin, path_origin, &
          & "cannot have remote repository", "local dependency already defined")
      end if
      stop 1
    end if
  end subroutine load_dependency

To preserve the order from the input we can compare the origin values of the two retrieved strings and produce the appropriate error message.

In this example, the git entry was defined first and a conflicting path entry is provided afterward.

fpm.toml#
[dependencies]
toml-f.git = "https://github.com/toml-f/toml-f.git"
toml-f.path = "./subprojects/toml-f"

The order is reported correctly in the produced error message shown below.

error: Remote dependency cannot have local path
 --> fpm.toml:3:15-36
  |
2 | toml-f.git = "https://github.com/toml-f/toml-f.git"
  |              -------------------------------------- remote dependency already defined
3 | toml-f.path = "./subprojects/toml-f"
  |               ^^^^^^^^^^^^^^^^^^^^^^ cannot have local path
  |

The other way round is also possible as shown in this example.

fpm.toml#
[dependencies]
toml-f.path = "./subprojects/toml-f"
toml-f.git = "https://github.com/toml-f/toml-f.git"

The error message is adjusted accordingly and now reports a conflicting git entry to the already defined path entry.

error: Local dependency cannot have remote repository
 --> fpm.toml:3:14-51
  |
2 | toml-f.path = "./subprojects/toml-f"
  |               ---------------------- local dependency already defined
3 | toml-f.git = "https://github.com/toml-f/toml-f.git"
  |              ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ cannot have remote repository
  |
full source

The full demo_dependency module is given provided below.

src/dependency.f90#
!> Demo module for fpm-like dependency reading
module demo_dependency
  use tomlf, only : toml_table, toml_context, toml_key, get_value
  implicit none

  !> Dummy dependency type storing only the name of the dependency
  type :: dependency_type
    !> The name of the dependency
    character(:), allocatable :: name
  end type dependency_type

contains

  !> Load a list of dependencies from a table
  subroutine load_dependencies(dependencies, table, context)
    !> List of dependencies
    type(dependency_type), allocatable, intent(out) :: dependencies(:)
    !> TOML data structure
    type(toml_table), intent(inout) :: table
    !> Context for error messages
    type(toml_context), intent(in) :: context

    integer :: it, origin
    type(toml_key), allocatable :: list(:)
    type(toml_table), pointer :: child

    call table%get_keys(list)
    allocate(dependencies(size(list)))

    do it = 1, size(list)
      call get_value(table, list(it), child, origin=origin)
      if (.not.associated(child)) then
        print '(a)', context%report("All entries must be subtables", &
          & origin, table%origin, "must be a subtable", "required for this table")
        stop 1
      end if
      call load_dependency(dependencies(it), list(it), child, context)
    end do
  end subroutine load_dependencies

  !> Load a single dependency from a table
  subroutine load_dependency(dependency, name, table, context)
    !> Information about the dependency
    type(dependency_type), intent(out) :: dependency
    !> Name of the dependency
    type(toml_key), intent(in) :: name
    !> TOML data structure
    type(toml_table), intent(inout) :: table
    !> Context for error messages
    type(toml_context), intent(in) :: context

    integer :: git_origin, path_origin
    character(:), allocatable :: git, path
    type(toml_key), allocatable :: list(:)

    dependency%name = name%key

    call table%get_keys(list)

    call get_value(table, "git", git, origin=git_origin)
    call get_value(table, "path", path, origin=path_origin)

    if (allocated(git) .and. allocated(path)) then
      if (git_origin < path_origin) then
        print '(a)', context%report("Remote dependency cannot have local path", &
          & path_origin, git_origin, &
          & "cannot have local path", "remote dependency already defined")
      else
        print '(a)', context%report("Local dependency cannot have remote repository", &
          & git_origin, path_origin, &
          & "cannot have remote repository", "local dependency already defined")
      end if
      stop 1
    end if
  end subroutine load_dependency

end module demo_dependency

The driver for the examples is given here.

app/main.f90#
program demo
  use tomlf, only : toml_table, toml_error, toml_context, toml_load, get_value
  use demo_dependency, only : dependency_type, load_dependencies
  implicit none

  type(dependency_type), allocatable :: deps(:)
  character(128) :: arg

  call get_command_argument(1, arg)

  block
    type(toml_table), allocatable :: table
    type(toml_error), allocatable :: error
    type(toml_context) :: context

    type(toml_table), pointer :: child

    call toml_load(table, trim(arg), context=context, error=error)
    if (allocated(error)) then
      print '(a)', error%message
      stop 1
    end if

    call get_value(table, "dependencies", child)
    if (associated(child)) then
      call load_dependencies(deps, child, context)
    end if
  end block
end program demo

Color support#

All reports also support colorful terminal output. For this purpose, we can use the provided toml_terminal which can be instantiated with color support.

block
  use tomlf, only : toml_terminal
  type(toml_terminal) :: terminal
  terminal = toml_terminal(.true.)
end block

To activate the color support for error messages produced in the load interface the optional argument config takes a toml_parser_config instance.

call toml_load(table, filename, config=toml_parser_config(color=.true.), error=error)

Alternatively, an instance of a toml_terminal can be passed to the toml_parser_config constructor.

For working with the context instance returned by the load interface we need a terminal to activate the colorful output passed to the optional color argument.

print '(a)', context%report("Cannot read timestep", &
  & origin, "expected real value", color=toml_terminal(.true.))

The terminal can also be used to colorize regular text output.

block
  use tomlf_terminal, only : toml_terminal, operator(//), operator(+)
  type(toml_terminal) :: terminal
  terminal = toml_terminal(.true.)
  print '(a)', (terminal%fg_red + terminal%bold) // "red bold text" // terminal%reset
end block

If the terminal is not initialized or the color support is explicitly disabled by passing .false. to the constructor, the output will be plain text.