Add unit tests for tensor interrogation

examples/6_Autograd/autograd.f90

@@ -39,16 +39,6 @@ program example
   call torch_tensor_from_array(a, in_data1, tensor_layout, torch_kCPU)
   call torch_tensor_from_array(b, in_data2, tensor_layout, torch_kCPU)
 
-  ! check tensor rank and shape match those of in_data
-  if ((a%get_rank() /= 2) .or. (b%get_rank() /= 2)) then
-    print *, "Error :: rank should be 2"
-    stop 1
-  end if
-  if (any(a%get_shape() /= [n, m]) .or. any(b%get_shape() /= [n, m])) then
-    write(6,"('Error :: shape should be (',i1,', ',i1,')')") n, m
-    stop 1
-  end if
-
   ! Check arithmetic operations work for torch_tensors
   write (*,*) "a = ", in_data1(:,1)
   write (*,*) "b = ", in_data2(:,1)

run_test_suite.sh

@@ -18,19 +18,25 @@ show_help() {
   echo
   echo "Options:"
   echo "  BUILD_DIR=<build_dir> Specify the build directory (default: src/build)."
-  echo "  --verbose | -V        Run with verbose ctest output."
-  echo "  --help | -h           Show this help message and exit."
+  echo "  --unit-only | -u        Run unit tests only."
+  echo "  --verbose   | -V        Run with verbose ctest output."
+  echo "  --help      | -h        Show this help message and exit."
 }
 
 # Parse command line arguments
 BUILD_DIR="src/build"
+UNIT_ONLY=false
 VERBOSE=false
 HELP=false
 for ARG in "$@"; do
   case ${ARG} in
   BUILD_DIR=*)
     BUILD_DIR="${ARG#*=}"
     ;;
+  --unit-only | -u)
+    UNIT_ONLY=true
+    shift
+    ;;
   --verbose | -V)
     VERBOSE=true
     shift
@@ -66,10 +72,12 @@ ctest "${CTEST_ARGS}"
 cd -
 
 # Run integration tests
-EXAMPLES="1_SimpleNet 2_ResNet18 4_MultiIO 6_Autograd"
-for EXAMPLE in ${EXAMPLES}; do
-  pip -q install -r examples/"${EXAMPLE}"/requirements.txt
-  cd "${BUILD_DIR}"/test/examples/"${EXAMPLE}"
-  ctest "${CTEST_ARGS}"
-  cd -
-done
+if [ "${UNIT_ONLY}" = false ]; then
+  EXAMPLES="1_SimpleNet 2_ResNet18 4_MultiIO 6_Autograd"
+  for EXAMPLE in ${EXAMPLES}; do
+    pip -q install -r examples/"${EXAMPLE}"/requirements.txt
+    cd "${BUILD_DIR}"/test/examples/"${EXAMPLE}"
+    ctest "${CTEST_ARGS}"
+    cd -
+  done
+fi

src/test/unit/CMakeLists.txt

@@ -10,5 +10,19 @@ find_package(PFUNIT REQUIRED)
 
 add_pfunit_ctest(test_constructors
   TEST_SOURCES test_constructors.pf LINK_LIBRARIES FTorch::ftorch)
+add_pfunit_ctest(test_tensor_interrogation
+  TEST_SOURCES test_tensor_interrogation.pf LINK_LIBRARIES FTorch::ftorch)
 add_pfunit_ctest(test_operator_overloads
   TEST_SOURCES test_tensor_operator_overloads.pf LINK_LIBRARIES FTorch::ftorch)
+
+if(ENABLE_CUDA)
+  check_language(CUDA)
+  if(CMAKE_CUDA_COMPILER)
+    enable_language(CUDA)
+  else()
+    message(ERROR "No CUDA support")
+  endif()
+  add_pfunit_ctest(test_tensor_interrogation_cuda
+    TEST_SOURCES test_tensor_interrogation_cuda.pf
+    LINK_LIBRARIES FTorch::ftorch)
+endif()

src/test/unit/test_tensor_interrogation.pf

