Add unit tests

Author: nedtaylor

test/CMakeLists.txt

@@ -3,6 +3,7 @@ foreach(execid
     misc
     misc_maths
     misc_linalg
+    cache
     element_utils
     geom_rw
     geom_utils
@@ -29,4 +30,4 @@ foreach(execid
   endif()
 
   add_test(NAME test_${execid} COMMAND test_${execid})
-endforeach()
+endforeach()

test/test_cache.f90

@@ -0,0 +1,103 @@
+program test_cache
+  use raffle__io_utils
+  use raffle__cache
+  use raffle__constants, only: real32
+  implicit none
+
+  logical :: success = .true.
+
+  call test_retrieve_unallocated(success)
+  call test_store_retrieve_probability_density(success)
+
+  !-----------------------------------------------------------------------------
+  ! check for any failed tests
+  !-----------------------------------------------------------------------------
+  write(*,*) "----------------------------------------"
+  if(success)then
+     write(*,*) 'test_cache passed all tests'
+  else
+     write(0,*) 'test_cache failed one or more tests'
+     stop 1
+  end if
+
+contains
+
+  subroutine test_store_retrieve_probability_density(success)
+    implicit none
+    logical, intent(inout) :: success
+    real(real32), allocatable :: test_data(:,:), retrieved_data(:,:)
+    integer :: i, j
+
+    ! Create test data - a 3x3 matrix with values
+    allocate(test_data(3,3))
+    do i = 1, 3
+      do j = 1, 3
+        test_data(i,j) = real(i*10 + j, real32)
+      end do
+    end do
+
+    ! Store the test data in the cache
+    call store_probability_density(test_data)
+
+    ! Retrieve the data from the cache
+    retrieved_data = retrieve_probability_density()
+
+    ! Check dimensions match
+    if (.not. all(shape(retrieved_data) == shape(test_data))) then
+      write(0,*) 'test_store_retrieve_probability_density: array shapes do not match'
+      success = .false.
+      return
+    end if
+
+    ! Check all values match
+    do i = 1, 3
+      do j = 1, 3
+        if (abs(retrieved_data(i,j) - test_data(i,j)) .gt. 1.e-6_real32) then
+          write(0,*) &
+               'test_store_retrieve_probability_density: values do not match at', &
+               i, j, retrieved_data(i,j), test_data(i,j)
+          success = .false.
+          return
+        end if
+      end do
+    end do
+
+    ! Clean up
+    if (allocated(test_data)) deallocate(test_data)
+    if (allocated(retrieved_data)) deallocate(retrieved_data)
+
+    write(*,*) 'test_store_retrieve_probability_density: PASSED'
+  end subroutine test_store_retrieve_probability_density
+
+  subroutine test_retrieve_unallocated(success)
+    implicit none
+    logical, intent(inout) :: success
+    real(real32), allocatable :: retrieved_data(:,:)
+
+    ! Try to retrieve data when cache is not allocated
+    retrieved_data = retrieve_probability_density()
+
+    ! Verify returned array is a scalar with value 0
+    if (size(retrieved_data) .ne. 1) then
+      write(0,*) &
+           'test_retrieve_unallocated: returned array should be scalar but has size', &
+           size(retrieved_data)
+      success = .false.
+      return
+    end if
+
+    if (abs(retrieved_data(1,1)) .gt. 1.e-6_real32) then
+      write(0,*) &
+           'test_retrieve_unallocated: returned value should be 0 but is', &
+           retrieved_data(1,1)
+      success = .false.
+      return
+    end if
+
+    ! Clean up
+    if (allocated(retrieved_data)) deallocate(retrieved_data)
+
+    write(*,*) 'test_retrieve_unallocated: PASSED'
+  end subroutine test_retrieve_unallocated
+
+end program test_cache

test/test_distribs_container.f90

@@ -83,9 +83,11 @@ program test_distribs_container
   call test_set_radius_distance_tol(success)
   call test_create([basis_graphite], success)
   call test_update([basis_graphite, basis_diamond], success)
+  call test_read_write_gdfs([basis_graphite, basis_diamond], success)
 
   call test_create([basis_diamond, basis_mgo], success)
   call test_update([basis_diamond, basis_mgo], success)
+  call test_read_write_gdfs([basis_diamond, basis_mgo], success)
   !  call test_write_read(success)
   !  call test_write_2body(success)
   !  call test_write_3body(success)
@@ -232,6 +234,41 @@ subroutine test_set_history_len(success)
          success &
     )
 
+    ! Call the subroutine to set the history length when already allocated
+    history_len = 3
+    call distribs_container%set_history_len(history_len)
+
+    ! Check if the history length was set correctly
+     call assert( &
+           distribs_container%history_len .eq. history_len, &
+           "History length was not set correctly after reallocation", &
+           success &
+     )
+
+     call assert( &
+           allocated(distribs_container%history_deltas) .and. &
+           size(distribs_container%history_deltas, 1) .eq. history_len, &
+           "History delta list was not reallocated", &
+           success &
+     )
+
+     ! Call the subroutine to set the history length to zero
+     history_len = 0
+     call distribs_container%set_history_len(history_len)
+
+     ! Check if the history length was set correctly
+     call assert( &
+          distribs_container%history_len .eq. history_len, &
+          "History length was not set to zero", &
+          success &
+     )
+
+     call assert( &
+          .not.allocated(distribs_container%history_deltas), &
+          "History deltas was not deallocated", &
+          success &
+     )
+
   end subroutine test_set_history_len
 
   subroutine test_is_converged(success)
@@ -392,6 +429,7 @@ subroutine test_create(basis, success)
     type(distribs_container_type) :: distribs_container
     type(basis_type), dimension(size(basis,1)) :: basis_list
     character(len=3), dimension(:), allocatable :: elements
+    real(real32), dimension(:), allocatable :: energy_above_hull
 
     ! Initialise basis_list
     do i = 1, size(basis,1)
@@ -584,6 +622,29 @@ subroutine test_create(basis, success)
          success &
     )
 
