C -*- Mode: Fortran; -*-
C
C (C) 2003 by Argonne National Laboratory.
C See COPYRIGHT in top-level directory.
C
program main
implicit none
include 'mpif.h'
integer ierr, errs
integer i1, i2
integer nkeys, i, j, sumindex, vlen, ln, valuelen
logical found, flag
character*(MPI_MAX_INFO_KEY) keys(6)
character*(MPI_MAX_INFO_VAL) values(6)
character*(MPI_MAX_INFO_KEY) mykey
character*(MPI_MAX_INFO_VAL) myvalue
C
data keys/"Key1", "key2", "KeY3", "A Key With Blanks","See Below",
& "last"/
data values/"value 1", "value 2", "VaLue 3", "key=valu:3","false",
& "no test"/
C
errs = 0
call mtest_init( ierr )
C Note that the MPI standard requires that leading an trailing blanks
C are stripped from keys and values (Section 4.10, The Info Object)
C
C First, create and initialize an info
call mpi_info_create( i1, ierr )
call mpi_info_set( i1, keys(1), values(1), ierr )
call mpi_info_set( i1, keys(2), values(2), ierr )
call mpi_info_set( i1, keys(3), values(3), ierr )
call mpi_info_set( i1, keys(4), values(4), ierr )
call mpi_info_set( i1, " See Below", values(5), ierr )
call mpi_info_set( i1, keys(6), " no test ", ierr )
C
call mpi_info_get_nkeys( i1, nkeys, ierr )
if (nkeys .ne. 6) then
print *, ' Number of keys should be 6, is ', nkeys
endif
sumindex = 0
do i=1, nkeys
C keys are number from 0 to n-1, even in Fortran (Section 4.10)
call mpi_info_get_nthkey( i1, i-1, mykey, ierr )
found = .false.
do j=1, 6
if (mykey .eq. keys(j)) then
found = .true.
sumindex = sumindex + j
call mpi_info_get_valuelen( i1, mykey, vlen, flag, ierr )
if (.not.flag) then
errs = errs + 1
print *, ' no value for key', mykey
else
call mpi_info_get( i1, mykey, MPI_MAX_INFO_VAL,
& myvalue, flag, ierr )
if (myvalue .ne. values(j)) then
errs = errs + 1
print *, ' Value for ', mykey, ' not expected'
else
do ln=MPI_MAX_INFO_VAL,1,-1
if (myvalue(ln:ln) .ne. ' ') then
if (vlen .ne. ln) then
errs = errs + 1
print *, ' length is ', ln,
& ' but valuelen gave ', vlen,
& ' for key ', mykey
endif
goto 100
endif
enddo
100 continue
endif
endif
endif
enddo
if (.not.found) then
print *, i, 'th key ', mykey, ' not in list'
endif
enddo
if (sumindex .ne. 21) then
errs = errs + 1
print *, ' Not all keys found'
endif
C
C delete 2, then dup, then delete 2 more
call mpi_info_delete( i1, keys(1), ierr )
call mpi_info_delete( i1, keys(2), ierr )
call mpi_info_dup( i1, i2, ierr )
call mpi_info_delete( i1, keys(3), ierr )
C
C check the contents of i2
C valuelen does not signal an error for unknown keys; instead, sets
C flag to false
do i=1,2
flag = .true.
call mpi_info_get_valuelen( i2, keys(i), valuelen, flag, ierr )
if (flag) then
errs = errs + 1
print *, ' Found unexpected key ', keys(i)
endif
myvalue = 'A test'
call mpi_info_get( i2, keys(i), MPI_MAX_INFO_VAL,
& myvalue, flag, ierr )
if (flag) then
errs = errs + 1
print *, ' Found unexpected key in MPI_Info_get ', keys(i)
else
if (myvalue .ne. 'A test') then
errs = errs + 1
print *, ' Returned value overwritten, is now ', myvalue
endif
endif
enddo
do i=3,6
myvalue = ' '
call mpi_info_get( i2, keys(i), MPI_MAX_INFO_VAL,
& myvalue, flag, ierr )
if (.not. flag) then
errs = errs + 1
print *, ' Did not find key ', keys(i)
else
if (myvalue .ne. values(i)) then
errs = errs + 1
print *, ' Found wrong value (', myvalue, ') for key ',
& keys(i)
endif
endif
enddo
C
C Free info
call mpi_info_free( i1, ierr )
call mpi_info_free( i2, ierr )
call mtest_finalize( errs )
call mpi_finalize( ierr )
end