@@ -0,0 +1,180 @@
+!| Unit tests for FTorch subroutines that interrogate tensors on the CPU.
+!
+!  * License
+!    FTorch is released under an MIT license.
+!    See the [LICENSE](https://github.com/Cambridge-ICCS/FTorch/blob/main/LICENSE)
+!    file for details.
+module test_tensor_interrogation
+  use funit
+  use ftorch, only: torch_kFloat32, torch_kCPU, torch_tensor, torch_tensor_delete, &
+                    torch_tensor_empty
+  use iso_c_binding, only: c_int64_t
+
+  implicit none
+
+  public
+
+  ! Parameters common across all test cases
+  integer, parameter :: device_type = torch_kCPU
+
+contains
+
+  ! Unit test for the torch_tensor_get_device_index function applied to a tensor on the CPU
+  @test
+  subroutine test_torch_tensor_get_device_index_default()
+    use ftorch, only: torch_tensor_get_device_index
+
+    implicit none
+
+    type(torch_tensor) :: tensor
+    integer, parameter :: ndims = 1
+    integer(c_int64_t), parameter, dimension(ndims) :: tensor_shape = [1]
+    integer, parameter :: dtype = torch_kFloat32
+    integer, parameter :: expected = -1
+
+    ! Create an empty tensor on the CPU with the default device index
+    call torch_tensor_empty(tensor, ndims, tensor_shape, dtype, device_type)
+
+    ! Check that torch_tensor_get_device_index can get the device index
+    if (expected /= torch_tensor_get_device_index(tensor)) then
+      call torch_tensor_delete(tensor)
+      print *, "Error :: torch_tensor_get_device_index returned incorrect CPU device index"
+      stop 999
+    end if
+    call torch_tensor_delete(tensor)
+
+  end subroutine test_torch_tensor_get_device_index_default
+
+  ! Unit test for the get_rank method of a 1D tensor
+  @test
+  subroutine test_get_rank_1D()
+
+    implicit none
+
+    type(torch_tensor) :: tensor
+    integer, parameter :: ndims = 1
+    integer(kind=c_int64_t), parameter :: tensor_shape(ndims) = [6]
+    integer, parameter :: dtype = torch_kFloat32
+
+    ! Create a tensor with uninitialised values and check get_rank can correctly identify its rank
+    call torch_tensor_empty(tensor, ndims, tensor_shape, dtype, device_type)
+    if (ndims /= tensor%get_rank()) then
+      call torch_tensor_delete(tensor)
+      print *, "Error :: get_rank returned incorrect rank for 1D tensor"
+      stop 999
+    end if
+    call torch_tensor_delete(tensor)
+
+  end subroutine test_get_rank_1D
+
+  ! Unit test for the get_rank method of a 2D tensor
+  @test
+  subroutine test_get_rank_2D()
+
+    implicit none
+
+    type(torch_tensor) :: tensor
+    integer, parameter :: ndims = 2
+    integer(kind=c_int64_t), parameter :: tensor_shape(ndims) = [2,3]
+    integer, parameter :: dtype = torch_kFloat32
+
+    ! Create a tensor with uninitialised values and check get_rank can correctly identify its rank
+    call torch_tensor_empty(tensor, ndims, tensor_shape, dtype, device_type)
+    if (ndims /= tensor%get_rank()) then
+      call torch_tensor_delete(tensor)
+      print *, "Error :: get_rank returned incorrect rank for 2D tensor"
+      stop 999
+    end if
+    call torch_tensor_delete(tensor)
+
+  end subroutine test_get_rank_2D
+
+  ! Unit test for the get_rank method of a 3D tensor
+  @test
+  subroutine test_get_rank_3D()
+
+    implicit none
+
+    type(torch_tensor) :: tensor
+    integer, parameter :: ndims = 3
+    integer(kind=c_int64_t), parameter :: tensor_shape(ndims) = [1,2,3]
+    integer, parameter :: dtype = torch_kFloat32
+
+    ! Create a tensor with uninitialised values and check get_rank can correctly identify its rank
+    call torch_tensor_empty(tensor, ndims, tensor_shape, dtype, device_type)
+    if (ndims /= tensor%get_rank()) then
+      call torch_tensor_delete(tensor)
+      print *, "Error :: get_rank returned incorrect rank for 3D tensor"
+      stop 999
+    end if
+    call torch_tensor_delete(tensor)
+
+  end subroutine test_get_rank_3D
+
+  ! Unit test for the get_shape method of a 1D tensor
+  @test
+  subroutine test_get_shape_1D()
+
+    implicit none
+
+    type(torch_tensor) :: tensor
+    integer, parameter :: ndims = 1
+    integer(kind=c_int64_t), parameter :: tensor_shape(ndims) = [6]
+    integer, parameter :: dtype = torch_kFloat32
+
+    ! Create a tensor with uninitialised values and check get_shape can correctly identify its shape
+    call torch_tensor_empty(tensor, ndims, tensor_shape, dtype, device_type)
+    if (.not. all(tensor_shape == tensor%get_shape())) then
+      call torch_tensor_delete(tensor)
+      print *, "Error :: get_rank returned incorrect shape for 1D tensor"
+      stop 999
+    end if
+    call torch_tensor_delete(tensor)
+
+  end subroutine test_get_shape_1D
+
+  ! Unit test for the get_shape method of a 2D tensor
+  @test
+  subroutine test_get_shape_2D()
+
+    implicit none
+
+    type(torch_tensor) :: tensor
+    integer, parameter :: ndims = 2
+    integer(kind=c_int64_t), parameter :: tensor_shape(ndims) = [2, 3]
+    integer, parameter :: dtype = torch_kFloat32
+
+    ! Create a tensor with uninitialised values and check get_shape can correctly identify its shape
+    call torch_tensor_empty(tensor, ndims, tensor_shape, dtype, device_type)
+    if (.not. all(tensor_shape == tensor%get_shape())) then
+      call torch_tensor_delete(tensor)
+      print *, "Error :: get_rank returned incorrect shape for 2D tensor"
+      stop 999
+    end if
+    call torch_tensor_delete(tensor)
+
+  end subroutine test_get_shape_2D
+
+  ! Unit test for the get_shape method of a 3D tensor
+  @test
+  subroutine test_get_shape_3D()
+
+    implicit none
+
+    type(torch_tensor) :: tensor
+    integer, parameter :: ndims = 3
+    integer(kind=c_int64_t), parameter :: tensor_shape(ndims) = [1, 2, 3]
+    integer, parameter :: dtype = torch_kFloat32
+
+    ! Create a tensor with uninitialised values and check get_shape can correctly identify its shape
+    call torch_tensor_empty(tensor, ndims, tensor_shape, dtype, device_type)
+    if (.not. all(tensor_shape == tensor%get_shape())) then
+      call torch_tensor_delete(tensor)
+      print *, "Error :: get_rank returned incorrect shape for 3D tensor"
+      stop 999
+    end if
+    call torch_tensor_delete(tensor)
+
+  end subroutine test_get_shape_3D
+
+end module test_tensor_interrogation

src/test/unit/test_tensor_interrogation_cuda.pf

@@ -0,0 +1,45 @@
+!| Unit tests for FTorch subroutines that interrogate tensors on a CUDA device.
+!
+!  * License
+!    FTorch is released under an MIT license.
+!    See the [LICENSE](https://github.com/Cambridge-ICCS/FTorch/blob/main/LICENSE)
+!    file for details.
+module test_tensor_interrogation_cuda
+
+  implicit none
+
+  public
+
+contains
+
+  ! Unit test for the torch_tensor_get_device_index function applied to a tensor on a CUDA device
+  @test
+  subroutine test_torch_tensor_get_device_index_default()
+    use funit
+    use ftorch, only: torch_kFloat32, torch_kCUDA, torch_tensor, torch_tensor_delete, &
+                      torch_tensor_empty, torch_tensor_get_device_index
+    use iso_c_binding, only: c_int64_t
+
+    implicit none
+
+    type(torch_tensor) :: tensor
+    integer, parameter :: ndims = 1
+    integer(c_int64_t), parameter, dimension(ndims) :: tensor_shape = [1]
+    integer, parameter :: dtype = torch_kFloat32
+    integer, parameter :: device_type = torch_kCUDA
+    integer, parameter :: expected = 0
+
+    ! Create an empty tensor on the CPU with the default device index
+    call torch_tensor_empty(tensor, ndims, tensor_shape, dtype, device_type)
+
+    ! Check that torch_tensor_get_device_index can get the device index
+    if (expected /= torch_tensor_get_device_index(tensor)) then
+      call torch_tensor_delete(tensor)
+      print *, "Error :: torch_tensor_get_device_index returned incorrect CUDA device index"
+      stop 999
+    end if
+    call torch_tensor_delete(tensor)
+
+  end subroutine test_torch_tensor_get_device_index_default
+
+end module test_tensor_interrogation_cuda