From e965f45d0f25f728ae2ccf8dc5acbf820685e1e3 Mon Sep 17 00:00:00 2001 From: Mark Allen Date: Fri, 10 Sep 2021 13:50:41 -0400 Subject: [PATCH] let Fortran array match caller of different rank (in ignore_tkr) The below example program uses a 2d array for requests and that gets rejected by the type/kind/rank checking when the MPI_Waitall module says the incoming argument should be an array. program main use mpi integer, contiguous, pointer :: requests(:, :) integer :: ierr, sbuf1, sbuf2, rbuf1, rbuf2 allocate(requests(2,2)) call MPI_Init(ierr) sbuf1 = 1 sbuf2 = 2 rbuf1 = -1 rbuf2 = -1 call MPI_Irecv(rbuf1, 1, MPI_INTEGER, 0, 99, MPI_COMM_SELF, requests(1,1), ierr) call MPI_Irecv(rbuf2, 1, MPI_INTEGER, 0, 99, MPI_COMM_SELF, requests(1,2), ierr) call MPI_Isend(sbuf1, 1, MPI_INTEGER, 0, 99, MPI_COMM_SELF, requests(2,1), ierr) call MPI_Isend(sbuf2, 1, MPI_INTEGER, 0, 99, MPI_COMM_SELF, requests(2,2), ierr) call MPI_Waitall(size(requests), requests, MPI_STATUSES_IGNORE, ierr) print *, 'rbufs:', rbuf1, rbuf2 if (rbuf1 .ne. 1 .or. rbuf2 .ne. 2) then print *, 'failed' call MPI_Abort(MPI_COMM_WORLD, MPI_ERR_OTHER, ierr) else print *, 'passed' endif call MPI_Finalize(ierr) end % mpifort -o x mpi.F90 > "mpi.F90", line 15.6: 1513-062 (S) Generic procedure reference > can not be resolved due to incorrect actual argument attributes. > ** main === End of Compilation 1 === > 1501-511 Compilation failed for file mpi.F90. The above is XLF, but gfortran is similar. This commit changes array_of_requests and a bunch of other arrays from integer, dimension(count), intent(inout) :: array_of_requests to @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ array_of_requests @OMPI_FORTRAN_IGNORE_TKR_TYPE@, intent(inout) :: array_of_requests This approach throws away more than just the rank check, so for example it would now start failing to detect if an array of reals was passed in as a request array. But I didn't find a good way to be more targeted. Some compilers can be more targeted, eg XLF can use integer count !ibm* ignore_tkr (r) array integer, dimension(count) :: array but gfortran as far as I know doesn't have an equivalent, and only has integer count !GCC$ ATTRIBUTES NO_ARG_CHECK :: array type(*), dimension(*) :: array but the macro system would have to provide a lot more than settings for OMPI_FORTRAN_IGNORE_TKR_PREDECL and OMPI_FORTRAN_IGNORE_TKR_TYPE to produce that code. Plus XLF recognizes the gfortran pragmas so it takes the gfortran path in configure so it wouldn't necessarily even take the more targeted path if we did provide it. Signed-off-by: Mark Allen --- .../mpi-ignore-tkr-interfaces.h.in | 85 ++++++++++++------- 1 file changed, 56 insertions(+), 29 deletions(-) diff --git a/ompi/mpi/fortran/use-mpi-ignore-tkr/mpi-ignore-tkr-interfaces.h.in b/ompi/mpi/fortran/use-mpi-ignore-tkr/mpi-ignore-tkr-interfaces.h.in index 0a636d2be48..32e5a9c77ac 100644 --- a/ompi/mpi/fortran/use-mpi-ignore-tkr/mpi-ignore-tkr-interfaces.h.in +++ b/ompi/mpi/fortran/use-mpi-ignore-tkr/mpi-ignore-tkr-interfaces.h.in @@ -982,7 +982,8 @@ subroutine MPI_Comm_spawn(command, argv, maxprocs, info, root, & integer, intent(in) :: root integer, intent(in) :: comm integer, intent(out) :: intercomm - integer, dimension(*), intent(out) :: array_of_errcodes + @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ array_of_errcodes + @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: array_of_errcodes integer, intent(out) :: ierror end subroutine MPI_Comm_spawn @@ -996,12 +997,15 @@ subroutine MPI_Comm_spawn_multiple(count, array_of_commands, array_of_argv, arra integer, intent(in) :: count character(len=*), dimension(*), intent(in) :: array_of_commands character(len=*), dimension(count, *), intent(in) :: array_of_argv - integer, dimension(*), intent(in) :: array_of_maxprocs - integer, dimension(*), intent(in) :: array_of_info + @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ array_of_maxprocs + @OMPI_FORTRAN_IGNORE_TKR_TYPE@, intent(in) :: array_of_maxprocs + @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ array_of_info + @OMPI_FORTRAN_IGNORE_TKR_TYPE@, intent(in) :: array_of_info integer, intent(in) :: root integer, intent(in) :: comm integer, intent(out) :: intercomm - integer, dimension(*), intent(out) :: array_of_errcodes + @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ array_of_errcodes + @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: array_of_errcodes integer, intent(out) :: ierror end subroutine MPI_Comm_spawn_multiple @@ -3603,7 +3607,8 @@ interface MPI_Startall subroutine MPI_Startall(count, array_of_requests, ierror) integer, intent(in) :: count - integer, dimension(*), intent(inout) :: array_of_requests + @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ array_of_requests + @OMPI_FORTRAN_IGNORE_TKR_TYPE@, intent(inout) :: array_of_requests integer, intent(out) :: ierror end subroutine MPI_Startall @@ -3678,9 +3683,11 @@ interface MPI_Testall subroutine MPI_Testall(count, array_of_requests, flag, array_of_statuses, ierror) include 'mpif-config.h' integer, intent(in) :: count - integer, dimension(count), intent(inout) :: array_of_requests + @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ array_of_requests + @OMPI_FORTRAN_IGNORE_TKR_TYPE@, intent(inout) :: array_of_requests logical, intent(out) :: flag - integer, dimension(MPI_STATUS_SIZE, *), intent(out) :: array_of_statuses + @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ array_of_statuses + @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: array_of_statuses integer, intent(out) :: ierror end subroutine MPI_Testall @@ -3693,7 +3700,8 @@ subroutine MPI_Testany(count, array_of_requests, index, flag, status& , ierror) include 'mpif-config.h' integer, intent(in) :: count - integer, dimension(count), intent(inout) :: array_of_requests + @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ array_of_requests + @OMPI_FORTRAN_IGNORE_TKR_TYPE@, intent(inout) :: array_of_requests integer, intent(out) :: index logical, intent(out) :: flag integer, dimension(MPI_STATUS_SIZE), intent(out) :: status @@ -3709,10 +3717,13 @@ subroutine MPI_Testsome(incount, array_of_requests, outcount, array_of_indices, , ierror) include 'mpif-config.h' integer, intent(in) :: incount - integer, dimension(incount), intent(inout) :: array_of_requests + @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ array_of_requests + @OMPI_FORTRAN_IGNORE_TKR_TYPE@, intent(inout) :: array_of_requests integer, intent(out) :: outcount - integer, dimension(*), intent(out) :: array_of_indices - integer, dimension(MPI_STATUS_SIZE, *), intent(out) :: array_of_statuses + @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ array_of_indices + @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: array_of_indices + @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ array_of_statuses + @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: array_of_statuses integer, intent(out) :: ierror end subroutine MPI_Testsome @@ -3813,8 +3824,10 @@ subroutine MPI_Type_create_hindexed(count, array_of_blocklengths, array_of_displ , ierror) include 'mpif-config.h' integer, intent(in) :: count - integer, dimension(*), intent(in) :: array_of_blocklengths - integer(kind=MPI_ADDRESS_KIND), dimension(*), intent(in) :: array_of_displacements + @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ array_of_blocklengths + @OMPI_FORTRAN_IGNORE_TKR_TYPE@, intent(in) :: array_of_blocklengths + @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ array_of_displacements + @OMPI_FORTRAN_IGNORE_TKR_TYPE@, intent(in) :: array_of_displacements integer, intent(in) :: oldtype integer, intent(out) :: newtype integer, intent(out) :: ierror @@ -3830,7 +3843,8 @@ subroutine MPI_Type_create_hindexed_block(count, blocklength, array_of_displacem include 'mpif-config.h' integer, intent(in) :: count integer, intent(in) :: blocklength - integer(kind=MPI_ADDRESS_KIND), dimension(*), intent(in) :: array_of_displacements + @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ array_of_displacements + @OMPI_FORTRAN_IGNORE_TKR_TYPE@, intent(in) :: array_of_displacements integer, intent(in) :: oldtype integer, intent(out) :: newtype integer, intent(out) :: ierror @@ -3861,7 +3875,8 @@ subroutine MPI_Type_create_indexed_block(count, blocklength, array_of_displaceme , ierror) integer, intent(in) :: count integer, intent(in) :: blocklength - integer, dimension(*), intent(in) :: array_of_displacements + @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ array_of_displacements + @OMPI_FORTRAN_IGNORE_TKR_TYPE@, intent(in) :: array_of_displacements integer, intent(in) :: oldtype integer, intent(out) :: newtype integer, intent(out) :: ierror @@ -3904,9 +3919,12 @@ subroutine MPI_Type_create_struct(count, array_of_block_lengths, array_of_displa , ierror) include 'mpif-config.h' integer, intent(in) :: count - integer, dimension(*), intent(in) :: array_of_block_lengths - integer(kind=MPI_ADDRESS_KIND), dimension(*), intent(in) :: array_of_displacements - integer, dimension(*), intent(in) :: array_of_types + @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ array_of_block_lengths + @OMPI_FORTRAN_IGNORE_TKR_TYPE@, intent(in) :: array_of_block_lengths + @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ array_of_displacements + @OMPI_FORTRAN_IGNORE_TKR_TYPE@, intent(in) :: array_of_displacements + @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ array_of_types + @OMPI_FORTRAN_IGNORE_TKR_TYPE@, intent(in) :: array_of_types integer, intent(out) :: newtype integer, intent(out) :: ierror end subroutine MPI_Type_create_struct @@ -3996,9 +4014,10 @@ subroutine MPI_Type_get_contents(datatype, max_integers, max_addresses, max_data integer, intent(in) :: max_integers integer, intent(in) :: max_addresses integer, intent(in) :: max_datatypes - integer, dimension(*), intent(out) :: array_of_integers - integer(kind=MPI_ADDRESS_KIND), dimension(*), intent(out) :: array_of_addresses - integer, dimension(*), intent(out) :: array_of_datatypes + @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ array_of_integers + @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: array_of_integers + integer(kind=MPI_ADDRESS_KIND), dimension(*) :: array_of_addresses + integer, dimension(*) :: array_of_datatypes integer, intent(out) :: ierror end subroutine MPI_Type_get_contents @@ -4089,8 +4108,10 @@ interface MPI_Type_indexed subroutine MPI_Type_indexed(count, array_of_blocklengths, array_of_displacements, oldtype, newtype& , ierror) integer, intent(in) :: count - integer, dimension(*), intent(in) :: array_of_blocklengths - integer, dimension(*), intent(in) :: array_of_displacements + @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ array_of_blocklengths + @OMPI_FORTRAN_IGNORE_TKR_TYPE@, intent(in) :: array_of_blocklengths + @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ array_of_displacements + @OMPI_FORTRAN_IGNORE_TKR_TYPE@, intent(in) :: array_of_displacements integer, intent(in) :: oldtype integer, intent(out) :: newtype integer, intent(out) :: ierror @@ -4241,8 +4262,10 @@ interface MPI_Waitall subroutine MPI_Waitall(count, array_of_requests, array_of_statuses, ierror) include 'mpif-config.h' integer, intent(in) :: count - integer, dimension(count), intent(inout) :: array_of_requests - integer, dimension(MPI_STATUS_SIZE, *), intent(out) :: array_of_statuses + @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ array_of_requests + @OMPI_FORTRAN_IGNORE_TKR_TYPE@, intent(inout) :: array_of_requests + @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ array_of_statuses + @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: array_of_statuses integer, intent(out) :: ierror end subroutine MPI_Waitall @@ -4254,7 +4277,8 @@ interface MPI_Waitany subroutine MPI_Waitany(count, array_of_requests, index, status, ierror) include 'mpif-config.h' integer, intent(in) :: count - integer, dimension(count), intent(inout) :: array_of_requests + @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ array_of_requests + @OMPI_FORTRAN_IGNORE_TKR_TYPE@, intent(inout) :: array_of_requests integer, intent(out) :: index integer, dimension(MPI_STATUS_SIZE), intent(out) :: status integer, intent(out) :: ierror @@ -4269,10 +4293,13 @@ subroutine MPI_Waitsome(incount, array_of_requests, outcount, array_of_indices, , ierror) include 'mpif-config.h' integer, intent(in) :: incount - integer, dimension(incount), intent(inout) :: array_of_requests + @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ array_of_requests + @OMPI_FORTRAN_IGNORE_TKR_TYPE@, intent(inout) :: array_of_requests integer, intent(out) :: outcount - integer, dimension(*), intent(out) :: array_of_indices - integer, dimension(MPI_STATUS_SIZE, *), intent(out) :: array_of_statuses + @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ array_of_indices + @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: array_of_indices + @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ array_of_statuses + @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: array_of_statuses integer, intent(out) :: ierror end subroutine MPI_Waitsome