!
! -*- Mode: Fortran; -*-
!
!  (C) 2012 by Argonne National Laboratory.
!      See COPYRIGHT in top-level directory.
!
!
! In MPI 2.2, the behavior of attributes set in one language and retrieved
! from another was defined.  There are three types of attribute values:
!  1. pointer (void *): "The C type"
!  2. INTEGER         : "The MPI-1 Fortran type"
!  3. INTEGER (KIND=MPI_ADDRESS_KIND) : "The MPI-2 Fortran type"
!
! All three apply to Communicator attributes, with case 2 using the
! deprecated MPI_ATTR_GET and MPI_ATTR_PUT routines. For Datatype and
! RMA Window attributes, cases 1 and 3 apply.
!
! Note, just to make this more complex, there are some reasons why an MPI
! implementation may choose to make MPI_Aint (and the corresponding
! Fortran MPI_ADDRESS_KIND) larger than a void pointer.  Specifically,
! make it as large as MPI_Offset, which simplifies certain operations
! with datatypes.
!
! There are 9 cases:
! 1. C sets, C gets
! 2. C sets, Fortran INTEGER gets
! 3. C sets, Fortran ADDRESS_KIND gets
! 4. Fortran INTEGER sets, C gets
! 5. Fortran INTEGER sets, Fortran INTEGER gets
! 6. Fortran INTEGER sets, Fortran ADDRESS_KIND gets
! 7. Fortran ADDRESS_KIND sets, C gets
! 8. Fortran ADDRESS_KIND sets, Fortran INTEGER gets
! 9. Fortran ADDRESS_KIND sets, Fortran ADDRESS_KIND gets
!
! These are the basic cases.  They are complicated by the fact that
! the attribute values have 3 types: void * (C interface), MPI_Fint
! (Fortran INTEGER), and MPI_Aint (Fortran ADDRESS_KIND).  These
! have the following size relationships:
!
! sizeof(void *) <= sizeof(MPI_Aint)
!     (For some systems, MPI_Aint is set to the same size as
!      MPI_Offset, and may be larger than a void *.)
! sizeof(MPI_Fint) <= sizeof(MPI_Aint)
!     (Not strictly defined, but all reasonable implementations will
!      have this property)
!
! When a value is stored, the full value is stored (this may be fewer
! bytes than the maximum-sized attribute, in which case the high
! bytes are stored as zero).  When a value is retrieved, if the
! destination location is smaller, the low bytes (in value) are
! saved; this is the same as trunction.  If the destination location
! is longer, then then value is sign-extended (See MPI-3, 17.2.7).
!
! Specifically, if the value was set from Fortran, C will return a
! pointer to the appropriate-sized integer.
! When the value is set from C but accessed from Fortran, the value
! is converted to an integer of the appropriate length, possibly truncated.
!
! FIXME: The above different-length attribute case is not yet handled
!  in this code.
!
! In addition to setting and getting attributes, they are accessed
! through duplication (COMM_DUP and TYPE_DUP), and on deletion of the
! object to which they are attached, when the copy functions will be
! well-defined.
!
! This code was inspired by a code written by Jeff Squyres to test these
! nine cases. This code, however, is different.
!
! So, for each of the same->same tests:
!    Store largest positive and negative attributes.  Dup them,
!    retrieve them, delete them.  All bytes should remain value, and
!    no other.  Use keys created in all three languages for set/get;
!    use language under test for dup.
!
! For X->Y tests:
!    Using X, store into key created in all three.
!    Using Y, retrive all attributes.  See above for handling of
!     truncated or sign-extended
!
! Use Fortran to drive tests (Fortran main program).  Call C for
! C routines and to check data with different sizes (to ensure that
! the proper bytes are used in the value).
!
! Use the same keyval for attributes used in both C and Fortran (both
! modes).  This found an error in MPICH, where the type of the
! attribute (e.g., pointer, integer, or address-sized integer) needs
! to be saved.
!
! Module containing the keys and other information, including
! interfaces to the C routines
      module keyvals
        use mpi_f08
        logical fverbose, useintSize
        integer ptrSize, intSize, aintSize
        integer fcomm1_key, fcomm1_extra
        integer fcomm2_key, ftype2_key, fwin2_key
        integer ccomm1_key
        integer ccomm2_key, ctype2_key, cwin2_key
        TYPE(MPI_Win) win
        integer (kind=MPI_ADDRESS_KIND) fcomm2_extra, ftype2_extra,&
             & fwin2_extra
        interface
           pure function bigint()
             integer bigint
           end function bigint
           pure function bigaint()
             use mpi_f08, only : MPI_ADDRESS_KIND
             integer (kind=MPI_ADDRESS_KIND) bigaint
           end function bigaint
           ! Could use bind(c) once we require that level of Fortran support.
           subroutine csetmpi( fcomm, fkey, val, errs )
             use mpi_f08
             TYPE(MPI_Comm), INTENT(IN) :: fcomm
             integer, INTENT(IN) :: fkey, val
             integer errs
           end subroutine csetmpi
           subroutine csetmpi2( fcomm, fkey, val, errs )
             use mpi_f08
             TYPE(MPI_Comm), INTENT(IN) :: fcomm
             integer, INTENT(IN) :: fkey
             integer  errs
             integer (KIND=MPI_ADDRESS_KIND) val
           end subroutine csetmpi2
           subroutine cattrinit( fv )
             integer fv
           end subroutine cattrinit
           subroutine cgetsizes( ps, is, as )
             integer, INTENT(OUT) :: ps, is, as
           end subroutine cgetsizes
           subroutine ccreatekeys( k1, k2, k3, k4 )
             integer, INTENT(OUT) :: k1, k2, k3, k4
           end subroutine ccreatekeys
           subroutine cfreekeys()
           end subroutine cfreekeys
           subroutine ctoctest( errs )
             integer errs
           end subroutine ctoctest
        end interface
      end module keyvals
