hasty_test_caf_basic Program

  1. hasty_test_caf_basic.F90
  2. hasty_test_caf_basic
program~~hasty_test_caf_basic~~UsesGraph program~hasty_test_caf_basic hasty_test_caf_basic module~hasty hasty module~hasty->program~hasty_test_caf_basic iso_fortran_env iso_fortran_env iso_fortran_env->program~hasty_test_caf_basic module~tester tester iso_fortran_env->module~tester module~penf_stringify penf_stringify iso_fortran_env->module~penf_stringify module~tester->program~hasty_test_caf_basic module~hasty_dictionary_node hasty_dictionary_node module~hasty_dictionary_node->module~hasty module~hasty_dictionary hasty_dictionary module~hasty_dictionary_node->module~hasty_dictionary module~hasty_hash_table hasty_hash_table module~hasty_hash_table->module~hasty module~hasty_content_adt hasty_content_adt module~hasty_content_adt->module~hasty module~hasty_content_adt->module~hasty_dictionary_node module~hasty_content_adt->module~hasty_hash_table module~hasty_dictionary->module~hasty module~hasty_dictionary->module~hasty_hash_table module~hasty_key_base hasty_key_base module~hasty_key_base->module~hasty module~hasty_key_base->module~hasty_dictionary_node module~hasty_key_base->module~hasty_hash_table module~hasty_key_base->module~hasty_dictionary module~hasty_key_morton hasty_key_morton module~hasty_key_base->module~hasty_key_morton module~hasty_key_morton->module~hasty module~penf penf module~penf->module~hasty_dictionary_node module~penf->module~hasty_hash_table module~penf->module~hasty_dictionary module~penf->module~hasty_key_base module~penf->module~hasty_key_morton module~penf_global_parameters_variables penf_global_parameters_variables module~penf_global_parameters_variables->module~penf module~penf_b_size penf_b_size module~penf_global_parameters_variables->module~penf_b_size module~penf_global_parameters_variables->module~penf_stringify module~penf_b_size->module~penf module~penf_b_size->module~penf_stringify module~penf_stringify->module~penf
Help


HASTY test hash table CAF basic.


Variables

Subroutines

Source Code

hasty_test_caf_basic

Variables

Type AttributesNameInitial
type(tester_t) :: hasty_tester

Tests handler.
type(hash_table) :: a_table

A table.
class(*), pointer:: a_content

A content.
class(*), allocatable:: a_new_content

A content.

Subroutines

subroutine test_assert_equal(content, reference)

Test content==reference.

Arguments

Type IntentOptional AttributesName
class(*), intent(in) :: content

Content value.
integer(kind=int32), intent(in) :: reference

Reference value.

subroutine print_content_iterator(key, content, done)

Iterator that print contents.

Arguments

Type IntentOptional AttributesName
class(*), intent(in) :: key

The node key.
class(*), intent(in), pointer:: content

The generic content.
logical, intent(out) :: done

Flag to set to true to stop traversing.

Source Code

program hasty_test_caf_basic
!-----------------------------------------------------------------------------------------------------------------------------------
!< HASTY test hash table CAF basic.
!-----------------------------------------------------------------------------------------------------------------------------------
use, intrinsic :: iso_fortran_env, only : int32, int64, error_unit
use hasty
use tester
!-----------------------------------------------------------------------------------------------------------------------------------

!-----------------------------------------------------------------------------------------------------------------------------------
type(tester_t)        :: hasty_tester  !< Tests handler.
type(hash_table)      :: a_table       !< A table.
class(*), pointer     :: a_content     !< A content.
class(*), allocatable :: a_new_content !< A content.
!-----------------------------------------------------------------------------------------------------------------------------------

!-----------------------------------------------------------------------------------------------------------------------------------
call hasty_tester%init

call a_table%initialize(buckets_number=4, use_prime=.true.)

#ifdef CAF

