1 ! This file created from test/mpi/f77/info/infotest2f.f with f77tof90
2 ! -*- Mode: Fortran; -*-
4 ! (C) 2003 by Argonne National Laboratory.
5 ! See COPYRIGHT in top-level directory.
11 integer nkeys, i, j, sumindex, vlen, ln, valuelen
13 character*(MPI_MAX_INFO_KEY) keys(6)
14 character*(MPI_MAX_INFO_VAL) values(6)
15 character*(MPI_MAX_INFO_KEY) mykey
16 character*(MPI_MAX_INFO_VAL) myvalue
18 data keys/"Key1", "key2", "KeY3", "A Key With Blanks","See Below", &
20 data values/"value 1", "value 2", "VaLue 3", "key=valu:3","false", &
25 call mtest_init( ierr )
27 ! Note that the MPI standard requires that leading an trailing blanks
28 ! are stripped from keys and values (Section 4.10, The Info Object)
30 ! First, create and initialize an info
31 call mpi_info_create( i1, ierr )
32 call mpi_info_set( i1, keys(1), values(1), ierr )
33 call mpi_info_set( i1, keys(2), values(2), ierr )
34 call mpi_info_set( i1, keys(3), values(3), ierr )
35 call mpi_info_set( i1, keys(4), values(4), ierr )
36 call mpi_info_set( i1, " See Below", values(5), ierr )
37 call mpi_info_set( i1, keys(6), " no test ", ierr )
39 call mpi_info_get_nkeys( i1, nkeys, ierr )
40 if (nkeys .ne. 6) then
41 print *, ' Number of keys should be 6, is ', nkeys
45 ! keys are number from 0 to n-1, even in Fortran (Section 4.10)
46 call mpi_info_get_nthkey( i1, i-1, mykey, ierr )
49 if (mykey .eq. keys(j)) then
51 sumindex = sumindex + j
52 call mpi_info_get_valuelen( i1, mykey, vlen, flag, ierr )
55 print *, ' no value for key', mykey
57 call mpi_info_get( i1, mykey, MPI_MAX_INFO_VAL, &
58 & myvalue, flag, ierr )
59 if (myvalue .ne. values(j)) then
61 print *, ' Value for ', mykey, ' not expected'
63 do ln=MPI_MAX_INFO_VAL,1,-1
64 if (myvalue(ln:ln) .ne. ' ') then
65 if (vlen .ne. ln) then
67 print *, ' length is ', ln, &
68 & ' but valuelen gave ', vlen, &
80 print *, i, 'th key ', mykey, ' not in list'
83 if (sumindex .ne. 21) then
85 print *, ' Not all keys found'
88 ! delete 2, then dup, then delete 2 more
89 call mpi_info_delete( i1, keys(1), ierr )
90 call mpi_info_delete( i1, keys(2), ierr )
91 call mpi_info_dup( i1, i2, ierr )
92 call mpi_info_delete( i1, keys(3), ierr )
94 ! check the contents of i2
95 ! valuelen does not signal an error for unknown keys; instead, sets
99 call mpi_info_get_valuelen( i2, keys(i), valuelen, flag, ierr )
102 print *, ' Found unexpected key ', keys(i)
105 call mpi_info_get( i2, keys(i), MPI_MAX_INFO_VAL, &
106 & myvalue, flag, ierr )
109 print *, ' Found unexpected key in MPI_Info_get ', keys(i)
111 if (myvalue .ne. 'A test') then
113 print *, ' Returned value overwritten, is now ', myvalue
120 call mpi_info_get( i2, keys(i), MPI_MAX_INFO_VAL, &
121 & myvalue, flag, ierr )
124 print *, ' Did not find key ', keys(i)
126 if (myvalue .ne. values(i)) then
128 print *, ' Found wrong value (', myvalue, ') for key ', &
135 call mpi_info_free( i1, ierr )
136 call mpi_info_free( i2, ierr )
138 call mtest_finalize( errs )
139 call mpi_finalize( ierr )