+    allocate(energy_above_hull(10))
+    energy_above_hull = 0._real32
+
+    write(*,*) "Testing energy_above_hull error handling"
+    call distribs_container%create( &
+         basis_list, deallocate_systems=.false., &
+         energy_above_hull_list=energy_above_hull &
+    )
+    write(*,*) "Handled error: energy_above_hull provided but weight_by_hull is false"
+    distribs_container%weight_by_hull = .true.
+    call distribs_container%create( &
+         basis_list, deallocate_systems=.false., &
+         energy_above_hull_list=energy_above_hull &
+    )
+    write(*,*) "Handled error: energy_above_hull and basis_list sizes do not match"
+    deallocate(energy_above_hull)
+    allocate(energy_above_hull(size(basis_list,1)))
+    energy_above_hull = 0._real32
+    call distribs_container%create( &
+         basis_list, deallocate_systems=.false., &
+         energy_above_hull_list=energy_above_hull &
+    )
+
   end subroutine test_create
 
   subroutine test_update(basis, success)
@@ -597,6 +658,7 @@ subroutine test_update(basis, success)
     type(distribs_container_type) :: distribs_container
     type(basis_type), dimension(size(basis,1)) :: basis_list
     character(len=3), dimension(:), allocatable :: elements
+    real(real32), dimension(:), allocatable :: energy_above_hull
 
     ! Initialise basis_list
     do i = 1, size(basis,1)
@@ -652,6 +714,42 @@ subroutine test_update(basis, success)
          success &
     )
 
+    ! Check history length
+    call distribs_container%set_history_len(10)
+    call distribs_container%update( &
+         basis_list, deallocate_systems=.false. &
+    )
+    call assert( &
+         distribs_container%history_deltas(1) .ne. huge(0._real32), &
+         "History delta not set on update", &
+         success &
+    )
+
+    allocate(energy_above_hull(10))
+    energy_above_hull = 0._real32
+
+    write(*,*) "Testing energy_above_hull error handling"
+    call distribs_container%update( &
+         basis_list, deallocate_systems=.false., &
+         energy_above_hull_list=energy_above_hull &
+    )
+    write(*,*) "Handled error: energy_above_hull provided but weight_by_hull is false"
+    distribs_container%weight_by_hull = .true.
+    call distribs_container%update( &
+         basis_list, deallocate_systems=.false., &
+         energy_above_hull_list=energy_above_hull &
+    )
+    write(*,*) "Handled error: energy_above_hull and basis_list sizes do not match"
+    deallocate(energy_above_hull)
+    allocate(energy_above_hull(size(basis_list,1)))
+    energy_above_hull = 0._real32
+    call distribs_container%update( &
+         basis_list, deallocate_systems=.false., &
+         energy_above_hull_list=energy_above_hull, &
+         from_host = .true. &
+    )
+    write(*,*) "Handled error: from_host and energy_above_hull provided"
+
   end subroutine test_update
 
   subroutine test_add(basis, success)