!
      program main
      use mpi_f08
      use keyvals
      implicit none
      integer ierr
      integer errs, tv, rank
      integer(MPI_ADDRESS_KIND) tmp

      errs = 0
      call MTEST_INIT( ierr )
      call MPI_COMM_RANK( MPI_COMM_WORLD, rank, ierr )
!
!     Let the C routines know about debugging
      call cgetenvbool( "MPITEST_VERBOSE", tv )
      if (tv .eq. 1) then
         fverbose = .true.
         call cattrinit( 1 )
      else
         fverbose = .false.
         call cattrinit( 0 )
      endif
!
! If this value is true, define an "big MPI_Aint" value that fits in
! an MPI_Fint (see function bigaint)
      call cgetenvbool( "MPITEST_ATTR_INTFORAINT", tv )
      if (tv .eq. 1) then
         useintSize = .true.
      else
         useintSize = .false.
      endif
!
!     Get the sizes of the three types of attributes
      call cgetsizes( ptrSize, intSize, aintSize )
      if (fverbose) then
         print *, 'sizeof(ptr)=',ptrSize, ' sizeof(int)=', intSize, ' &
              &sizeof(aint)=', aintSize
      endif
!
!     Create the keyvals
!
!     Create the attribute values to use.  We want these to use the full
!     available width, which depends on both the type and the test,
!     since when switching between types of different sizes, we need to
!     check only the "low" bits (those shared in types of each size).
!
!
      if (fverbose) then
         print *, "Creating Fortran attribute keys"
      endif

      call fCreateKeys()
      if (fverbose) then
         print *, "Creating C attribute keys"
      endif
      call ccreatekeys( ccomm1_key, ccomm2_key, ctype2_key, cwin2_key&
           & )
!
!     Create a window to use with the attribute tests in Fortran
      tmp = 0
      call MPI_WIN_CREATE( MPI_BOTTOM, tmp, 1, MPI_INFO_NULL,&
           & MPI_COMM_WORLD, win, ierr )
!
      if (fverbose) then
         print *, "Case 1: C sets and C gets"
      endif
      call ctoctest( errs )
      if (fverbose) then
         print *, "Case 2: C sets and Fortran (MPI1) gets"
      endif
      call ctof1test( errs )
      if (fverbose) then
         print *, "Case 3: C sets and Fortran (MPI2) gets"
      endif
      call ctof2test( errs )
      if (fverbose) then
         print *, "Case 4: Fortran (MPI1) sets and C gets"
      endif
      call f1toctest( errs )
      if (fverbose) then
         print *, "Case 5: Fortran (MPI1) sets and gets"
      endif
      call f1tof1test( errs )
      if (fverbose) then
         print *, "Case 6: Fortran (MPI1) sets and Fortran (MPI2) gets"
      endif
      call f1tof2test( errs )
      if (fverbose) then
         print *, "Case 7: Fortran (MPI2) sets and C gets"
      endif
      call f2toctest( errs )
      if (fverbose) then
         print *, "Case 8: Fortran (MPI2) sets and Fortran (MPI1) gets"
      endif
      call f2tof1test( errs )
      if (fverbose) then
         print *, "Case 9: Fortran (MPI2) sets and gets"
      endif
      call f2tof2test( errs )