call a_table%add_clone(key=1_int32, content=int(this_image(), int32))
call a_table%add_clone(key=3_int32, content=int(this_image(), int32))
call a_table%add_clone(key=10_int32, content=int(this_image(), int32))
call a_table%add_clone(key=13_int32, content=int(this_image(), int32))
call a_table%add_clone(key=16_int32, content=int(this_image(), int32))
call a_table%add_clone(key=22_int32, content=int(this_image(), int32))
call a_table%add_clone(key=27_int32, content=int(this_image(), int32))
call a_table%add_clone(key=31_int32, content=int(this_image(), int32))
call a_table%add_clone(key=40_int32, content=int(this_image(), int32))

sync all
a_content => a_table%get_pointer(key=3_int32)
if (associated(a_content)) then
  call test_assert_equal(content=a_content, reference=int(this_image(), int32))
  call hasty_tester%print
  write(error_unit, *) '  I am image: ', this_image(), ' and I HAVE key=3'
else
  write(error_unit, *) '  I am image: ', this_image(), ' and I have NOT key=3'
endif
sync all

sync all
critical
call a_table%get_clone(key=3_int32, content=a_new_content)
end critical
! if (allocated(a_new_content)) then
!   call test_assert_equal(content=a_content, reference=int(mod(mod(3, 5) + 1, num_images())+1, int32))
!   call hasty_tester%print
!   write(error_unit, *) '  I am image: ', this_image(), ' and I HAVE a copy key=3'
! else
!   write(error_unit, *) '  I am image: ', this_image(), ' and I have NOT a copy key=3'
! endif
sync all

if (this_image()==1) write(error_unit, *) 'Keys/Contents'
sync all
critical
call a_table%traverse(iterator=print_content_iterator)
end critical
sync all

if (this_image()==1) write(error_unit, *) 'IDs'
sync all
critical
write(error_unit, *) '  image: ', this_image(), ' ids = ', a_table%ids()
end critical
sync all

if (this_image()==1) write(error_unit, *) 'IDs global'
sync all
critical
write(error_unit, *) '  image: ', this_image(), ' ids global = ', a_table%ids(global=.true.)
end critical
sync all

if (this_image()==1) write(error_unit, *) 'Length'
sync all
critical
write(error_unit, *) '  image: ', this_image(), ' table length ', len(a_table)
end critical
sync all

if (this_image()==1) write(error_unit, *) 'Global length', len(a_table, global=.true.)

call a_table%destroy

if (this_image()==1) write(error_unit, *) 'Length'
sync all
critical
write(error_unit, *) '  image: ', this_image(), ' table length ', len(a_table)
end critical
sync all

#endif
!-----------------------------------------------------------------------------------------------------------------------------------
contains
  subroutine test_assert_equal(content, reference)
  !---------------------------------------------------------------------------------------------------------------------------------
  !< Test `content==reference`.
  !---------------------------------------------------------------------------------------------------------------------------------
  class(*),       intent(in) :: content   !< Content value.
  integer(int32), intent(in) :: reference !< Reference value.
  !---------------------------------------------------------------------------------------------------------------------------------

  !---------------------------------------------------------------------------------------------------------------------------------
  select type(content)
  type is(integer(int32))
    call hasty_tester%assert_equal(content, reference)
  endselect
  !---------------------------------------------------------------------------------------------------------------------------------
  endsubroutine test_assert_equal

  subroutine print_content_iterator(key, content, done)
  !---------------------------------------------------------------------------------------------------------------------------------
  !< Iterator that print contents.
  !---------------------------------------------------------------------------------------------------------------------------------
  class(*),          intent(in)  :: key     !< The node key.
  class(*), pointer, intent(in)  :: content !< The generic content.
  logical,           intent(out) :: done    !< Flag to set to true to stop traversing.
  !---------------------------------------------------------------------------------------------------------------------------------

  !---------------------------------------------------------------------------------------------------------------------------------
  if (associated(content)) then
    select type(content)
    type is(integer(int32))
      select type(key)
      type is(key_base)
#ifdef CAF
        write(error_unit, *) '  image: ', this_image(), 'key: ', key%stringify(), ' content: ', content
#endif
      endselect
    endselect
  endif
  done = .false.
  !---------------------------------------------------------------------------------------------------------------------------------
  endsubroutine print_content_iterator
endprogram hasty_test_caf_basic

All Programs