@@ -909,6 +1007,123 @@ subroutine test_get_bin(success)
 
   end subroutine test_get_bin
 
+  subroutine test_read_write_gdfs(basis, success)
+    implicit none
+    type(basis_type), dimension(:), intent(in) :: basis
+    logical, intent(inout) :: success
+
+     type(distribs_container_type) :: distribs_container, distribs_container_read
+     character(len=100) :: filename
+
+    ! Set up a test filename
+    filename = 'test_gdfs.dat'
+
+    ! Create a dummy distribs_container
+    call distribs_container%set_history_len(10)
+    call distribs_container%set_width([0.1_real32, 0.1_real32, 0.1_real32])
+    call distribs_container%set_sigma([0.2_real32, 0.2_real32, 0.2_real32])
+    call distribs_container%create([basis], deallocate_systems=.false.)
+
+    ! Write the GDFs to a file
+    call distribs_container%write_gdfs(filename)
+
+    ! Check if the file exists
+    inquire(file=filename, exist=success)
+    call assert(success, "GDF file was not created", success)
+
+    ! Read the GDFs from the file
+    call distribs_container_read%read_gdfs(filename)
+
+    ! Check if the GDFs were read correctly
+    call assert( &
+         allocated(distribs_container_read%gdf%df_2body), &
+         "2-body GDF was not read correctly", &
+         success &
+    )
+    call assert( &
+         allocated(distribs_container_read%gdf%df_3body), &
+         "3-body GDF was not read correctly", &
+         success &
+    )
+    call assert( &
+         allocated(distribs_container_read%gdf%df_4body), &
+         "4-body GDF was not read correctly", &
+         success &
+    )
+
+    ! Check if the read width, sigma, and history length match
+    call assert( &
+         all( &
+              abs( &
+                   distribs_container_read%width - &
+                   distribs_container%width &
+              ) .lt. 1.E-6_real32 &
+         ), &
+         "Width was not read correctly", &
+         success &
+    )
+    call assert( &
+         all( &
+              abs( &
+                   distribs_container_read%sigma - &
+                   distribs_container%sigma &
+              ) .lt. 1.E-6_real32 &
+         ), &
+         "Sigma was not read correctly", &
+         success &
+    )
+    call assert( &
+         distribs_container_read%history_len .eq. distribs_container%history_len, &
+         "History length was not read correctly", &
+         success &
+    )
+    call assert( &
+         all( &
+              abs( 1._real32 - &
+                   distribs_container_read%history_deltas / &
+                   distribs_container%history_deltas &
+              ) .lt. 1.E-4_real32 &
+         ), &
+         "History deltas were not read correctly", &
+         success &
+    )
+    call assert( &
+         all( &
+              abs( &
+                   distribs_container_read%cutoff_min - &
+                   distribs_container%cutoff_min &
+              ) .lt. 1.E-6_real32 &
+         ), &
+         "Cutoff min was not read correctly", &
+         success &
+    )
+    call assert( &
+         all( &
+              abs( &
+                   distribs_container_read%cutoff_max - &
+                   distribs_container%cutoff_max &
+              ) .lt. 1.E-6_real32 &
+         ), &
+         "Cutoff max was not read correctly", &
+         success &
+    )
+    call assert( &
+         all( &
+              abs( &
+                   distribs_container_read%radius_distance_tol - &
+                   distribs_container%radius_distance_tol &
+              ) .lt. 1.E-6_real32 &
+         ), &
+         "Radius distance tolerance was not read correctly", &
+         success &
+    )
+    call assert( &
+         all( distribs_container_read%nbins .eq. distribs_container%nbins ), &
+         "Number of bins was not read correctly", &
+         success &
+    )
+  end subroutine test_read_write_gdfs
+
 !###############################################################################
 
   subroutine assert(condition, message, success)