! $Id$
!
! Earth System Modeling Framework
! Copyright (c) 2002-2024, University Corporation for Atmospheric Research,
! Massachusetts Institute of Technology, Geophysical Fluid Dynamics
! Laboratory, University of Michigan, National Centers for Environmental
! Prediction, Los Alamos National Laboratory, Argonne National Laboratory,
! NASA Goddard Space Flight Center.
! Licensed under the University of Illinois-NCSA License.
!
!==============================================================================
!
      program ESMF_BaseUTest

!------------------------------------------------------------------------------
! INCLUDES
#include "ESMF.h"
!
!==============================================================================
!BOP
! !PROGRAM: ESMF_BaseUTest - One line general statement about this test
!
! !DESCRIPTION:
!
! The code in this file drives F90 Base unit tests.
!
!-----------------------------------------------------------------------------
! !USES:
      use ESMF_TestMod     ! test methods
      use ESMF         ! the ESMF Framework
      use ESMF_BaseMod, only: ESMF_BaseDeserializeIDVMId
      implicit none

!------------------------------------------------------------------------------
! The following line turns the CVS identifier string into a printable variable.
      character(*), parameter :: version = &
      '$Id$'
!------------------------------------------------------------------------------

      ! cumulative result: count failures; no failures equals "all pass"
      integer :: result = 0

      ! individual test result code
      integer :: rc

      ! individual test name
      character(ESMF_MAXSTR) :: name

      ! individual test failure messages
      character(ESMF_MAXSTR*2) :: failMsg

      ! local variables needed to pass into function/subroutine calls
      !type(ESMF_BaseConfig) :: config_set
      !type(ESMF_BaseConfig) :: config_get

      ! instantiate a Base 
      type(ESMF_Base) :: base

#ifdef ESMF_TESTEXHAUSTIVE
      character(ESMF_MAXSTR) :: print_options
      character(ESMF_MAXSTR) :: validate_options
      character(ESMF_MAXSTR) :: name_set, name_get
      character(ESMF_MAXSTR) :: obj_name
      ! instantiate a Base 
      type(ESMF_Base) :: base1, base2
      type(ESMF_AttReconcileFlag) :: attreconflag
      integer :: id, id_inq
      type(ESMF_VMId) :: vmid, vmid_inq, vmid_new, vmid_new2
      character, allocatable   :: buffer(:)
      integer :: buff_size
      integer :: offset1, offset2, offset3
      logical :: tf
#endif

!-------------------------------------------------------------------------------
!  The unit tests are divided into Sanity and Exhaustive. The Sanity tests are
!  always run. When the environment variable, EXHAUSTIVE, is set to ON then
!  the EXHAUSTIVE and sanity tests both run. If the EXHAUSTIVE variable is set
!  to OFF, then only the sanity unit tests.
!  Special strings (Non-exhaustive and exhaustive) have been
!  added to allow a script to count the number and types of unit tests.
!-------------------------------------------------------------------------------

      call ESMF_TestStart(ESMF_SRCLINE, rc=rc)
      if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)


      !NEX_UTest
      ! test creation of base objects
      call ESMF_BaseCreate(base, "Base", "test object", 0, rc=rc)
      write(name, *) "ESMF_BaseCreate"
      write(failMsg, *) "rc =", rc
      call ESMF_Test((rc.eq.ESMF_SUCCESS), &
                      name, failMsg, result, ESMF_SRCLINE)

                      
      !NEX_UTest
      ! destroy base object
      call ESMF_BaseDestroy(base, rc=rc)
      write(name, *) "ESMF_Destroy"
      write(failMsg, *) "rc =", rc
      call ESMF_Test((rc.eq.ESMF_SUCCESS), &
                      name, failMsg, result, ESMF_SRCLINE)
      

