[mpich-commits] [mpich] MPICH primary repository branch, master, updated. v3.0.2-57-gf5be9cd
mysql vizuser
noreply at mpich.org
Thu Feb 28 12:45:23 CST 2013
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "MPICH primary repository".
The branch, master has been updated
via f5be9cdbf563dd55fa935967903241038ed60fae (commit)
from 941dfe7d3552604d11426c14f26d8ec88f8391b7 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
http://git.mpich.org/mpich.git/commitdiff/f5be9cdbf563dd55fa935967903241038ed60fae
commit f5be9cdbf563dd55fa935967903241038ed60fae
Author: Antonio J. Pena <apenya at mcs.anl.gov>
Date: Wed Feb 27 11:39:23 2013 -0600
Fixed MPI_Get_elements returning wrong values
Fix bug #884. The routine was returning wrong results for derived
datatypes. Two comparisons have been fixed in PMPI_LOCAL MPI_Count
MPIR_Type_get_elements, src/mpi/datatype/get_elements_x.c. Two new
test cases, get_elems_d and get_elems_u have been provided in f90.
Reviewer: goodell
diff --git a/src/mpi/datatype/get_elements_x.c b/src/mpi/datatype/get_elements_x.c
index fe8eefc..a511452 100644
--- a/src/mpi/datatype/get_elements_x.c
+++ b/src/mpi/datatype/get_elements_x.c
@@ -147,7 +147,7 @@ PMPI_LOCAL MPI_Count MPIR_Type_get_basic_type_elements(MPI_Count *bytes_p,
* Arguments:
* - bytes_p - input/output byte count
* - count - maximum number of this type to subtract from the bytes; a count
- * of -1 indicates use as many as we like
+ * of <0 indicates use as many as we like
* - datatype - input datatype
*
* Returns number of elements available given the two constraints of number of
@@ -232,14 +232,14 @@ PMPI_LOCAL MPI_Count MPIR_Type_get_elements(MPI_Count *bytes_p,
* cycle through the types just as the struct would. thus the
* nested loops.
*
- * We need to keep going until we see a "0" elements returned
+ * We need to keep going until we get less elements than expected
* or we run out of bytes.
*/
last_nr_elements = 1; /* seed value */
for (j=0;
- (count == -1 || j < count) &&
+ (count < 0 || j < count) &&
*bytes_p > 0 && last_nr_elements > 0;
j++)
{
@@ -255,7 +255,7 @@ PMPI_LOCAL MPI_Count MPIR_Type_get_elements(MPI_Count *bytes_p,
MPIU_Assert(last_nr_elements >= 0);
- if (last_nr_elements == 0) break;
+ if (last_nr_elements < ints[i+1]) break;
}
}
return nr_elements;
diff --git a/test/mpi/f90/datatype/Makefile.ap b/test/mpi/f90/datatype/Makefile.ap
index 8046393..9f94666 100644
--- a/test/mpi/f90/datatype/Makefile.ap
+++ b/test/mpi/f90/datatype/Makefile.ap
@@ -1,6 +1,6 @@
## vim: set ft=automake :
-noinst_PROGRAMS += structf indtype createf90 sizeof kinds trf90
+noinst_PROGRAMS += structf indtype createf90 sizeof kinds trf90 get_elem_d get_elem_u
structf_SOURCES = structf.f90
indtype_SOURCES = indtype.f90
@@ -8,4 +8,6 @@ createf90_SOURCES = createf90.f90
sizeof_SOURCES = sizeof.f90
kinds_SOURCES = kinds.f90
trf90_SOURCES = trf90.f90
+get_elem_d_SOURCES = get_elem_d.f90
+get_elem_u_SOURCES = get_elem_u.f90
diff --git a/test/mpi/f90/datatype/get_elem_d.f90 b/test/mpi/f90/datatype/get_elem_d.f90
new file mode 100644
index 0000000..6b9edde
--- /dev/null
+++ b/test/mpi/f90/datatype/get_elem_d.f90
@@ -0,0 +1,124 @@
+! -*- Mode: Fortran; -*-
+!
+! (C) 2013 by Argonne National Laboratory.
+! See COPYRIGHT in top-level directory.
+!
+
+! Based on a test written by Jim Hoekstra on behalf of Cray, Inc.
+! see ticket #884 https://trac.mpich.org/projects/mpich/ticket/884
+
+program get_elem_d
+
+ use mpi
+ implicit none
+
+ integer, parameter :: verbose=0
+ integer, parameter :: cmax=100,dmax=100,imax=60
+ integer, parameter :: nb=2
+ integer :: comm,rank,size,dest,ierror,errs=0
+ integer :: status(MPI_STATUS_SIZE)
+ integer :: i,ii,count,ka,j,jj,k,kj,krat,tag=100
+ integer :: blklen(nb)=(/2,2/)
+ integer :: types(nb)=(/MPI_DOUBLE_PRECISION,MPI_INTEGER/)
+ integer(kind=MPI_ADDRESS_KIND) :: disp(nb)
+ integer :: newtype,ntlen,ians(0:23),ians0(0:3),ians1(20),ians2(20)
+ double precision :: dbuff(dmax), a
+ integer :: ibuff(imax)
+ character :: cbuff(cmax)='X'
+
+ call MPI_Init(ierror)
+ comm=MPI_COMM_WORLD
+ call MPI_Comm_size(comm, size, ierror)
+ dest=size-1
+ call MPI_Comm_rank(comm, rank, ierror)
+ call MPI_Sizeof (j, kj, ierror)
+ call MPI_Sizeof (a, ka, ierror)
+ ntlen=2*ka+2*kj
+ krat=ntlen/kj
+ disp=(/0,2*ka/)
+
+ ! calculate answers for expected i values for Get_elements with derived type
+ ians0(0)=ka
+ ians0(1)=2*ka
+ ians0(2)=2*ka+kj
+ ians0(3)=2*ka+2*kj
+ ii=0
+ do i=1,24
+ if (i .eq. ians0(ii)) ii=ii+1
+ ians1(i)=ii
+ enddo
+ if (rank == 0 .and. verbose > 0) print *, (ians1(k),k=1,24)
+ jj=0
+ do j=0,19,4
+ ians(j)=jj+ka/kj
+ ians(j+1)=jj+2*(ka/kj)
+ ians(j+2)=jj+2*(ka/kj)+1
+ ians(j+3)=jj+2*(ka/kj)+2
+ if (rank == 0 .and. verbose > 0) print *, (ians(k),k=j,j+3)
+ jj=jj+ntlen/kj
+ enddo
+ ii=0
+ do i=1,20
+ if (i .eq. ians(ii)) ii=ii+1
+ ians2(i)=ii
+ enddo
+ if (rank == 0 .and. verbose > 0) print *, (ians2(k),k=1,20)
+
+ if (verbose > 0) print *, MPI_UNDEFINED
+
+ call MPI_Type_create_struct(nb, blklen, disp, types, newtype, ierror)
+ call MPI_Type_commit(newtype, ierror)
+
+ do i=1,24
+ if (rank == 0) then
+ call MPI_Send(cbuff, i, MPI_BYTE, dest, 100, comm, ierror)
+
+ else if (rank == dest) then
+
+ ! first receive
+ call MPI_Recv(dbuff, dmax, newtype, 0, 100, comm, status, ierror)
+ ! check on MPI_Get_elements
+ call MPI_Get_elements(status, newtype, count, ierror)
+ if (count .ne. ians1(i)) then
+ errs=errs+1
+ write (*,fmt="(i2,' R1 Get_elements count=',i3,&
+ &' but should be ',i3)") i,count,ians1(i)
+ endif
+
+ else
+ ! other ranks do not participate
+ endif
+ enddo
+
+ do i=1,20
+ if (rank == 0) then
+ call MPI_Send(ibuff, i, MPI_INTEGER, dest, 100, comm, ierror)
+
+ else if (rank == dest) then
+
+ ! second receive
+ call MPI_Recv(dbuff, dmax, newtype, 0, 100, comm, status, ierror)
+ ! check on MPI_Get_elements
+ call MPI_Get_elements(status, newtype, count, ierror)
+ if (count .ne. ians2(i)) then
+ errs=errs+1
+ write (*,fmt="(i2,' R2 Get_elements count=',i3,&
+ &' but should be ',i3)") i,count,ians2(i)
+ endif
+ else
+ ! other ranks do not participate
+ endif
+ enddo
+
+ if (rank .eq. dest) then
+ if (errs .eq. 0) then
+ write (*,*) " No Errors"
+ else
+ print *, 'errs=',errs
+ endif
+ endif
+
+ call MPI_Type_free(newtype, ierror)
+ call MPI_Finalize(ierror)
+
+end program get_elem_d
diff --git a/test/mpi/f90/datatype/get_elem_u.f90 b/test/mpi/f90/datatype/get_elem_u.f90
new file mode 100644
index 0000000..aa9f8fe
--- /dev/null
+++ b/test/mpi/f90/datatype/get_elem_u.f90
@@ -0,0 +1,72 @@
+! -*- Mode: Fortran; -*-
+!
+! (C) 2013 by Argonne National Laboratory.
+! See COPYRIGHT in top-level directory.
+!
+
+! Based on a test written by Jim Hoekstra on behalf of Cray, Inc.
+! see ticket #884 https://trac.mpich.org/projects/mpich/ticket/884
+
+PROGRAM get_elem_u
+
+ USE mpi
+ IMPLICIT NONE
+ INTEGER RANK, SIZE, IERR, COMM, errs
+ INTEGER MAX, I, K, dest
+ INTEGER STATUS(MPI_STATUS_SIZE)
+
+ INTEGER, PARAMETER :: nb=2
+ INTEGER :: blklen(nb)=(/1,1/)
+ INTEGER :: types(nb)=(/MPI_DOUBLE_PRECISION,MPI_CHAR/)
+ INTEGER(kind=MPI_ADDRESS_KIND) :: disp(nb)=(/0,8/)
+
+ INTEGER, PARAMETER :: amax=200
+ INTEGER :: type1, type2, extent
+ REAL :: a(amax)
+
+ errs = 0
+ CALL MPI_Init( ierr )
+ COMM = MPI_COMM_WORLD
+ CALL MPI_Comm_rank(COMM,RANK,IERR)
+ CALL MPI_Comm_size(COMM,SIZE,IERR)
+ dest=size-1
+
+ CALL MPI_Type_create_struct(nb, blklen, disp, types, type1, ierr)
+ CALL MPI_Type_commit(type1, ierr)
+ CALL MPI_Type_extent(type1, extent, ierr)
+
+ CALL MPI_Type_contiguous(4, Type1, Type2, ierr)
+ CALL MPI_Type_commit(Type2, ierr)
+ CALL MPI_Type_extent(Type2, extent, ierr)
+
+ DO k=1,17
+
+ IF(rank .EQ. 0) THEN
+
+ ! send k copies of datatype Type1
+ CALL MPI_Send(a, k, Type1, dest, 0, comm, ierr)
+
+ ELSE IF (rank == dest) THEN
+
+ CALL MPI_Recv(a, 200, Type2, 0, 0, comm, status, ierr)
+ CALL MPI_Get_elements(status, Type2, i, ierr)
+ IF (i .NE. 2*k) THEN
+ errs = errs+1
+ PRINT *, "k=",k," MPI_Get_elements returns", i, ", but it should be", 2*k
+ END IF
+
+ ELSE
+ ! thix rank does not particupate
+ END IF
+ enddo
+
+ CALL MPI_Type_free(type1, ierr)
+ CALL MPI_Type_free(type2, ierr)
+
+ CALL MPI_Finalize( ierr )
+
+ IF(rank .EQ. 0 .AND. errs .EQ. 0) THEN
+ PRINT *, " No Errors"
+ END IF
+
+END PROGRAM get_elem_u
diff --git a/test/mpi/f90/datatype/testlist.ap b/test/mpi/f90/datatype/testlist.ap
index 77964f6..9a402a4 100644
--- a/test/mpi/f90/datatype/testlist.ap
+++ b/test/mpi/f90/datatype/testlist.ap
@@ -4,3 +4,5 @@ createf90 1
sizeof 1
kinds 2 mpiversion=2.2
trf90 1
+get_elem_d 2
+get_elem_u 2
-----------------------------------------------------------------------
Summary of changes:
src/mpi/datatype/get_elements_x.c | 8 +-
test/mpi/f90/datatype/Makefile.ap | 4 +-
test/mpi/f90/datatype/get_elem_d.f90 | 124 ++++++++++++++++++++++++++++++++++
test/mpi/f90/datatype/get_elem_u.f90 | 72 ++++++++++++++++++++
test/mpi/f90/datatype/testlist.ap | 2 +
5 files changed, 205 insertions(+), 5 deletions(-)
create mode 100644 test/mpi/f90/datatype/get_elem_d.f90
create mode 100644 test/mpi/f90/datatype/get_elem_u.f90
hooks/post-receive
--
MPICH primary repository
More information about the commits
mailing list