! Cleanup
      call ffreekeys()
      call cfreekeys()
      call MPI_WIN_FREE( win, ierr )

      call MPI_REDUCE( MPI_IN_PLACE, errs, 1, MPI_INT, MPI_SUM, 0,&
           & MPI_COMM_WORLD, ierr )

      call MTEST_FINALIZE( errs )

      end
!
! -------------------------------------------------------------------
! Check attribute set in Fortran (MPI-1) and read from Fortran (MPI-1)
! -------------------------------------------------------------------
      integer function FMPI1checkCommAttr( comm, key, expected, msg )
      use mpi_f08
      integer key, expected
      TYPE(MPI_Comm) comm
      character*(*) msg
      integer value, ierr
      logical flag
!
      FMPI1checkCommAttr = 0
      call MPI_ATTR_GET( comm, key, value, flag, ierr )
      if (.not. flag) then
         print *, "Error: reading Fortran INTEGER attribute: ", msg
         FMPI1checkCommAttr = 1
         return
      endif
      if (value .ne. expected) then
         print *, "Error: Fortran INTEGER attribute: ", msg
         print *, "Expected ", expected, " but got ", value
         FMPI1checkCommAttr = 1
      endif
      return
      end
!
! -------------------------------------------------------------------
! Functions associated with attribute copy/delete.
! -------------------------------------------------------------------
      subroutine FMPI1_COPY_FN( oldcomm, key, extrastate, inval,&
           & outval, flag, ierr )
      use mpi_f08
      use keyvals, only : fverbose
      integer key, extrastate, inval, outval, ierr
      TYPE(MPI_Comm) oldcomm
      logical flag
!
      if (fverbose) then
         print *, 'FMPI1_COPY: Attr in = ', inval, ' extra = ',&
              & extrastate
      endif
      flag = .true.
      outval = inval + 1
      ierr = MPI_SUCCESS
      end
!
      subroutine FMPI1_DELETE_FN( oldcomm, key, extrastate, inval,&
     &     ierr )
      use mpi_f08
      use keyvals, only : fverbose
      integer key, extrastate, inval, ierr
      TYPE(MPI_Comm) oldcomm
      logical flag
!
      if (fverbose) then
         print *, "FMPI1_DELETE: inval = ", inval, " extra = ",&
              & extrastate
      endif
      ierr = MPI_SUCCESS
      end
!
!
      subroutine FMPI2_COPY_FN( oldcomm, key, extrastate, inval, outval,&
     &     flag, ierr )
      use mpi_f08
      use keyvals, only : fverbose
      implicit none
      integer key, ierr
      TYPE(MPI_Comm) oldcomm
      integer (KIND=MPI_ADDRESS_KIND) inval, outval, extrastate
      logical flag
!
      if (fverbose) then
         print *, 'FMPI2_COPY: Attr in = ', inval, ' extra = ',&
              & extrastate
      endif
      flag = .true.
      outval = inval + 1
      ierr = MPI_SUCCESS
      end
!
      subroutine FMPI2_DELETE_FN( oldcomm, key, extrastate, inval,&
     &     ierr )
      use mpi_f08
      use keyvals, only : fverbose
      implicit none
      integer key, ierr
      TYPE(MPI_Comm) oldcomm
      integer (kind=MPI_ADDRESS_KIND) inval, extrastate
!
      if (fverbose) then
         print *, "FMPI2_DELETE: inval = ", inval, " extra = ",&
              & extrastate
      endif
      ierr = MPI_SUCCESS
      end
! -------------------------------------------------------------------
!
! Typical check pattern
!
! Set value
! Get value (check set in same form)
! Get value in other modes
! Dup object (updates value)
! Get value in other modes
! Delete dup'ed object; check correct value sent to delete routine
!
      subroutine fcreateKeys( )
        use mpi_f08
        use keyvals
        implicit none
        external FMPI1_COPY_FN, FMPI1_DELETE_FN, FMPI2_COPY_FN,&
           & FMPI2_DELETE_FN
        integer ierr

        fcomm1_extra = 0
        fcomm2_extra = 0
        ftype2_extra = 0
        fwin2_extra  = 0
        call MPI_KEYVAL_CREATE( FMPI1_COPY_FN, FMPI1_DELETE_FN,&
             & fcomm1_key, fcomm1_extra, ierr )
        call MPI_COMM_CREATE_KEYVAL( FMPI2_COPY_FN, FMPI2_DELETE_FN,&
             & fcomm2_key, fcomm2_extra, ierr )
        call MPI_TYPE_CREATE_KEYVAL( FMPI2_COPY_FN, FMPI2_DELETE_FN,&
             & ftype2_key, ftype2_extra, ierr )
        call MPI_WIN_CREATE_KEYVAL( FMPI2_COPY_FN, FMPI2_DELETE_FN,&
             & fwin2_key, fwin2_extra, ierr )

      end subroutine fcreateKeys
