test_get_attribute_vector Subroutine

public subroutine test_get_attribute_vector()

Arguments

None

Calls

proc~~test_get_attribute_vector~~CallsGraph proc~test_get_attribute_vector test_get_attribute_vector anyexceptions anyexceptions proc~test_get_attribute_vector->anyexceptions assertall assertall proc~test_get_attribute_vector->assertall assertequal assertequal proc~test_get_attribute_vector->assertequal asserttrue asserttrue proc~test_get_attribute_vector->asserttrue none~add_attribute~3 FileMetadata%add_attribute proc~test_get_attribute_vector->none~add_attribute~3 none~get_attribute~2 FileMetadata%get_attribute proc~test_get_attribute_vector->none~get_attribute~2 none~get_shape UnlimitedEntity%get_shape proc~test_get_attribute_vector->none~get_shape none~get_values UnlimitedEntity%get_values proc~test_get_attribute_vector->none~get_values none~add_attribute_0d~2 FileMetadata%add_attribute_0d none~add_attribute~3->none~add_attribute_0d~2 none~add_attribute_1d~2 FileMetadata%add_attribute_1d none~add_attribute~3->none~add_attribute_1d~2 interface~mapl_assert MAPL_Assert none~get_attribute~2->interface~mapl_assert none~get_attribute Variable%get_attribute none~get_attribute~2->none~get_attribute proc~mapl_return MAPL_Return none~get_attribute~2->proc~mapl_return none~get_shape->proc~mapl_return none~get_values->proc~mapl_return none~add_attribute_0d~2->proc~mapl_return none~add_attribute~2 Variable%add_attribute none~add_attribute_0d~2->none~add_attribute~2 none~add_attribute_1d~2->proc~mapl_return none~add_attribute_1d~2->none~add_attribute~2 none~get_attribute->interface~mapl_assert none~get_attribute->proc~mapl_return none~at~140 StringAttributeMap%at none~get_attribute->none~at~140 at at proc~mapl_return->at insert insert proc~mapl_return->insert proc~mapl_throw_exception MAPL_throw_exception proc~mapl_return->proc~mapl_throw_exception none~add_attribute_1d Variable%add_attribute_1d none~add_attribute~2->none~add_attribute_1d none~find~39 StringAttributeMap%find none~at~140->none~find~39

Source Code

   subroutine test_get_attribute_vector()
      type (FileMetadata), target :: cf

      integer(INT32) :: i32(2) = [3,4]
      integer(INT64) :: i64(3) = [5,6,7]
      real(REAL32) :: x32(3) = 1.234
      real(REAL64) :: x64(2) = 2.345_REAL64
      logical :: flag(2) = [.true.,.false.]

      type (Attribute), pointer :: attr
      
      call cf%add_attribute('i32', i32)
      call cf%add_attribute('i64', i64)
      call cf%add_attribute('x32', x32)
      call cf%add_attribute('x64', x64)
      call cf%add_attribute('flag', flag)

      call check_has_attr('i32')
      if (anyexceptions()) return
      call check_has_attr('i64')
      if (anyexceptions()) return
      call check_has_attr('x32')
      if (anyexceptions()) return
      call check_has_attr('x64')
      if (anyexceptions()) return
      call check_has_attr('flag')
      if (anyexceptions()) return

      call check_shape('i32', i32)
      if (anyexceptions()) return
      call check_shape('i64', i64)
      if (anyexceptions()) return
      call check_shape('x32', x32)
      if (anyexceptions()) return
      call check_shape('x64', x64)
      if (anyexceptions()) return
      call check_shape('flag', flag)
      if (anyexceptions()) return
      
      call check_equal('i32', i32)
      if (anyexceptions()) return
      call check_equal('i64', i64)
      if (anyexceptions()) return
      call check_equal('x32', x32)
      if (anyexceptions()) return
      call check_equal('x64', x64)
      if (anyexceptions()) return
      call check_equal('flag', flag)
      if (anyexceptions()) return


   contains

      subroutine check_has_attr(attr_name)
         character(len=*), intent(in) :: attr_name
         attr => cf%get_attribute(attr_name)
         @assertTrue(associated(attr))
      end subroutine check_has_attr

      subroutine check_shape(attr_name, values)
         character(len=*), intent(in) :: attr_name
         class (*), intent(in) :: values(:)
         
         attr => cf%get_attribute(attr_name)
         @assertEqual(attr%get_shape(), shape(values))
      end subroutine check_shape

      subroutine check_equal(attr_name, expected)
         character(len=*), intent(in) :: attr_name
         class (*), intent(in) :: expected(:)

         class (*), pointer :: found(:)
         
         attr => cf%get_attribute(attr_name)
         found => attr%get_values()

         select type (expected)
         type is (integer(INT32))
            select type (found)
            type is (integer(INT32))
               @assertEqual(expected, found)
            class default
               @assertTrue(1==2, 'incorrect type ' // attr_name)
            end select
         type is (integer(INT64))
            select type (found)
            type is (integer(INT64))
               @assertEqual(expected, found)
            class default
               @assertTrue(1==2, 'incorrect type ' // attr_name)
            end select
         type is (real(REAL32))
            select type (found)
            type is (real(REAL32))
               @assertEqual(expected, found)
            class default
               @assertTrue(1==2, 'incorrect type ' // attr_name)
            end select
         type is (real(REAL64))
            select type (found)
            type is (real(REAL64))
               @assertEqual(expected, found)
            class default
               @assertTrue(1==2, 'incorrect type ' // attr_name)
            end select
         type is (logical)
            select type (found)
            type is (logical)
               @assertAll(expected .eqv. found)
            class default
               @assertTrue(1==2, 'incorrect type ' // attr_name)
            end select
         end select

      end subroutine check_equal



   end subroutine test_get_attribute_vector