Blame test/mpi/f77/info/infotestf.f

Packit Service c5cf8c
C -*- Mode: Fortran; -*- 
Packit Service c5cf8c
C
Packit Service c5cf8c
C  (C) 2003 by Argonne National Laboratory.
Packit Service c5cf8c
C      See COPYRIGHT in top-level directory.
Packit Service c5cf8c
C
Packit Service c5cf8c
C Simple info test 
Packit Service c5cf8c
       program main
Packit Service c5cf8c
       implicit none
Packit Service c5cf8c
       include 'mpif.h'
Packit Service c5cf8c
       integer i1, i2
Packit Service c5cf8c
       integer i, errs, ierr
Packit Service c5cf8c
       integer valuelen
Packit Service c5cf8c
       parameter (valuelen=64)
Packit Service c5cf8c
       character*(valuelen) value
Packit Service c5cf8c
       logical flag
Packit Service c5cf8c
C
Packit Service c5cf8c
       errs = 0
Packit Service c5cf8c
Packit Service c5cf8c
       call MTest_Init( ierr )
Packit Service c5cf8c
Packit Service c5cf8c
       call mpi_info_create( i1, ierr )
Packit Service c5cf8c
       call mpi_info_create( i2, ierr )
Packit Service c5cf8c
Packit Service c5cf8c
       call mpi_info_set( i1, "key1", "value1", ierr )
Packit Service c5cf8c
       call mpi_info_set( i2, "key2", "value2", ierr )
Packit Service c5cf8c
Packit Service c5cf8c
       call mpi_info_get( i1, "key2", valuelen, value, flag, ierr )
Packit Service c5cf8c
       if (flag) then
Packit Service c5cf8c
          print *, "Found key2 in info1"
Packit Service c5cf8c
          errs = errs + 1
Packit Service c5cf8c
       endif
Packit Service c5cf8c
Packit Service c5cf8c
       call MPI_Info_get( i1, "key1", 64, value, flag, ierr )
Packit Service c5cf8c
       if (.not. flag ) then
Packit Service c5cf8c
          print *, "Did not find key1 in info1"
Packit Service c5cf8c
          errs = errs + 1
Packit Service c5cf8c
       else 
Packit Service c5cf8c
          if (value .ne. "value1") then
Packit Service c5cf8c
             print *, "Found wrong value (", value, "), expected value1"
Packit Service c5cf8c
             errs = errs + 1
Packit Service c5cf8c
          else
Packit Service c5cf8c
C     check for trailing blanks             
Packit Service c5cf8c
             do i=7,valuelen
Packit Service c5cf8c
                if (value(i:i) .ne. " ") then
Packit Service c5cf8c
                   print *, "Found non blank in info value"
Packit Service c5cf8c
                   errs = errs + 1
Packit Service c5cf8c
                endif
Packit Service c5cf8c
             enddo
Packit Service c5cf8c
          endif
Packit Service c5cf8c
       endif
Packit Service c5cf8c
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
       end