subroutine test3callback(key, value, args, stat)
  use n3bits, only: itoaunpack
  integer, intent(in):: key(*)
  integer, intent(in):: value(*)
  integer, intent(in):: args(*)
  integer, intent(out):: stat
  character(8):: ckey
  character(32):: cvalue
  call itoaunpack(key, 2, ckey)
  call itoaunpack(value, 8, cvalue)
  print "(A)", '"' // trim(ckey) // '" => "' // trim(cvalue) // '"'
  stat = 0
end subroutine

program hash
  use n3hash
  use n3error, only: trace
  implicit none
  integer:: hash2
  call test1
  call test2(hash2)
  call test3
  call test4(hash2)
  call endtest(hash2)
contains

  subroutine class_fill
    use n3object, only: class_max, class_new
    use n3error, only: die
    character(8):: classname
    integer:: klass, i
    do, i = 1, class_max
      write(classname, "('KLASS', I3.3)") i
      call class_new(classname, klass)
      if (klass < 0) call die
    enddo
  end subroutine

  subroutine class_release
    use n3object, only: class_max, class_dispose
    use n3error, only: die
    integer:: i, stat
    do, i = 1, class_max
      call class_dispose(i, stat)
      if (stat /= 0) call die
    enddo
  end subroutine

  subroutine oktrace
    use n3error, only: trace
    call trace(prefix='(')
  end subroutine

  subroutine test1
    integer:: handle
    print "('Class table overflow test ...')"
    call class_fill
    call hash_new(1, 1, handle)
    if (handle < 0) then
      call oktrace
    else
      print '("Weird: hash_new success after class table overflow")'
      stop 16
    endif
    call class_release
    print "('... passed')"
  end subroutine

  integer function ifunc(i)
    integer, intent(in):: i
    ifunc = ieor(i, ishft(i, 8))
    ifunc = ieor(ifunc, ishft(iand(i, 3), 16))
    ifunc = ieor(ifunc, ishft(mod(i / 13, 3), 18))
  end function

  subroutine test2(handle)
    use n3error, only: die, trace
    use n3hash, only: hash_put, hash_get, hash_new, hash_dispose
    integer, intent(out):: handle
    integer:: key(1)
    integer:: value(1)
    integer:: stat, i, j
    integer, parameter:: NENTRIES = 1000
    print "('Multiple append test ...')"
    call hash_new(1, 1, handle)
    if (handle < 0) call die
    if (hash_size(handle) /= 0) then
      print "('hash size mismatch')"
      stop 16
    endif
    ! --- EMPTY REFERENCE ---
    key = 1
    call hash_get(handle, key, value, stat)
    if (stat == 0) then
      print *, "reference to empty hash returns value"
      stop 16
    else
      call trace(prefix='(')
    endif
    ! --- FILL HASH TABLE ---
    do, i = 1, NENTRIES
      key = i
      value = ifunc(i)
      call hash_put(handle, key, value, stat)
      if (stat /= 0) call die
    enddo
    ! --- CHECK FILLED AREA ---
    do, i = NENTRIES, 1, -1
      key = i
      call hash_get(handle, key, value, stat)
      if (stat /= 0) call die
      if (value(1) /= ifunc(i)) then
        print *, 'mismatch!', i, value(1), ifunc(i)
        stop 16
      endif
    enddo
    if (hash_size(handle) /= NENTRIES) then
      print "('hash size mismatch')"
      stop 16
    endif
    ! --- CHECK UNFILLED AREA STILL EMPTY ---
    key = NENTRIES + 1
    call hash_get(handle, key, value, stat)
    if (stat == 0) then
      print *, "reference to empty hash returns value"
      stop 16
    else
      call trace(prefix='(')
    endif
    ! --- OVERWRITE TEST ---
    do, i = 1, NENTRIES
      key = i
      j = ifunc(i) + 1
      value = j
      call hash_put(handle, key, value, stat)
      if (stat /= 0) call die
      value = 0
      call hash_get(handle, key, value, stat)
      if (stat /= 0) call die
      if (value(1) /= j) then
        print *, "mismatch (overwrite):", i, value(1), j
        stop 16
      endif
    enddo
    ! --- CHECK UNFILLED AREA STILL EMPTY ---
    key = NENTRIES + 1
    call hash_get(handle, key, value, stat)
    if (stat == 0) then
      print *, "reference to empty hash returns value"
      stop 16
    else
      call trace(prefix='(')
    endif
    if (hash_size(handle) /= NENTRIES) then
      print "('hash size mismatch')"
      stop 16
    endif
    ! HASH handle KEPT UNDISPOSED UNTIL THE END OF THE PROGRAM
    print "('... passed')"
  end subroutine

  subroutine test3
    use n3error, only: die
    use n3bits, only: atoipack
    integer, parameter:: EXAMPLES = 4
    character(8):: keys(EXAMPLES)
    character(32):: values(EXAMPLES)
    data keys(1) / 'mouse' / values(1) / 'Mickey Mouse' /
    data keys(2) / 'duck' / values(2) / 'Donald' /
    data keys(3) / 'cat' / values(3) / 'Doraemon' /
    data keys(4) / 'human' / values(4) / 'Dr. Anonymous Coward III' /
    integer:: i
    integer:: handle
    integer:: key(2)
    integer:: value(8)
    integer:: stat
    external test3callback
    print "('hash of string ....')"
    call hash_new(2, 8, handle); if (handle < 0) call die
    do, i = 1, EXAMPLES
      call atoipack(keys(i), key, size(key))
      call atoipack(values(i), value, size(value))
      call hash_put(handle, key, value, stat); if (stat /= 0) call die
    enddo
    if (hash_size(handle) /= EXAMPLES) then
      print "('hash size mismatch')"
      stop 16
    endif
    call hash_each(handle, test3callback, (/i/), stat)
    if (stat /= 0) call die
    call hash_dispose(handle, stat); if (stat /= 0) call die
    print "('.... passed')"
  end subroutine

  subroutine test4(handle2)
    use n3error, only: die, trace
    use n3hash, only: hash_save, hash_load, hash_get, hash_dispose
    use n3io1, only: delete
    integer, intent(in):: handle2
    integer:: key(1)
    integer:: value(1)
    integer:: stat, i, j, handle
    integer, parameter:: NENTRIES = 1000
    character(*), parameter:: filename = "test.hash"
    print "('save/load test ...')"
    call hash_save(handle2, filename, stat)
    if (stat < 0) call die

    call hash_load(filename, handle)
    if (handle < 0) call die

    ! --- CHECK FILLED AREA ---
    do, i = NENTRIES, 1, -1
      key = i
      call hash_get(handle, key, value, stat)
      if (stat /= 0) call die
      if (value(1) /= ifunc(i) + 1) then
        print *, 'mismatch!', i, value(1), ifunc(i) + 1
        stop 16
      endif
    enddo
    if (hash_size(handle) /= NENTRIES) then
      print "('hash size mismatch')"
      stop 16
    endif
    ! --- CHECK UNFILLED AREA STILL EMPTY ---
    key = NENTRIES + 1
    call hash_get(handle, key, value, stat)
    if (stat == 0) then
      print *, "reference to empty hash returns value"
      stop 16
    else
      call trace(prefix='(')
    endif

    call hash_dispose(handle, stat); if (stat /= 0) call die
    call delete(filename, stat)

    print "('... passed')"
  end subroutine

  subroutine endtest(hash)
    use n3error, only: die
    integer, intent(in):: hash
    integer:: stat
    call hash_dispose(hash, stat); if (stat /= 0) call die
    call hashclass_finalize(stat); if (stat /= 0) call die
  end subroutine

end program