!
      subroutine ffreekeys()
        use mpi_f08
        use keyvals
        implicit none
        integer ierr

        call MPI_KEYVAL_FREE( fcomm1_key, ierr )
        call MPI_COMM_FREE_KEYVAL( fcomm2_key, ierr )
        call MPI_TYPE_FREE_KEYVAL( ftype2_key, ierr )
        call MPI_WIN_FREE_KEYVAL( fwin2_key, ierr )

        return
      end subroutine ffreekeys
! -------------------------------------------------------------------
! Set attributes in Fortran (MPI-1) and read them from Fortran (MPI-1)
      subroutine f1tof1test(errs)
        use mpi_f08
        use keyvals
        implicit none
        integer errs
        integer ierr, attrval, fcomm1attr
        TYPE(MPI_Comm) fdup
!
        fcomm1attr = bigint()
        attrval    = fcomm1attr
        call MPI_ATTR_PUT( MPI_COMM_SELF, fcomm1_key, fcomm1attr,&
             & ierr )
        call fmpi1read( MPI_COMM_SELF, fcomm1_key, attrval, &
             &"F to F (check value)", errs )
        call MPI_COMM_DUP( MPI_COMM_SELF, fdup, ierr )
        call fmpi1read( fdup, fcomm1_key, attrval + 1, "F to F dup",&
             & errs )
        call MPI_COMM_FREE( fdup, ierr )
!
! Use a negative value
        fcomm1attr = -bigint()
        attrval    = fcomm1attr
        call MPI_ATTR_PUT( MPI_COMM_SELF, fcomm1_key, fcomm1attr,&
             & ierr )
        call fmpi1read( MPI_COMM_SELF, fcomm1_key, attrval, &
             &"F to F (check neg value)", errs )
        call MPI_COMM_DUP( MPI_COMM_SELF, fdup, ierr )
        call fmpi1read( fdup, fcomm1_key, attrval + 1, "F to F dup",&
             & errs )
        call MPI_COMM_FREE( fdup, ierr )

      end subroutine f1tof1test
!
! Set attributes in C and read them from Fortran (MPI-1)
      subroutine ctof1test(errs)
        use mpi_f08
        use keyvals
        implicit none
        integer errs
        integer ierr, attrval, fcomm1attr
        TYPE(MPI_Comm) fdup
!
        fcomm1attr = bigint()
        attrval    = fcomm1attr
        call csetmpi( MPI_COMM_SELF, fcomm1_key, fcomm1attr, errs )
        call fmpi1read( MPI_COMM_SELF, fcomm1_key, attrval, "C to F",&
             & errs )
        if (ptrSize .eq. intSize) then
           call MPI_COMM_DUP( MPI_COMM_SELF, fdup, ierr )
           call fmpi1read( fdup, fcomm1_key, attrval + 1, "C to F dup",&
                & errs )
           call MPI_COMM_FREE( fdup, ierr )
        endif
!
        fcomm1attr = -bigint()
        attrval    = fcomm1attr
        call csetmpi( MPI_COMM_SELF, fcomm1_key, fcomm1attr, errs )
        call fmpi1read( MPI_COMM_SELF, fcomm1_key, attrval, "C to F",&
             & errs )
        if (ptrSize .eq. intSize) then
           call MPI_COMM_DUP( MPI_COMM_SELF, fdup, ierr )
           call fmpi1read( fdup, fcomm1_key, attrval + 1, "C to F dup",&
                & errs )
           call MPI_COMM_FREE( fdup, ierr )
        endif

      end subroutine ctof1test
!
! Set attributes in Fortran (MPI-1) and read in Fortran (MPI-2)
      subroutine f1tof2test(errs)
        use mpi_f08
        use keyvals
        implicit none
        integer errs
        integer ierr, attrval, fcomm1attr
        TYPE(MPI_Comm) fdup
        integer (kind=MPI_ADDRESS_KIND) expected
!
        fcomm1attr = bigint()
        attrval    = fcomm1attr
        call MPI_ATTR_PUT( MPI_COMM_SELF, fcomm1_key, fcomm1attr,&
             & ierr )
        call fmpi1read( MPI_COMM_SELF, fcomm1_key, attrval, &
             & "F to F (check value for F2 test)", errs )
        if (intSize .eq. aintSize) then
           call MPI_COMM_DUP( MPI_COMM_SELF, fdup, ierr )
           expected = attrval + 1
           call fmpi2read( fdup, fcomm1_key, expected, "F to F2 dup",&
                & errs )
           call MPI_COMM_FREE( fdup, ierr )
        endif
