Blame test/mpi/f90/info/infotest2f90.f90

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