B.1.19 Status Class Unit Test Program

This lightly commented program performs a unit test on the Status Class.

program Unit_Test

  use Caesar_Status_Class
  implicit none

  type(integer), parameter :: NStats=12
  type(Status_type), dimension(NStats) :: Status
  type(Status_type) :: Final_Status
  type(character,36) :: status_string
  type(integer) :: i, j

  ! Initialize status.

  call Initialize (Status)
  call Initialize (Final_Status)

  ! Check state of status.

  VERIFY(Valid_State(Status),0)
  VERIFY(Valid_State(Final_Status),0)

  ! Testing statements.

  Status(2)  = 'Memory Error'
  Status(3)  = 'Memory Error'
  Status(4)  = 'Success'
  Status(5)  = 'Memory Warning'
  Status(6)  = 'Unset'
  Status(7)  = 'Success'
  Status(8)  = 'Memory Warning'
  Status(9)  = 'Multiple Warning'
  Status(10) = 'Success'
  Status(11) = 'Multiple Error'
  Status(12) = 'Multiple Warning'

  write (6,101) 'Assignment tests:'

  do i = 1, NStats
    if (Error(Status(i))) write (6,100,advance='no') 'Error: '
    if (Warning(Status(i))) write (6,100,advance='no') 'Warning: '
    if (Normal(Status(i))) write (6,100,advance='no') 'Normal: '
    status_string = Status(i)
    write (6,*) status_string
  end do

  write (6,101) 'Consolidation tests:'

  do i = 1, NStats
    do j = i, NStats
      Final_Status = Status(i:j)
      if (Error(Final_Status)) write (6,100,advance='no') 'Error: '
      if (Warning(Final_Status)) write (6,100,advance='no') 'Warning: '
      if (Normal(Final_Status)) write (6,100,advance='no') 'Normal: '
      status_string = Final_Status
      write (6,*) status_string
    end do
    write (6,*) 
  end do

  ! Format statement.

  100 format (a)
  101 format (/,a,/)

  ! Check state of status.

  VERIFY(Valid_State(Status),0)
  VERIFY(Valid_State(Final_Status),0)

  ! Finalize status.

  call Finalize (Status)
  call Finalize (Final_Status)

end