#ifdef ESMF_TESTEXHAUSTIVE

                      
      !EX_UTest
      ! destroy base object
      call ESMF_BaseDestroy(base, rc=rc)
      write(name, *) "Destroy a destroyed Base"
      write(failMsg, *) "Did not return ESMF_RC_OBJ_DELETED"
      call ESMF_Test((rc.eq.ESMF_RC_OBJ_DELETED), &
                      name, failMsg, result, ESMF_SRCLINE)
      
                      
      !EX_UTest
      ! destroy base object
      call ESMF_BaseDestroy(base1, rc=rc)
      write(name, *) "Destroy a non-created Base"
      write(failMsg, *) "Did not return ESMF_RC_OBJ_NOT_CREATED"
      call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), &
                      name, failMsg, result, ESMF_SRCLINE)


      !EX_UTest
      ! test print method of deleted base via option string
      print_options = "brief"
      call ESMF_BasePrint(base, print_options, rc=rc)
      write(name, *) "ESMF_BasePrint of deleted Base"
      write(failMsg, *) "Did not return ESMF_RC_OBJ_DELETED"
      call ESMF_Test((rc.eq.ESMF_RC_OBJ_DELETED), &
                      name, failMsg, result, ESMF_SRCLINE)


      !EX_UTest
      ! test print method of non-created base via option string
      print_options = "brief"
      call ESMF_BasePrint(base1, print_options, rc=rc)
      write(name, *) "ESMF_BasePrint of non-created Base"
      write(failMsg, *) "Did not return ESMF_RC_OBJ_NOT_CREATED"
      call ESMF_Test((rc.eq.ESMF_RC_OBJ_NOT_CREATED), &
                      name, failMsg, result, ESMF_SRCLINE)

      !EX_UTest
      ! test setting of ESMF_Base members values of uncreated Base
      ! Note That this will recreate the base
      name_set = "fred"
      call ESMF_SetName(base1, name_set, "Base", rc=rc)
      write(name, *) "ESMF_SetName of non-created Base"
      write(failMsg, *) "Did not return ESMF_SUCCESS"
      call ESMF_Test((rc.eq.ESMF_SUCCESS), &
                      name, failMsg, result, ESMF_SRCLINE)


      !EX_UTest
      ! test setting of ESMF_Base members values of deleted Base
      ! Note That this will recreate the base
      name_set = "fred"
      call ESMF_SetName(base, name_set, "Base", rc=rc)
      write(name, *) "ESMF_SetName of deleted Base"
      write(failMsg, *) "Did not return ESMF_SUCCESS"
      call ESMF_Test((rc.eq.ESMF_SUCCESS), &
                      name, failMsg, result, ESMF_SRCLINE)


      ! destroy base objects created by ESMF_SetName
      call ESMF_BaseDestroy(base, rc=rc)
      call ESMF_BaseDestroy(base1, rc=rc)


      
      !EX_UTest
      ! test creation of base objects with slash in its name
      call ESMF_BaseCreate(base, "Base", "test/object", 0, rc=rc)
      write(name, *) "ESMF_BaseCreate with slash in name"
      write(failMsg, *) "rc =", rc
      call ESMF_Test((rc /= ESMF_SUCCESS), &
                      name, failMsg, result, ESMF_SRCLINE)
      
      !EX_UTest
      ! test creation of base objects
      call ESMF_BaseCreate(base, "Base", "test object", 0, rc=rc)
      write(name, *) "ESMF_BaseCreate"
      write(failMsg, *) "rc =", rc
      call ESMF_Test((rc.eq.ESMF_SUCCESS), &
                      name, failMsg, result, ESMF_SRCLINE)


      !EX_UTest
      ! test setting of ESMF_Base members values with slash in its name
      name_set = "fred/jones"
      call ESMF_SetName(base, name_set, "Base", rc=rc)
      write(name, *) "ESMF_SetName with slash in its name"
      write(failMsg, *) "rc =", rc, ", name =", trim(name_set)
      call ESMF_Test((rc /= ESMF_SUCCESS), &
                      name, failMsg, result, ESMF_SRCLINE)

      !EX_UTest
      ! test setting of ESMF_Base members values
      name_set = "fred"
      call ESMF_SetName(base, name_set, "Base", rc=rc)
      write(name, *) "ESMF_SetName"
      write(failMsg, *) "rc =", rc, ", name =", trim(name_set)
      call ESMF_Test((rc.eq.ESMF_SUCCESS), &
                      name, failMsg, result, ESMF_SRCLINE)

      !EX_UTest
      ! test getting of ESMF_Base members values,
      !   compare to values set previously
      call ESMF_GetName(base, name_get, rc=rc)
      write(name, *) "ESMF_GetName"
      write(failMsg, *) "rc =", rc, ", name =", name_get
      call ESMF_Test((rc.eq.ESMF_SUCCESS .and. name_get .eq. name_set), &
                      name, failMsg, result, ESMF_SRCLINE)
    
      !EX_UTest
      ! test validate method via option string
      validate_options = ''
      call ESMF_BaseValidate(base, validate_options, rc=rc)
      write(name, *) "ESMF_BaseValidate"
      write(failMsg, *) "rc =",rc,", validate_options =", trim(validate_options)
      call ESMF_Test((rc.eq.ESMF_SUCCESS), &
                      name, failMsg, result, ESMF_SRCLINE)

      !EX_UTest
      ! test getting of ESMF_Base members values,
      id = -1
      call ESMF_BaseGetId (base, id, rc=rc)
      write(name, *) "ESMF_BaseGetID"
      write(failMsg, *) "rc =", rc
      call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
      print *, 'id =', id

      !EX_UTest
      ! test getting of ESMF_Base members values,
      call ESMF_BaseGetVMId (base, vmid, rc=rc)
      write(name, *) "ESMF_BaseGetVMId of original Base"
      write(failMsg, *) "rc =", rc
      call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

      !EX_UTest
      ! test setting of ESMF_Base members values,
      call ESMF_VMIdCreate (vmid_new, rc=rc)
      call c_ESMCI_VMIdSet (vmid_new, 1234, achar (123), rc)
      call ESMF_BaseSetVMId (base, vmid_new, rc=rc)
      write(name, *) "ESMF_BaseSetVMId a new VMId into the Base"
      write(failMsg, *) "rc =", rc
      call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
      call ESMF_BasePrint (base)

      !EX_UTest
      ! test getting of ESMF_Base members values,
      call ESMF_BaseGetVMId (base, vmid_new2, rc=rc)
      write(name, *) "ESMF_BaseGetVMId new VMid"
      write(failMsg, *) "rc =", rc
      call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

      !EX_UTest
      ! test resetting of ESMF_Base members values,
      call ESMF_BaseSetVMId (base, vmid, rc=rc)
      write(name, *) "ESMF_BaseSetVMId reset the original VMId into the Base"
      write(failMsg, *) "rc =", rc
      call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
      call ESMF_BasePrint (base)

      !EX_UTest
      ! test print method via option string
      print_options = "brief"
      call ESMF_BasePrint(base, print_options, rc=rc)
      write(name, *) "ESMF_BasePrint brief"
      write(failMsg, *) "rc =", rc, ", print_options =", trim(print_options)
      call ESMF_Test((rc.eq.ESMF_SUCCESS), &
                      name, failMsg, result, ESMF_SRCLINE)

      !EX_UTest
      ! test print method via option string
      print_options = "debug"
      call ESMF_BasePrint(base, print_options, rc=rc)
      write(name, *) "ESMF_BasePrint debug"
      write(failMsg, *) "rc =", rc, ", print_options =", trim(print_options)
      call ESMF_Test((rc.eq.ESMF_SUCCESS), &
                      name, failMsg, result, ESMF_SRCLINE)

      ! BEGIN tests of certain INTERNAL methods.  They are subject
      ! to change and are NOT part of the ESMF user API.

      !EX_UTest
      ! test the serialize inquire-only option
      ! WARNING: This is testing an INTERNAL method.  It is NOT
      ! part of the supported ESMF user API!

      ! NOTE (bekozi): Changed this flag to ON when adding Info-JSON interface.
      attreconflag = ESMF_ATTRECONCILE_ON

      buff_size = 1
      allocate (buffer(buff_size))
      offset1 = 0
      call ESMF_BaseSerialize (base, buffer, offset1, &
          attreconflag, ESMF_INQUIREONLY, rc=rc)
      write(name, *) "ESMF_BaseSerialize - inquire only option"
      write(failMsg, *) "rc =", rc, ", offset =", offset1
      call ESMF_Test((rc == ESMF_SUCCESS), &
                      name, failMsg, result, ESMF_SRCLINE)
      print *, '  offset returned =', offset1, ' bytes'
      deallocate (buffer)

      !EX_UTest
      ! test doing a serialize for real.
      ! WARNING: This is testing an INTERNAL method.  It is NOT
      ! part of the supported ESMF user API!
      buff_size = offset1 ! from previous inquiry
      allocate (buffer(buff_size))
      buffer = char (66)
      offset2 = 0
      call ESMF_BaseSerialize (base, buffer, offset2, &
          attreconflag, ESMF_NOINQUIRE, rc=rc)
      write(name, *) "ESMF_BaseSerialize - perform serialization"
      write(failMsg, *) "rc =", rc, ", offset =", offset2
      call ESMF_Test((rc == ESMF_SUCCESS), &
                      name, failMsg, result, ESMF_SRCLINE)
      print *, '  offset returned =', offset2, ' bytes'

      !EX_UTest
      ! Compare inquired size with actual size.  Note that the two
      ! sizes will not be equal because the inquire option currently
      ! overestimates the space needed - which is ok.
      ! WARNING: This is testing an INTERNAL method.  It is NOT
      ! part of the supported ESMF user API!
      write(name, *) "Compare calculated buffer size with actual size"
      write(failMsg, *) 'actual offset', offset2, ' > inquire offset', offset1
      call ESMF_Test(offset1 >= offset2, &
                      name, failMsg, result, ESMF_SRCLINE)

      ! print '(25z3)', iachar (buffer)

      !EX_UTest
      ! test doing a deserialize for real.
      ! WARNING: This is testing an INTERNAL method.  It is NOT
      ! part of the supported ESMF user API!
      offset3 = 0
      base2 = ESMF_BaseDeserialize (buffer, offset3, &
          attreconflag, rc=rc)
      write(name, *) "ESMF_BaseDeserialize - perform deserialization"
      write(failMsg, *) "rc =", rc, ", offset =", offset3
      call ESMF_Test((rc == ESMF_SUCCESS), &
                      name, failMsg, result, ESMF_SRCLINE)

      !EX_UTest
      ! Compare calculated serialed offset with actual deserialed offset.
      ! WARNING: This is testing an INTERNAL method.  It is NOT
      ! part of the supported ESMF user API!
      write(name, *) "Compare serialize/deserialize offsets"
      write(failMsg, *) 'offset', offset2, ' /=', offset3
      call ESMF_Test(offset2 == offset3, &
                      name, failMsg, result, ESMF_SRCLINE)

      !EX_UTest
      ! Create VMId for inquiry
      ! WARNING: This is testing an INTERNAL method.  It is NOT
      ! part of the supported ESMF user API!
      call ESMF_VMIdCreate (vmid_inq, rc=rc)
      write(name, *) "Creating VMId for inquiry"
      write(failMsg, *) "rc =", rc
      call ESMF_Test((rc == ESMF_SUCCESS), &
                      name, failMsg, result, ESMF_SRCLINE)

      !EX_UTest
      ! Test ID/VMId inquiry in a serialized buffer
      ! WARNING: This is testing an INTERNAL method.  It is NOT
      ! part of the supported ESMF user API!
      offset3 = 0
      call ESMF_BaseDeserializeIDVMId (buffer, offset3, &
          id_inq, vmid_inq, obj_name, rc=rc)
      write(name, *) "ESMF_BaseDeserializeID/VMId - perform deserialization inquiry"
      write(failMsg, *) "rc =", rc
      call ESMF_Test((rc == ESMF_SUCCESS), &
                      name, failMsg, result, ESMF_SRCLINE)
      ! print *, 'After deserialization inquiry, obj_name: ', trim (obj_name)

      !EX_UTest
      ! Compare original vs inquired ids.
      ! WARNING: This is testing an INTERNAL method.  It is NOT
      ! part of the supported ESMF user API!
      write(name, *) "Compare original vs inquired ids"
      write(failMsg, *) 'id', id, '/=', id_inq
      call ESMF_Test(id == id_inq, &
                      name, failMsg, result, ESMF_SRCLINE)

      !EX_UTest
      ! Compare original vs inquired VMId inquiry.
      ! WARNING: This is testing an INTERNAL method.  It is NOT
      ! part of the supported ESMF user API!
      write(name, *) "Compare original vs inquired VMId inquiry"
      write(failMsg, *) 'VMIds do not compare'
