Add (some) mpich3 f77 tests

[simgrid.git] / 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 (file)
index 0000000..44e5b5e
--- /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