module f_unittests
  implicit none
  private

  interface compare
     module procedure compare_l, compare_i, compare_f, compare_d, compare_s
     module procedure compare_dict, compare_dict_d
     module procedure compare_ai, compare_af, compare_ad
     module procedure compare_ai2, compare_ad2
  end interface compare

  interface run
     module procedure run_serial, run_parallel
  end interface run

  public :: run, compare, verify, skip, expectFailure

  integer :: ERR_SKIPPED_ID = 0
  integer :: ERR_EXPECTED_ID = 0

contains
  function isError(errors, id, reason)
    use dictionaries
    implicit none
    type(dictionary), pointer :: errors
    integer, intent(in) :: id
    character(len = *), intent(out) :: reason
    logical :: isError

    type(dictionary), pointer :: iter
    integer :: ierr

    isError = .false.
    iter => dict_iter(errors)
    do while (associated(iter))
       ierr = iter // "Id"
       isError = ierr == id
       if (isError) then
          reason = iter // "Additional Info"
          call dict_remove(errors, dict_key(iter))
          return
       end if
       iter => dict_next(iter)
    end do
  end function isError
  
  subroutine output(test, errors)
    use yaml_output
    use yaml_strings
    use dictionaries
    implicit none
    character(len = *), intent(in) :: test
    type(dictionary), pointer :: errors

    character(len = max_field_length) :: reason

    call yaml_sequence(advance = "no")
    if (associated(errors)) then
       call yaml_mapping_open(test)
       if (isError(errors, ERR_SKIPPED_ID, reason)) then
          call yaml_map("status", "skipped")
          call yaml_map("reason", reason)
       else if (isError(errors, ERR_EXPECTED_ID, reason)) then
          call yaml_map("status", "failed")
          call yaml_map("expected", .true.)
          call yaml_map("reason", reason)
          if (associated(errors)) call yaml_map("error", errors)
       else
          call yaml_map("status", "failed")
          call yaml_map("error", errors)
       end if
       call yaml_mapping_close()
       call dict_free(errors)
    else
       call yaml_map(test, "succeed")
    end if
  end subroutine output
  
  subroutine run_parallel(func, env)
    use dictionaries
    use wrapper_MPI
    implicit none
    interface
       subroutine func(test, env)
         use wrapper_MPI
         character(len = *), intent(out) :: test
         type(mpi_environment), intent(in) :: env
       end subroutine func
    end interface

    character(len = max_field_length) :: test
    type(dictionary), pointer :: errors
    type(mpi_environment), intent(in) :: env

    logical :: error

    nullify(errors)
    call f_err_open_try()
    call func(test, env)
    call f_err_close_try(errors)

    error = associated(errors)
    call fmpi_allreduce(error, 1, FMPI_LOR, env%mpi_comm)
    if (associated(errors) .and. env%iproc > 0) call dict_free(errors)

    if (env%iproc > 0) return

    if (.not. associated(errors) .and. error) then
       call dict_init(errors)
       call set(errors, "MPI issue")
    end if
    call output(test, errors)
  end subroutine run_parallel

  subroutine run_serial(func)
    use dictionaries
    use wrapper_MPI
    implicit none
    interface
       subroutine func(test)
         character(len = *), intent(out) :: test
       end subroutine func
    end interface

    character(len = max_field_length) :: test
    type(dictionary), pointer :: errors
    type(mpi_environment) :: env
    integer :: iproc

    env = mpi_environment_comm()
    iproc = env%iproc
    call release_mpi_environment(env)
    if (iproc > 0) return

    nullify(errors)
    call f_err_open_try()
    call func(test)
    call f_err_close_try(errors)
    call output(test, errors)
  end subroutine run_serial

  subroutine skip(reason)
    use dictionaries
    implicit none
    character(len = *), intent(in), optional :: reason

    if (ERR_SKIPPED_ID == 0) then
       call f_err_define("REGTESTS_SKIP", "test skipped", ERR_SKIPPED_ID)
    end if
    call f_err_throw(reason, ERR_SKIPPED_ID)
  end subroutine skip

  subroutine expectFailure(reason)
    use dictionaries
    implicit none
    character(len = *), intent(in), optional :: reason

    if (ERR_EXPECTED_ID == 0) then
       call f_err_define("REGTESTS_EXPECT", "expected test failure", ERR_EXPECTED_ID)
    end if
    call f_err_throw(reason, ERR_EXPECTED_ID)
  end subroutine expectFailure

  subroutine verify(val, label)
    use dictionaries
    implicit none
    logical, intent(in) :: val
    character(len = *), intent(in) :: label

    if (.not. val) call f_err_throw(label // ": failed")
  end subroutine verify
  
  subroutine compare_l(val, expected, label)
    use dictionaries
    use yaml_strings
    implicit none
    logical, intent(in) :: val, expected
    character(len = *), intent(in), optional :: label
    logical :: ok
    ok = val .eqv. expected
    include 'compare-scalar-inc.f90'
  end subroutine compare_l

  subroutine compare_i(val, expected, label)
    use dictionaries
    use f_precisions, only: f_integer
    use yaml_strings
    implicit none
    integer(f_integer), intent(in) :: val, expected
    character(len = *), intent(in), optional :: label
    logical :: ok
    ok = val == expected
    include 'compare-scalar-inc.f90'
  end subroutine compare_i

  subroutine compare_f(val, expected, label, tol)
    use dictionaries
    use f_precisions, only: f_simple
    use yaml_strings
    implicit none
    real(f_simple), intent(in) :: val, expected
    character(len = *), intent(in), optional :: label
    real(f_simple), intent(in), optional :: tol
    logical :: ok
    if (present(tol)) then
       ok = abs(val - expected) < tol
    else
       ok = val == expected
    end if
    include 'compare-scalar-inc.f90'
  end subroutine compare_f

  subroutine compare_d(val, expected, label, tol)
    use dictionaries
    use f_precisions, only: f_double
    use yaml_strings
    implicit none
    real(f_double), intent(in) :: val, expected
    character(len = *), intent(in), optional :: label
    real(f_double), intent(in), optional :: tol
    logical :: ok
    if (present(tol)) then
       ok = abs(val - expected) < tol
    else
       ok = val == expected
    end if
    include 'compare-scalar-inc.f90'
  end subroutine compare_d

  subroutine compare_s(val, expected, label)
    use dictionaries
    use yaml_strings
    implicit none
    character(len = *), intent(in) :: val, expected
    character(len = *), intent(in), optional :: label
    logical :: ok
    ok = val == expected
    include 'compare-scalar-inc.f90'
  end subroutine compare_s

  subroutine compare_dict(dict, expected, label)
    use dictionaries
    use yaml_strings
    implicit none
    type(dictionary), pointer :: dict
    character(len = *), intent(in) :: expected
    character(len = *), intent(in), optional :: label
    character(len = max_field_length) :: val

    val = dict
    call compare(val, expected, label)
  end subroutine compare_dict

  subroutine compare_dict_d(dict, expected, label, tol)
    use dictionaries
    use f_precisions, only: f_double, f_long
    use yaml_strings
    implicit none
    type(dictionary), pointer :: dict
    real(f_double), intent(in) :: expected
    character(len = *), intent(in), optional :: label
    real(f_double), intent(in), optional :: tol
    real(f_double) :: val

    val = dict
    call compare(val, expected, label, tol)
  end subroutine compare_dict_d

  subroutine compare_ai(val, expected, label)
    use dictionaries
    use f_precisions, only: f_integer
    use yaml_strings
    implicit none
    integer(f_integer), dimension(:), intent(in) :: val, expected
    character(len = *), intent(in), optional :: label
    logical :: ok
    include 'compare-array-inc-size.f90'
    ok = all(val == expected)
    include 'compare-array-inc.f90'
  end subroutine compare_ai

  subroutine compare_af(val, expected, label, tol)
    use dictionaries
    use f_precisions, only: f_simple
    use yaml_strings
    implicit none
    real(f_simple), dimension(:), intent(in) :: val, expected
    character(len = *), intent(in), optional :: label
    real(f_simple), intent(in), optional :: tol
    logical :: ok
    include 'compare-array-inc-size.f90'
    if (present(tol)) then
       ok = all(abs(val - expected) < tol)
    else
       ok = all(val == expected)
    end if
    include 'compare-array-inc.f90'
  end subroutine compare_af

  subroutine compare_ad(val, expected, label, tol)
    use dictionaries
    use f_precisions, only: f_double
    use yaml_strings
    implicit none
    real(f_double), dimension(:), intent(in) :: val, expected
    character(len = *), intent(in), optional :: label
    real(f_double), intent(in), optional :: tol
    logical :: ok
    include 'compare-array-inc-size.f90'
    if (present(tol)) then
       ok = all(abs(val - expected) < tol)
    else
       ok = all(val == expected)
    end if
    include 'compare-array-inc.f90'
  end subroutine compare_ad

  subroutine compare_ad2(val, expected, label, tol)
    use dictionaries
    use f_precisions, only: f_double
    use yaml_strings
    implicit none
    real(f_double), dimension(:,:), intent(in) :: val, expected
    character(len = *), intent(in), optional :: label
    real(f_double), intent(in), optional :: tol
    logical :: ok
    include 'compare-array-inc-size.f90'
    if (present(tol)) then
       ok = all(abs(val - expected) < tol)
    else
       ok = all(val == expected)
    end if
    include 'compare-array-inc.f90'
  end subroutine compare_ad2

  subroutine compare_ai2(val, expected, label)
    use dictionaries
    use f_precisions, only: f_integer
    use yaml_strings
    implicit none
    integer(f_integer), dimension(:,:), intent(in) :: val, expected
    character(len = *), intent(in), optional :: label
    logical :: ok
    include 'compare-array-inc-size.f90'
    ok = all(val == expected)
    include 'compare-array-inc.f90'
  end subroutine compare_ai2
end module f_unittests