!
        fcomm1attr = -bigint()
        attrval    = fcomm1attr
        call MPI_ATTR_PUT( MPI_COMM_SELF, fcomm1_key, fcomm1attr,&
             & ierr )
        call fmpi1read( MPI_COMM_SELF, fcomm1_key, attrval, &
             &"F to F (check neg value for F2 test)", errs )
        if (intSize .eq. aintSize) then
           call MPI_COMM_DUP( MPI_COMM_SELF, fdup, ierr )
           expected = attrval + 1
           call fmpi2read( fdup, fcomm1_key, expected, "F to F2 dup",&
                & errs )
           call MPI_COMM_FREE( fdup, ierr )
        endif

      end subroutine f1tof2test
!
      subroutine fmpi1read( comm, key, expected, msg, errs )
        use mpi_f08
        implicit none
        integer key, expected, errs
        TYPE(MPI_Comm) comm
        character *(*) msg
        logical flag
        integer ierr, attrval
!
        call MPI_ATTR_GET( comm, key, attrval, flag, ierr )
        if (.not. flag) then
           print *, 'Error: flag false for Attr_get: ', msg
           errs = errs + 1
           return
        endif
        if (attrval .ne. expected) then
           print *, 'Error: expected ', expected, ' but saw ',&
                & attrval, ':', msg
           errs = errs + 1
        endif
        return
      end subroutine fmpi1read

      subroutine fmpi2read( comm, key, expected, msg, errs )
        use mpi_f08
        implicit none
        integer key, errs
        TYPE(MPI_Comm) comm
        integer (kind=MPI_ADDRESS_KIND) expected
        character *(*) msg
        logical flag
        integer ierr
        integer (kind=MPI_ADDRESS_KIND) attrval
!
        call MPI_COMM_GET_ATTR( comm, key, attrval, flag, ierr )
        if (.not. flag) then
           print *, 'Error: flag false for Attr_get: ', msg
           errs = errs + 1
           return
        endif
        if (attrval .ne. expected) then
           print *, 'Error: expected ', expected, ' but saw ',&
                & attrval, ':', msg
           errs = errs + 1
        endif
        return
      end subroutine fmpi2read

      subroutine fmpi2readwin( win, key, expected, msg, errs )
        use mpi_f08
        implicit none
        integer key, errs
        TYPE(MPI_Win) win
        integer (kind=MPI_ADDRESS_KIND) expected
        character *(*) msg
        logical flag
        integer ierr
        integer (kind=MPI_ADDRESS_KIND) attrval
!
        call MPI_WIN_GET_ATTR( win, key, attrval, flag, ierr )
        if (.not. flag) then
           print *, 'Error: flag false for Win_get_attr: ', msg
           errs = errs + 1
           return
        endif
        if (attrval .ne. expected) then
           print *, 'Error: expected ', expected, ' but saw ',&
                & attrval, ':', msg
           errs = errs + 1
        endif
        return
      end subroutine fmpi2readwin

      subroutine fmpi2readtype( dtype, key, expected, msg, errs )
        use mpi_f08
        implicit none
        integer key, errs
        TYPE(MPI_Datatype) dtype
        integer (kind=MPI_ADDRESS_KIND) expected
        character *(*) msg
        logical flag
        integer ierr
        integer (kind=MPI_ADDRESS_KIND) attrval
!
        call MPI_TYPE_GET_ATTR( dtype, key, attrval, flag, ierr )
        if (.not. flag) then
           print *, 'Error: flag false for Type_get_attr: ', msg
           errs = errs + 1
           return
        endif
        if (attrval .ne. expected) then
           print *, 'Error: expected ', expected, ' but saw ',&
                & attrval, ':', msg
           errs = errs + 1
        endif
        return
      end subroutine fmpi2readtype

      subroutine f2tof2test(errs)
        use mpi_f08
        use keyvals
        implicit none
        integer errs
        integer ierr
        TYPE(MPI_Comm) fdup
        TYPE(MPI_Datatype) tdup
        integer (kind=MPI_ADDRESS_KIND) fcomm2attr, ftype2attr,&
             & fwin2attr, attrval
