teshsuite/smpi/mpich3-test/f77/info/infotestf.f

   1 C -*- Mode: Fortran; -*-
   2 C
   3 C  (C) 2003 by Argonne National Laboratory.
   4 C      See COPYRIGHT in top-level directory.
   5 C
   6 C Simple info test
   7        program main
   8        implicit none
   9        include 'mpif.h'
  10        integer i1, i2
  11        integer i, errs, ierr
  12        integer valuelen
  13        parameter (valuelen=64)
  14        character*(valuelen) value
  15        logical flag
  16 C
  17        errs = 0
  18
  19        call MTest_Init( ierr )
  20
  21        call mpi_info_create( i1, ierr )
  22        call mpi_info_create( i2, ierr )
  23
  24        call mpi_info_set( i1, "key1", "value1", ierr )
  25        call mpi_info_set( i2, "key2", "value2", ierr )
  26
  27        call mpi_info_get( i1, "key2", valuelen, value, flag, ierr )
  28        if (flag) then
  29           print *, "Found key2 in info1"
  30           errs = errs + 1
  31        endif
  32
  33        call MPI_Info_get( i1, "key1", 64, value, flag, ierr )
  34        if (.not. flag ) then
  35           print *, "Did not find key1 in info1"
  36           errs = errs + 1
  37        else
  38           if (value .ne. "value1") then
  39              print *, "Found wrong value (", value, "), expected value1"
  40              errs = errs + 1
  41           else
  42 C     check for trailing blanks
  43              do i=7,valuelen
  44                 if (value(i:i) .ne. " ") then
  45                    print *, "Found non blank in info value"
  46                    errs = errs + 1
  47                 endif
  48              enddo
  49           endif
  50        endif
  51
  52        call mpi_info_free( i1, ierr )
  53        call mpi_info_free( i2, ierr )
  54
  55        call MTest_Finalize( errs )
  56        call MPI_Finalize( ierr )
  57        end