#if 0
      print *, 'original vmid:'
      call ESMF_VMIdPrint (vmid)
      print *, 'deserialized/inquiry vmid:'
      call ESMF_VMIdPrint (vmid_inq)
#endif
      tf = ESMF_VMIdCompare (vmid, vmid_inq, rc=rc)
      call ESMF_Test((rc == ESMF_SUCCESS), &
                      name, failMsg, result, ESMF_SRCLINE)

      !EX_UTest
      ! Compare original vs inquired VMIds.
      ! WARNING: This is testing an INTERNAL method.  It is NOT
      ! part of the supported ESMF user API!
      write(name, *) "Compare original vs inquired VMIds"
      write(failMsg, *) 'VMIds do not compare'
      rc = merge (ESMF_SUCCESS, ESMF_FAILURE, tf)
      call ESMF_Test((rc == ESMF_SUCCESS), &
                      name, failMsg, result, ESMF_SRCLINE)

      call ESMF_VMIdDestroy (vmid_new, rc=rc)
      call ESMF_VMIdDestroy (vmid_inq, rc=rc)

      ! END of tests of INTERNAL methods.

      ! return number of failures to environment; 0 = success (all pass)
      ! return result  ! TODO: no way to do this in F90 ?

      !EX_UTest
      ! destroy base object
      call ESMF_BaseDestroy(base, rc=rc)
      write(name, *) "ESMF_Destroy"
      write(failMsg, *) "rc =", rc
      call ESMF_Test((rc.eq.ESMF_SUCCESS), &
                      name, failMsg, result, ESMF_SRCLINE)

      deallocate (buffer)

#endif

      ! This calls finalize before returning, so it must be the last
      ! ESMF-related thing the test does.
      call ESMF_TestEnd(ESMF_SRCLINE)
  
      end program ESMF_BaseUTest
