1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
|
!
! Copyright (C) by Argonne National Laboratory
! See COPYRIGHT in top-level directory
!
program main
use mpi_f08
integer ierr, errs
type(MPI_Info) 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
!
data keys/"Key1", "key2", "KeY3", "A Key With Blanks","See Below", &
& "last"/
data values/"value 1", "value 2", "VaLue 3", "key=value:3","false", &
& "no test"/
!
errs = 0
call mtest_init( ierr )
! Note that the MPI standard requires that leading an trailing blanks
! are stripped from keys and values (Section 4.10, The Info Object)
!
! 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 )
!
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
! 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
!
! 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 )
!
! check the contents of i2
! valuelen does not signal an error for unknown keys; instead, sets
! 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
!
! Free info
call mpi_info_free( i1, ierr )
call mpi_info_free( i2, ierr )
call mtest_finalize( errs )
end
|
