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/f5be9cdbf563dd55fa935967903241038e... commit f5be9cdbf563dd55fa935967903241038ed60fae Author: Antonio J. Pena <[email protected]> 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