X-Git-Url: http://info.iut-bm.univ-fcomte.fr/pub/gitweb/simgrid.git/blobdiff_plain/3f31053637ef02fcd96e3819683103686ce11992..9deda161a84a426d0ea75ec4bd9b8cdc3a4b28fb:/teshsuite/smpi/mpich3-test/f77/attr/attrmpi1f.f

diff --git a/teshsuite/smpi/mpich3-test/f77/attr/attrmpi1f.f b/teshsuite/smpi/mpich3-test/f77/attr/attrmpi1f.f
new file mode 100644
index 0000000000..44e5b5e3e1
--- /dev/null
+++ b/teshsuite/smpi/mpich3-test/f77/attr/attrmpi1f.f
@@ -0,0 +1,62 @@
+C -*- Mode: Fortran; -*- 
+C
+C  (C) 2003 by Argonne National Laboratory.
+C      See COPYRIGHT in top-level directory.
+C
+      program main
+      implicit none
+      include 'mpif.h'
+      integer value, wsize, wrank, extra, mykey
+      integer rvalue, svalue, ncomm
+      logical flag
+      integer ierr, errs
+C
+      errs = 0
+      call mtest_init( ierr )
+      call mpi_comm_size( MPI_COMM_WORLD, wsize, ierr )
+      call mpi_comm_rank( MPI_COMM_WORLD, wrank, ierr )
+C
+C     Simple attribute put and get
+C
+      call mpi_keyval_create( MPI_NULL_COPY_FN, MPI_NULL_DELETE_FN,
+     $     mykey, extra,ierr ) 
+      call mpi_attr_get( MPI_COMM_WORLD, mykey, value, flag, ierr )
+      if (flag) then
+         errs = errs + 1
+         print *,
+     $       "Did not get flag==.false. for attribute that was not set"
+      endif
+C
+      value = 1234567
+      svalue = value
+      call mpi_attr_put( MPI_COMM_WORLD, mykey, value, ierr )
+      value = -9876543
+      call mpi_attr_get( MPI_COMM_WORLD, mykey, rvalue, flag, ierr )
+      if (.not. flag) then
+         errs = errs + 1
+         print *, "Did not find attribute after set"
+      else
+         if (rvalue .ne. svalue) then
+            errs = errs + 1
+            print *, "Attribute value ", rvalue, " should be ", svalue
+         endif
+      endif
+      value = -123456
+      svalue = value
+      call mpi_attr_put( MPI_COMM_WORLD, mykey, value, ierr )
+      value = 987654
+      call mpi_attr_get( MPI_COMM_WORLD, mykey, rvalue, flag, ierr )
+      if (.not. flag) then
+         errs = errs + 1
+         print *, "Did not find attribute after set (neg)"
+      else
+         if (rvalue .ne. svalue) then
+            errs = errs + 1
+            print *, "Neg Attribute value ", rvalue," should be ",svalue
+         endif
+      endif
+C      
+      call mpi_keyval_free( mykey, ierr )
+      call mtest_finalize( errs )
+      call mpi_finalize( ierr )
+      end