#include "test-utils.F90"

module prif_coarray_inquiry_test_m
# include "test-uses-alloc.F90"
  use prif, only : &
      prif_coarray_handle, prif_num_images, &
      prif_local_data_pointer, prif_size_bytes, &
      prif_lcobound_no_dim, prif_lcobound_with_dim, &
      prif_ucobound_no_dim, prif_ucobound_with_dim, &
      prif_coshape

  use julienne_m, only: &
     operator(//) &
    ,operator(.all.) &
    ,operator(.also.) &
    ,operator(.equalsExpected.) &
    ,usher &
    ,string_t &
    ,test_description_t &
    ,test_diagnosis_t &
    ,test_result_t &
    ,test_t

  implicit none
  private
  public :: prif_coarray_inquiry_test_t

  type, extends(test_t) :: prif_coarray_inquiry_test_t
  contains
    procedure, nopass, non_overridable :: subject
    procedure, nopass, non_overridable :: results
  end type

contains

  pure function subject() result(test_subject)
     character(len=:), allocatable :: test_subject
     test_subject = "PRIF Coarray Inquiries"
  end function

  function results() result(test_results)
    type(test_result_t), allocatable :: test_results(:)
    type(prif_coarray_inquiry_test_t) prif_coarray_inquiry_test

    allocate(test_results, source = prif_coarray_inquiry_test%run([ &
       test_description_t("preserving the prif_local_data_pointer for an allocated coarray", usher(check_prif_local_data_pointer)) &
      ,test_description_t("checking passed cobounds", usher(check_cobounds)) &
    ]))
  end function

  function check_prif_local_data_pointer() result(diag)
      type(test_diagnosis_t) :: diag

      integer :: dummy_element
      type(prif_coarray_handle) :: coarray_handle
      type(c_ptr) :: allocation_ptr, local_ptr


      call prif_allocate_coarray( &
              [integer(c_int64_t):: 1], &
              [integer(c_int64_t)::], &
              int(storage_size(dummy_element)/8, c_size_t), &
              c_null_funptr, &
              coarray_handle, &
              allocation_ptr)
      call prif_local_data_pointer(coarray_handle, local_ptr)
      diag = c_associated(local_ptr, allocation_ptr)
      call prif_deallocate_coarray(coarray_handle)
  end function

  impure elemental function check_cobound(corank, omit_trailing) result(diag)
    type(test_diagnosis_t) :: diag
    integer(c_int), intent(in) :: corank
    logical, intent(in) :: omit_trailing

    ! Allocate memory for an integer scalar coarray with given corank
    ! and then test some queries on it

    integer :: num_imgs, i
    integer(kind=c_int64_t), dimension(corank) :: lcobounds, ucobounds, tmp_bounds
    integer(kind=c_int64_t), dimension(corank-1) :: leading_ucobounds
    integer(kind=c_int64_t) :: tmp_bound
    integer(kind=c_size_t), dimension(corank)  :: sizes
    type(prif_coarray_handle) :: coarray_handle
    type(c_ptr) :: allocated_memory
    integer(c_size_t) :: data_size, query_size

    diag = .true.

    call prif_num_images(num_images=num_imgs)
    lcobounds(1) = 1
    ucobounds(1) = num_imgs
    do i = 2,corank
      lcobounds(i) = i
      ucobounds(i) = i + merge(1,0,mod(i,2)==0)
    end do

    allocated_memory = c_null_ptr
    data_size = 64 * corank

    if (omit_trailing) then
      leading_ucobounds = ucobounds(1:corank-1)
      call prif_allocate_coarray( lcobounds, leading_ucobounds, data_size, c_null_funptr, &
        coarray_handle, allocated_memory)
    else
      call prif_allocate_coarray( lcobounds, ucobounds, data_size, c_null_funptr, &
        coarray_handle, allocated_memory)
    end if

    if (corank > 1) ucobounds(corank) = lcobounds(corank) ! trailing ucobound gets rounded down

    ALSO(c_associated(allocated_memory))

    call prif_size_bytes(coarray_handle, data_size=query_size)
    ALSO2(query_size .equalsExpected. data_size, "prif_size_bytes is valid")

    call prif_lcobound_no_dim(coarray_handle, tmp_bounds)
    ALSO2(.all. (tmp_bounds .equalsExpected. lcobounds), "prif_lcobound_no_dim is valid")

    call prif_ucobound_no_dim(coarray_handle, tmp_bounds)
    ALSO2(.all. (tmp_bounds .equalsExpected. ucobounds), "prif_ucobound_no_dim is valid")

    do i = 1, corank
      call prif_lcobound_with_dim(coarray_handle, i, tmp_bound)
      ALSO2(tmp_bound .equalsExpected. lcobounds(i), "prif_lcobound_with_dim is valid")

      call prif_ucobound_with_dim(coarray_handle, i, tmp_bound)
      ALSO2(tmp_bound .equalsExpected. ucobounds(i), "prif_ucobound_with_dim is valid")
    end do

    call prif_coshape(coarray_handle, sizes)
    ALSO2(.all. ((ucobounds - lcobounds + 1) .equalsExpected. sizes), "prif_coshape is valid")

    call prif_deallocate_coarray(coarray_handle)
  end function

  function check_cobounds() result(diag)
    type(test_diagnosis_t) :: diag
    integer(c_int) :: corank

    diag = .true.

    ALSO(.all. check_cobound([(corank, corank = 1_c_int, 15_c_int)], .false.))
    ALSO(.all. check_cobound([(corank, corank = 1_c_int, 15_c_int)], .true.))
  end function

end module prif_coarray_inquiry_test_m
