program object_test
  use n3object
  implicit none
  ! parameter test
  call dump_consts
  call filltabletest
  call roundtrip
contains

  subroutine dump(name, value)
      character(*), intent(in):: name
      integer, intent(in):: value
      print "(A16,': 0x',Z8.8,' (',I11.1,')')", name, value, value
  end subroutine

  subroutine dump_consts
    print '("--- constants ---")'
    call dump('CLASS_MAX', class_max)
    call dump('CLASS_MASK', class_mask)
    call dump('CLASS_NBITS', class_nbits)
    call dump('CLASS_SHIFTER', class_shifter)
    call dump('ID_MASK', id_mask)
    call dump('ID_NBITS', id_nbits)
    call dump('ID_SHIFTER', id_shifter)
    print '("------")'
  end subroutine

  subroutine oktrace
    use n3error, only: trace
    call trace
    print '(A)', "(Don't worry, error above is expected one)"
  end subroutine

  subroutine filltabletest
    use n3error, only: die
    character(8):: classname
    integer:: klass
    integer:: stat
    integer:: i
    do, i = 1, class_max
      write(classname, "('KLASS',I3.3)") i
      call class_new(classname, klass)
      if (klass < 0) then
        print *, 'class table full before expected'
        call die
      endif
    enddo
    call class_new('MUSTFULL', klass)
    if (klass < 0) then
      call oktrace
    else
      print *, 'class table not full (weird)'
      stop 16
    endif
    !
    call class_dispose(class_max, stat)
    if (stat == 0) then
      print '(A)', 'ok class dispose'
    else
      call die
    endif
    !
    call class_dispose(class_max, stat)
    if (stat /= 0) then
      call oktrace
    else
      print *, 'class disposed twice (weird)'
      stop 16
    endif
    !
    call class_dispose(class_max + 1, stat)
    if (stat /= 0) then
      call oktrace
    else
      print *, 'bad class disposed (weird)'
      stop 16
    endif
    !
    call class_new('OTHERNAM', klass)
    if (klass > 0) then
      print *, 'class reallocation ok'
    else
      call die
    endif
  end subroutine

  subroutine roundtrip_k(klass0, id0)
    integer, intent(in):: klass0, id0
    integer:: klass, id, handle
    logical:: fail
    call object_new(klass = klass0, id = id0, handle = handle)
    klass = 0
    id = 0
    call object_idpart(handle, id = id)
    call object_classpart(handle, klass = klass)
    fail = .false.
    if (id /= id0) then
      print *, 'id mismatch:', id, id0
      fail = .true.
    endif
    if (klass /= klass0) then
      print *, 'class mismatch:', klass, klass0
      fail = .true.
    endif
    if (fail) stop 16
  end subroutine

  subroutine roundtrip
    call roundtrip_k(0, 0)
    call roundtrip_k(1, 1)
    call roundtrip_k(127, 0)
    call roundtrip_k(0, 127)
    call roundtrip_k(213, 2123)
  end subroutine

end program