1! This file created from test/mpi/f77/info/infotest2f.f with f77tof90 2! -*- Mode: Fortran; -*- 3! 4! (C) 2003 by Argonne National Laboratory. 5! See COPYRIGHT in top-level directory. 6! 7 program main 8 use mpi 9 integer ierr, errs 10 integer i1, i2 11 integer nkeys, i, j, sumindex, vlen, ln, valuelen 12 logical found, flag 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 17! 18 data keys/"Key1", "key2", "KeY3", "A Key With Blanks","See Below", & 19 & "last"/ 20 data values/"value 1", "value 2", "VaLue 3", "key=valu:3","false", & 21 & "no test"/ 22! 23 errs = 0 24 25 call mtest_init( ierr ) 26 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) 29! 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 ) 38! 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 42 endif 43 sumindex = 0 44 do i=1, 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 ) 47 found = .false. 48 do j=1, 6 49 if (mykey .eq. keys(j)) then 50 found = .true. 51 sumindex = sumindex + j 52 call mpi_info_get_valuelen( i1, mykey, vlen, flag, ierr ) 53 if (.not.flag) then 54 errs = errs + 1 55 print *, ' no value for key', mykey 56 else 57 call mpi_info_get( i1, mykey, MPI_MAX_INFO_VAL, & 58 & myvalue, flag, ierr ) 59 if (myvalue .ne. values(j)) then 60 errs = errs + 1 61 print *, ' Value for ', mykey, ' not expected' 62 else 63 do ln=MPI_MAX_INFO_VAL,1,-1 64 if (myvalue(ln:ln) .ne. ' ') then 65 if (vlen .ne. ln) then 66 errs = errs + 1 67 print *, ' length is ', ln, & 68 & ' but valuelen gave ', vlen, & 69 & ' for key ', mykey 70 endif 71 goto 100 72 endif 73 enddo 74 100 continue 75 endif 76 endif 77 endif 78 enddo 79 if (.not.found) then 80 print *, i, 'th key ', mykey, ' not in list' 81 endif 82 enddo 83 if (sumindex .ne. 21) then 84 errs = errs + 1 85 print *, ' Not all keys found' 86 endif 87! 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 ) 93! 94! check the contents of i2 95! valuelen does not signal an error for unknown keys; instead, sets 96! flag to false 97 do i=1,2 98 flag = .true. 99 call mpi_info_get_valuelen( i2, keys(i), valuelen, flag, ierr ) 100 if (flag) then 101 errs = errs + 1 102 print *, ' Found unexpected key ', keys(i) 103 endif 104 myvalue = 'A test' 105 call mpi_info_get( i2, keys(i), MPI_MAX_INFO_VAL, & 106 & myvalue, flag, ierr ) 107 if (flag) then 108 errs = errs + 1 109 print *, ' Found unexpected key in MPI_Info_get ', keys(i) 110 else 111 if (myvalue .ne. 'A test') then 112 errs = errs + 1 113 print *, ' Returned value overwritten, is now ', myvalue 114 endif 115 endif 116 117 enddo 118 do i=3,6 119 myvalue = ' ' 120 call mpi_info_get( i2, keys(i), MPI_MAX_INFO_VAL, & 121 & myvalue, flag, ierr ) 122 if (.not. flag) then 123 errs = errs + 1 124 print *, ' Did not find key ', keys(i) 125 else 126 if (myvalue .ne. values(i)) then 127 errs = errs + 1 128 print *, ' Found wrong value (', myvalue, ') for key ', & 129 & keys(i) 130 endif 131 endif 132 enddo 133! 134! Free info 135 call mpi_info_free( i1, ierr ) 136 call mpi_info_free( i2, ierr ) 137 138 call mtest_finalize( errs ) 139 call mpi_finalize( ierr ) 140 141 end 142