! author: ralf.mueller@mpimet.mpg.de
module self_assert

    use iso_fortran_env

    use self_object, only: object_equal, object_string

    implicit none

    public

    character(*), parameter :: NL = new_line('')
    character(1), parameter :: ESC = achar(27)

    character(5), parameter :: &
        mode_black         = ESC//'[30m', &
        mode_red           = ESC//'[31m', &
        mode_green         = ESC//'[32m', &
        mode_yellow        = ESC//'[33m', &
        mode_blue          = ESC//'[34m', &
        mode_purple        = ESC//'[35m', &
        mode_aqua          = ESC//'[36m', &
        mode_dark_grey     = ESC//'[90m', &
        mode_peach         = ESC//'[91m', &
        mode_light_green   = ESC//'[92m', &
        mode_light_yellow  = ESC//'[93m', &
        mode_light_blue    = ESC//'[94m', &
        mode_pink          = ESC//'[95m', &
        mode_light_aqua    = ESC//'[96m', &
        mode_pearl_white   = ESC//'[97m'

    character(4), parameter :: &
        mode_bold   = ESC//'[1m', &
        mode_normal = ESC//'[0m'

    integer, private :: counter = 0

contains

    subroutine print_mode(mode, message, stderr)
        character(*), intent(in)      :: mode
        character(*), intent(in)      :: message
        logical, optional, intent(in) :: stderr

        integer :: stream
      
        stream = output_unit
        if(present(stderr)) then
            if(stderr) stream = error_unit
        end if

        write(stream, '(*(A))') mode, trim(message), mode_normal
    end subroutine

    subroutine print_error(message,stderr)
        character(*), intent(in)      :: message
        logical, optional, intent(in) :: stderr
        call print_mode(mode_red, message,stderr)
    end subroutine

    subroutine print_verbose(message)
        character(*), intent(in)      :: message
        call print_mode(mode_normal, message, stderr=.true.)
    end subroutine

    subroutine print_footer(message,stderr)
        character(*), intent(in)      :: message
        logical, optional, intent(in) :: stderr
        call print_mode(mode_green, message,stderr)
    end subroutine

    subroutine print_summary(message,stderr)
        character(*), intent(in)      :: message
        logical, optional, intent(in) :: stderr
        call print_mode(mode_bold//mode_green, message,stderr)
    end subroutine

    subroutine assert(this, message)
        logical, intent(in) :: this
        character(*), intent(in), optional :: message

        counter = counter + 1

        if(.not. this) then
            call print_error('== ASSERT FAILED =======================')
            print *,counter

            if ( present(message) ) call print_error(message)
            stop
        end if
    end subroutine

    subroutine assert_equal(a, b, message, verbose)
        class(*), intent(in)   :: a
        class(*), intent(in)   :: b
        character(*), optional :: message
        logical, optional      :: verbose

        character(:), allocatable :: buffer

        if(present(message)) then
            buffer = message
        else
            buffer = &
                'found non-equal objects:' // NL // &
                '-- LEFT --------------------------------' // NL // &
                object_string(a) // NL // &
                '-- RIGHT -------------------------------' // NL // &
                object_string(b)
        end if

        call assert(object_equal(a, b), buffer)

        if(present(verbose)) then
            if(verbose) then
                call print_verbose( &
                    '== ASSERT SUCCESSFUL ===================' // NL // &
                    ' got      : ' // NL // &
                    object_string(a) // NL // &
                    ' expected: ' // NL // &
                    object_string(b) // NL // &
                    '== END ASSERT ==========================' &
                )
            end if
        end if
    end subroutine assert_equal

    subroutine assert_not_equal(a, b, message, verbose)
        class(*), intent(in)   :: a
        class(*), intent(in)   :: b
        character(*), optional :: message
        logical, optional      :: verbose

        character(:), allocatable :: buffer

        if(present(message)) then
            buffer = message
        else
            buffer = &
                'found equal objects:' // NL // &
                '-- LEFT --------------------------------' // NL // &
                object_string(a) // NL // &
                '-- RIGHT -------------------------------' // NL // &
                object_string(b)
        end if

        call assert(.not. object_equal(a, b), buffer)

        if(present(verbose)) then
            if(verbose) then
                call print_verbose( &
                    '== ASSERT SUCCESSFUL ===================' // NL // &
                    ' got      : ' // NL // &
                    object_string(a) // NL // &
                    ' expected: ' // NL // &
                    object_string(b) // NL // &
                    '== END ASSERT ==========================' &
                )
            end if
        end if
    end subroutine assert_not_equal

    subroutine assert_print_count()
        call print_footer('#================================================')
        call print_summary('Executed '//object_string(counter)//' assertions.')
    end subroutine assert_print_count

end module self_assert

!vim tw=0