!
        fcomm2attr = bigaint()
        attrval    = fcomm2attr
        call MPI_COMM_SET_ATTR( MPI_COMM_SELF, fcomm2_key, fcomm2attr,&
             & ierr )
        call fmpi2read( MPI_COMM_SELF, fcomm2_key, attrval, "F2 to F2",&
             & errs )
        call MPI_COMM_DUP( MPI_COMM_SELF, fdup, ierr )
        call fmpi2read( fdup, fcomm2_key, attrval + 1, "F2 to F2 dup",&
             & errs )
        call MPI_COMM_FREE( fdup, ierr )
!
        ftype2attr = bigaint()-9
        attrval    = ftype2attr
        call MPI_TYPE_SET_ATTR( MPI_INTEGER, ftype2_key, ftype2attr,&
             & ierr )
        call fmpi2readtype( MPI_INTEGER, ftype2_key, attrval, "F2 type&
             & to F2", errs )
        call MPI_TYPE_DUP( MPI_INTEGER, tdup, ierr )
        call fmpi2readtype( tdup, ftype2_key, attrval + 1, "F2 type to&
             & F dup", errs )
        call MPI_TYPE_FREE( tdup, ierr )

        fwin2attr = bigaint()-9
        attrval    = fwin2attr
        call MPI_WIN_SET_ATTR( win, fwin2_key, fwin2attr,&
             & ierr )
        call fmpi2readwin( win, fwin2_key, attrval, "F2 win to F2",&
             & errs )
!
        fcomm2attr = -bigaint()
        attrval    = fcomm2attr
        call MPI_COMM_SET_ATTR( MPI_COMM_SELF, fcomm2_key, fcomm2attr,&
             & ierr )
        call fmpi2read( MPI_COMM_SELF, fcomm2_key, attrval, "F2 to F2",&
             & errs )
        call MPI_COMM_DUP( MPI_COMM_SELF, fdup, ierr )
        call fmpi2read( fdup, fcomm2_key, attrval + 1, "F2 to F2 dup",&
             & errs )
        call MPI_COMM_FREE( fdup, ierr )
!
        ftype2attr = -(bigaint()-9)
        attrval    = ftype2attr
        call MPI_TYPE_SET_ATTR( MPI_INTEGER, ftype2_key, ftype2attr,&
             & ierr )
        call fmpi2readtype( MPI_INTEGER, ftype2_key, attrval, "F2 type&
             & to F2", errs )
        call MPI_TYPE_DUP( MPI_INTEGER, tdup, ierr )
        call fmpi2readtype( tdup, ftype2_key, attrval + 1, "F2 type to&
             & F dup", errs )
        call MPI_TYPE_FREE( tdup, ierr )

        fwin2attr = -(bigaint()-9)
        attrval    = fwin2attr
        call MPI_WIN_SET_ATTR( win, fwin2_key, fwin2attr,&
             & ierr )
        call fmpi2readwin( win, fwin2_key, attrval, "F2 win to F2",&
             & errs )

      end subroutine f2tof2test
!
      subroutine f1toctest( errs )
        use mpi_f08
        use keyvals
        implicit none
        integer errs
        integer ierr, attrval, fcomm1attr
        TYPE(MPI_Comm) fdup
!
        fcomm1attr = bigint()
        attrval    = fcomm1attr
        call MPI_ATTR_PUT( MPI_COMM_SELF, fcomm1_key, fcomm1attr,&
             & ierr )
        call fmpi1read( MPI_COMM_SELF, fcomm1_key, attrval, &
             & "F to F (check for F to C)", errs )
        if (intSize .eq. ptrSize) then
           call MPI_COMM_DUP( MPI_COMM_SELF, fdup, ierr )
           call cmpif1read( fdup, fcomm1_key, attrval + 1, errs, &
                & "F to F2 dup" )
           call MPI_COMM_FREE( fdup, ierr )
        endif
!
        fcomm1attr = -bigint()
        attrval    = fcomm1attr
        call MPI_ATTR_PUT( MPI_COMM_SELF, fcomm1_key, fcomm1attr,&
             & ierr )
        call fmpi1read( MPI_COMM_SELF, fcomm1_key, attrval, &
             &"F to F (check neg value for F to C)", errs )
        if (intSize .eq. ptrSize) then
           call MPI_COMM_DUP( MPI_COMM_SELF, fdup, ierr )
           call cmpif1read( fdup, fcomm1_key, attrval + 1, errs, &
                "F to C dup" )
           call MPI_COMM_FREE( fdup, ierr )
        endif

      end subroutine f1toctest

      subroutine f2tof1test(errs)
        use mpi_f08
        use keyvals
        implicit none
        integer errs
        integer ierr
        TYPE(MPI_Comm) fdup
        TYPE(MPI_Datatype) tdup
        integer (kind=MPI_ADDRESS_KIND) fcomm2attr, ftype2attr,&
             & fwin2attr, attrval
        integer expected
!
        fcomm2attr = bigaint()
        attrval    = fcomm2attr
        call MPI_COMM_SET_ATTR( MPI_COMM_SELF, fcomm2_key, fcomm2attr,&
             & ierr )
        call fmpi2read( MPI_COMM_SELF, fcomm2_key, attrval, "F2 to F2",&
             & errs )
        if (aintSize .eq. intSize) then
           call MPI_COMM_DUP( MPI_COMM_SELF, fdup, ierr )
           expected = attrval + 1
           call fmpi1read( fdup, fcomm2_key, expected, "F2 to F1 dup",&
                & errs )
           call MPI_COMM_FREE( fdup, ierr )
        endif
!
        fcomm2attr = -bigaint()
        attrval    = fcomm2attr
        call MPI_COMM_SET_ATTR( MPI_COMM_SELF, fcomm2_key, fcomm2attr,&
             & ierr )
        call fmpi2read( MPI_COMM_SELF, fcomm2_key, attrval, "F2 to F2",&
             & errs )
        if (aintSize .eq. intSize) then
           call MPI_COMM_DUP( MPI_COMM_SELF, fdup, ierr )
           expected = attrval + 1
           call fmpi1read( fdup, fcomm2_key, expected, "F2 to F1 dup",&
                & errs )
           call MPI_COMM_FREE( fdup, ierr )
        endif

!
      end subroutine f2tof1test
!
      subroutine f2toctest(errs)
        use mpi_f08
        use keyvals
        implicit none
        integer errs
        integer ierr
        TYPE(MPI_Comm) fdup
        TYPE(MPI_Datatype) tdup
        integer (kind=MPI_ADDRESS_KIND) fcomm2attr, ftype2attr,&
             & fwin2attr, attrval
!
        fcomm2attr = bigaint()
        attrval    = fcomm2attr
        call MPI_COMM_SET_ATTR( MPI_COMM_SELF, fcomm2_key, fcomm2attr,&
             & ierr )
        call fmpi2read( MPI_COMM_SELF, fcomm2_key, attrval, "F2 to F2",&
             & errs )
        if (aintSize .eq. ptrSize) then
           call MPI_COMM_DUP( MPI_COMM_SELF, fdup, ierr )
           call cmpif2read( fdup, fcomm2_key, attrval + 1, errs, "F2 t&
                &o c dup")
           call MPI_COMM_FREE( fdup, ierr )
        endif
!
        ftype2attr = bigaint()-9
        attrval    = ftype2attr
        call MPI_TYPE_SET_ATTR( MPI_INTEGER, ftype2_key, ftype2attr,&
             & ierr )
        call fmpi2readtype( MPI_INTEGER, ftype2_key, attrval, "F2 type&
             & to F2", errs )
        if (aintSize .eq. ptrSize) then
           call MPI_TYPE_DUP( MPI_INTEGER, tdup, ierr )
           call cmpif2readtype( tdup, ftype2_key, attrval + 1, errs, "F2 &
                &type toF dup" )
           call MPI_TYPE_FREE( tdup, ierr )
        endif

        fwin2attr = bigaint()-9
        attrval    = fwin2attr
        call MPI_WIN_SET_ATTR( win, fwin2_key, fwin2attr, ierr )
        call cmpif2readwin( win, fwin2_key, attrval, errs, "F2 win to &
             &c" )
!
        fcomm2attr = -bigaint()
        attrval    = fcomm2attr
        call MPI_COMM_SET_ATTR( MPI_COMM_SELF, fcomm2_key, fcomm2attr,&
             & ierr )
        call fmpi2read( MPI_COMM_SELF, fcomm2_key, attrval, "F2 to F2",&
             & errs )
        if (aintSize .eq. ptrSize) then
           call MPI_COMM_DUP( MPI_COMM_SELF, fdup, ierr )
           call cmpif2read( fdup, fcomm2_key, attrval + 1, errs, "F2 t&
                &o c dup")
           call MPI_COMM_FREE( fdup, ierr )
        endif
!
        ftype2attr = -(bigaint()-9)
        attrval    = ftype2attr
        call MPI_TYPE_SET_ATTR( MPI_INTEGER, ftype2_key, ftype2attr,&
             & ierr )
        call fmpi2readtype( MPI_INTEGER, ftype2_key, attrval, "F2 type&
             & to F2", errs )
        if (aintSize .eq. ptrSize) then
           call MPI_TYPE_DUP( MPI_INTEGER, tdup, ierr )
           call cmpif2readtype( tdup, ftype2_key, attrval + 1, errs, "F2 &
                &type toF dup" )
           call MPI_TYPE_FREE( tdup, ierr )
        endif

        fwin2attr = -(bigaint()-9)
        attrval    = fwin2attr
        call MPI_WIN_SET_ATTR( win, fwin2_key, fwin2attr, ierr )
        call cmpif2readwin( win, fwin2_key, attrval, errs, "F2 win to &
             &c" )

      end subroutine f2toctest
!
      subroutine ctof2test(errs)
        use mpi_f08
        use keyvals
        implicit none
        integer errs
        integer ierr
        TYPE(MPI_Comm) fdup
        TYPE(MPI_Datatype) tdup
        integer (kind=MPI_ADDRESS_KIND) fcomm2attr, ftype2attr,&
             & fwin2attr, attrval
!
        fcomm2attr = bigaint()
        attrval    = fcomm2attr
        call csetmpi2( MPI_COMM_SELF, fcomm2_key, fcomm2attr, errs )
        call fmpi2read( MPI_COMM_SELF, fcomm2_key, attrval, "c to F2",&
             & errs )
        if (aintSize .eq. ptrSize) then
           call MPI_COMM_DUP( MPI_COMM_SELF, fdup, ierr )
           call fmpi2read( fdup, fcomm2_key, attrval + 1, "c to F2 dup",&
                & errs )
           call MPI_COMM_FREE( fdup, ierr )
        endif
!
        ftype2attr = bigaint()-9
        attrval    = ftype2attr
        call csetmpitype( MPI_INTEGER, ftype2_key, ftype2attr, errs )
        call fmpi2readtype( MPI_INTEGER, ftype2_key, attrval, "c type&
             & to F2", errs )
        if (aintSize .eq. ptrSize) then
           call MPI_TYPE_DUP( MPI_INTEGER, tdup, ierr )
           call fmpi2readtype( tdup, ftype2_key, attrval + 1, "c type to&
                & F2 dup", errs )
           call MPI_TYPE_FREE( tdup, ierr )
        endif

        fwin2attr = bigaint()-9
        attrval    = fwin2attr
        call csetmpiwin( win%MPI_VAL, fwin2_key, fwin2attr, errs )
        call fmpi2readwin( win, fwin2_key, attrval, "c win to F2",&
             & errs )
!
        fcomm2attr = -bigaint()
        attrval    = fcomm2attr
        call csetmpi2( MPI_COMM_SELF, fcomm2_key, fcomm2attr, errs )
        call fmpi2read( MPI_COMM_SELF, fcomm2_key, attrval, "c to F2",&
             & errs )
        if (aintSize .eq. ptrSize) then
           call MPI_COMM_DUP( MPI_COMM_SELF, fdup, ierr )
           call fmpi2read( fdup, fcomm2_key, attrval + 1, "c to F2 dup",&
                & errs )
           call MPI_COMM_FREE( fdup, ierr )
        endif
!
        ftype2attr = -(bigaint()-9)
        attrval    = ftype2attr
        call csetmpitype( MPI_INTEGER, ftype2_key, ftype2attr, errs )
        call fmpi2readtype( MPI_INTEGER, ftype2_key, attrval, "c type&
             & to F2", errs )
        if (aintSize .eq. ptrSize) then
           call MPI_TYPE_DUP( MPI_INTEGER, tdup, ierr )
           call fmpi2readtype( tdup, ftype2_key, attrval + 1, "c type to&
                & F2 dup", errs )
           call MPI_TYPE_FREE( tdup, ierr )
        endif

        fwin2attr = -(bigaint()-9)
        attrval    = fwin2attr
        call csetmpiwin( win, fwin2_key, fwin2attr, errs )
        call fmpi2readwin( win, fwin2_key, attrval, "c win to F2",&
             & errs )

      end subroutine ctof2test

! -------------------------------------------------------------------
! Return an integer value that fills all of the bytes
      pure integer function bigint()
        integer i, v, digits
        digits = range(i)
        v = 0
        do i=1,digits
           v = v * 10 + i
        enddo
        bigint = v
        return
      end function bigint
!
! Return an integer value that fill all of the bytes in an AINT
! The logical "useintsize" allows us to specify that only an int-sized
! result should be returned
      pure function bigaint()
        use mpi_f08, only : MPI_ADDRESS_KIND
        use keyvals, only : useintsize
        implicit none
        integer (kind=MPI_ADDRESS_KIND) bigaint, v
        integer i, digits
        if (useintsize) then
           digits = range(i)
        else
           digits = range(v)
        endif
        v = 0
        do i=1,digits
           v = v * 10 + i
        enddo
        bigaint = v
        return
      end function bigaint