!>
!! Provides the base object defining basic operations used in containers
!!
module self_object

    implicit none

    type, abstract, public :: object
    contains
        procedure(is_equal_function), deferred :: is_equal
        procedure(to_string_function), deferred :: to_string
        generic :: operator(==) => is_equal
    end type object

    abstract interface
        recursive logical function is_equal_function(this, that)
            import object
            class(object), intent(in) :: this
            class(*), intent(in) :: that
        end function is_equal_function

        recursive function to_string_function(this)
            import object
            class(object), intent(in) :: this
            character(:), allocatable :: to_string_function
        end function to_string_function
    end interface

contains

    recursive function object_equal(this, that) result(equal)
        class(*), intent(in) :: this
        class(*), intent(in) :: that
        logical :: equal

#ifdef __GFORTRAN__
        character(1), allocatable :: mold(:)
#endif

        equal = .false.

        select type(this)

            class is (object)
                equal = this == that

            type is (character(*))
                select type(that)
                    type is (character(*))
                        equal = this == that
                end select

            type is (logical)
                select type(that)
                    type is (logical)
                        equal = this .eqv. that
                end select

            type is (integer)
                select type(that)
                    type is (integer)
                        equal = this == that
                end select

            type is (real)
                select type(that)
                    type is (real)
                        equal = this == that
                end select

            type is (double precision)
                select type(that)
                    type is (double precision)
                        equal = this == that
                end select

            class default
#ifdef __GFORTRAN__
                equal = all(transfer(this, mold) == transfer(that, mold))
#else
                write(0, '(*(g0))') 'Sorry: comparison of arbitrary types not &
                    &supported due to compiler deficiencies'
#endif

        end select

    end function object_equal

    recursive function object_pointer_string(this) result(string)
        class(*), pointer, intent(in) :: this
        character(:), allocatable :: string
        if(associated(this)) then
            string = object_string(this)
        else
            string = '<NULL>'
        end if
    end function object_pointer_string

    recursive function object_string(this) result(string)
        class(*), intent(in) :: this
        character(:), allocatable :: string

        select type(this)
            class is (object)
                string = this%to_string()
            type is (integer)
                string = repeat(' ', 11)
                write(string, '(I0)') this
                string = trim(string)
            type is (real)
                string = repeat(' ', 100)
                write(string, '(G0)') this
                string = trim(string)
            type is (character(*))
                string = "'"//trim(this)//"'"
            type is (logical)
                string = repeat(' ',1)
                write(string, '(L1)') this
            class default
                string = '<UNKNOWN TYPE>'
        end select
    end function object_string

end module self_object