From cda094afc7ea56f037a9363b7ab8c053b91e232f Mon Sep 17 00:00:00 2001 From: Gilles Gouaillardet Date: Tue, 2 Feb 2016 13:36:55 +0900 Subject: [PATCH] mpi_f08: correctly implements MPI_{COMM,TYPE,WIN}_{DUP,NULL_{COPY,DELETE}}_FN Fixes open-mpi/ompi#1323 --- ompi/mpi/fortran/use-mpi-f08/Makefile.am | 10 +- .../attr-fn-f08-callback-interfaces.h | 152 ------------------ .../conversion-fn-null-f08-interface.h | 35 ---- .../fortran/use-mpi-f08/mpi-f08-callbacks.F90 | 142 ++++++++++++++++ ompi/mpi/fortran/use-mpi-f08/mpi-f08.F90 | 11 +- 5 files changed, 149 insertions(+), 201 deletions(-) delete mode 100644 ompi/mpi/fortran/use-mpi-f08/attr-fn-f08-callback-interfaces.h delete mode 100644 ompi/mpi/fortran/use-mpi-f08/conversion-fn-null-f08-interface.h create mode 100644 ompi/mpi/fortran/use-mpi-f08/mpi-f08-callbacks.F90 diff --git a/ompi/mpi/fortran/use-mpi-f08/Makefile.am b/ompi/mpi/fortran/use-mpi-f08/Makefile.am index 99f599e99bb..78137e38653 100644 --- a/ompi/mpi/fortran/use-mpi-f08/Makefile.am +++ b/ompi/mpi/fortran/use-mpi-f08/Makefile.am @@ -43,8 +43,6 @@ noinst_LTLIBRARIES = $(module_sentinel_file) mpi-f08.lo: $(module_sentinel_file) mpi-f08.lo: mpi-f08.F90 mpi-f08.lo: mpi-f-interfaces-bind.h pmpi-f-interfaces-bind.h -mpi-f08.lo: attr-fn-f08-callback-interfaces.h -mpi-f08.lo: conversion-fn-null-f08-interface.h mpi-f08.lo: sizeof_f08.h # @@ -800,8 +798,6 @@ libmpi_usempif08_la_SOURCES = \ $(pmpi_api_files) \ mpi-f-interfaces-bind.h \ pmpi-f-interfaces-bind.h \ - attr-fn-f08-callback-interfaces.h \ - conversion-fn-null-f08-interface.h \ mpi-f08.F90 \ buffer_detach.c \ constants.h \ @@ -843,8 +839,6 @@ $(pmpi_api_lo_files): mpi-f08.lo mpi-f08.lo: $(module_sentinel_file) $(SIZEOF_H) mpi-f08.lo: mpi-f-interfaces-bind.h pmpi-f-interfaces-bind.h -mpi-f08.lo: attr-fn-f08-callback-interfaces.h -mpi-f08.lo: conversion-fn-null-f08-interface.h ########################################################################### @@ -854,6 +848,7 @@ libforce_usempif08_internal_modules_to_be_built_la_SOURCES = \ mpi-f08-types.F90 \ mpi-f08-interfaces.F90 \ mpi-f08-interfaces-callbacks.F90 \ + mpi-f08-callbacks.F90 \ pmpi-f08-interfaces.F90 config_h = \ @@ -873,6 +868,9 @@ mpi-f08-interfaces.lo: mpi-f08-interfaces-callbacks.lo mpi-f08-interfaces-callbacks.lo: $(config_h) mpi-f08-interfaces-callbacks.lo: mpi-f08-interfaces-callbacks.F90 mpi-f08-interfaces-callbacks.lo: mpi-f08-types.lo +mpi-f08-callbacks.lo: $(config_h) +mpi-f08-callbacks.lo: mpi-f08-callbacks.F90 +mpi-f08-callbacks.lo: mpi-f08-types.lo pmpi-f08-interfaces.lo: $(config_h) pmpi-f08-interfaces.lo: pmpi-f08-interfaces.F90 pmpi-f08-interfaces.lo: mpi-f08-interfaces-callbacks.lo diff --git a/ompi/mpi/fortran/use-mpi-f08/attr-fn-f08-callback-interfaces.h b/ompi/mpi/fortran/use-mpi-f08/attr-fn-f08-callback-interfaces.h deleted file mode 100644 index 769c5eaf312..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/attr-fn-f08-callback-interfaces.h +++ /dev/null @@ -1,152 +0,0 @@ -! -*- f90 -*- -! Copyright (c) 2004-2005 The Regents of the University of California. -! All rights reserved. -! Copyright (c) 2006-2014 Cisco Systems, Inc. All rights reserved. -! Copyright (c) 2013 Los Alamos National Security, LLC. All rights -! reserved. -! Copyright (c) 2015-2016 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! $COPYRIGHT$ -! -! Additional copyrights may follow -! -! $HEADER$ -! - -! -! F08 handle (e.g., Type(MPI_Comm)) pre-defined attribute callback -! function interfaces -! - -interface - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - subroutine MPI_NULL_COPY_FN( comm, comm_keyval, extra_state, & - attribute_val_in, attribute_val_out, & - flag, ierr ) - use mpi_f08_types - implicit none - type(MPI_Comm) :: comm - integer :: comm_keyval, extra_state - integer :: attribute_val_in, attribute_val_out, ierr - logical :: flag - end subroutine MPI_NULL_COPY_FN - - subroutine MPI_NULL_DELETE_FN( comm, comm_keyval, attribute_val_out, & - extra_state, ierr ) - use mpi_f08_types - implicit none - type(MPI_Comm) :: comm - integer :: comm_keyval, attribute_val_out, extra_state, ierr - end subroutine MPI_NULL_DELETE_FN - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - subroutine MPI_COMM_NULL_COPY_FN( comm, comm_keyval, extra_state, & - attribute_val_in, attribute_val_out, & - flag, ierr ) - use mpi_f08_types - implicit none - type(MPI_Comm) :: comm - integer :: comm_keyval - integer(kind=MPI_ADDRESS_KIND) :: extra_state, attribute_val_in, attribute_val_out - integer :: ierr - logical :: flag - end subroutine MPI_COMM_NULL_COPY_FN - - subroutine MPI_COMM_DUP_FN( comm, comm_keyval, extra_state, & - attribute_val_in, attribute_val_out, & - flag, ierr ) - use mpi_f08_types - implicit none - type(MPI_Comm) :: comm - integer :: comm_keyval - integer(kind=MPI_ADDRESS_KIND) :: extra_state, attribute_val_in, attribute_val_out - integer :: ierr - logical :: flag - end subroutine MPI_COMM_DUP_FN - - subroutine MPI_COMM_NULL_DELETE_FN(comm, comm_keyval, attribute_val_out, & - extra_state, ierr ) - use mpi_f08_types - implicit none - type(MPI_Comm) :: comm - integer :: comm_keyval - integer(kind=MPI_ADDRESS_KIND) :: attribute_val_out, extra_state - integer :: ierr - end subroutine MPI_COMM_NULL_DELETE_FN - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - subroutine MPI_TYPE_NULL_COPY_FN( type, type_keyval, extra_state, & - attribute_val_in, attribute_val_out, & - flag, ierr ) - use mpi_f08_types - implicit none - type(MPI_Datatype) :: type - integer :: type_keyval - integer(kind=MPI_ADDRESS_KIND) :: extra_state, attribute_val_in, attribute_val_out - integer :: ierr - logical :: flag - end subroutine MPI_TYPE_NULL_COPY_FN - - subroutine MPI_TYPE_DUP_FN( type, type_keyval, extra_state, & - attribute_val_in, attribute_val_out, & - flag, ierr ) - use mpi_f08_types - implicit none - type(MPI_Datatype) :: type - integer :: type_keyval - integer(kind=MPI_ADDRESS_KIND) :: extra_state, attribute_val_in, attribute_val_out - integer :: ierr - logical :: flag - end subroutine MPI_TYPE_DUP_FN - - subroutine MPI_TYPE_NULL_DELETE_FN( type, type_keyval, attribute_val_out, & - extra_state, ierr ) - use mpi_f08_types - implicit none - type(MPI_Datatype) :: type - integer :: type_keyval - integer(kind=MPI_ADDRESS_KIND) :: attribute_val_out, extra_state - integer :: ierr - end subroutine MPI_TYPE_NULL_DELETE_FN - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - subroutine MPI_WIN_NULL_COPY_FN( window, win_keyval, extra_state, & - attribute_val_in, attribute_val_out, & - flag, ierr ) - use mpi_f08_types - implicit none - type(MPI_Win) :: window - integer :: win_keyval - integer(kind=MPI_ADDRESS_KIND) :: extra_state, attribute_val_in, attribute_val_out - integer :: ierr - logical :: flag - end subroutine MPI_WIN_NULL_COPY_FN - - subroutine MPI_WIN_DUP_FN( window, win_keyval, extra_state, & - attribute_val_in, attribute_val_out, & - flag, ierr ) - use mpi_f08_types - implicit none - type(MPI_Win) :: window - integer :: win_keyval - integer(kind=MPI_ADDRESS_KIND) :: extra_state, attribute_val_in, attribute_val_out - integer :: ierr - logical :: flag - end subroutine MPI_WIN_DUP_FN - - subroutine MPI_WIN_NULL_DELETE_FN( window, win_keyval, attribute_val_out, & - extra_state, ierr ) - use mpi_f08_types - implicit none - type(MPI_Win) :: window - integer :: win_keyval - integer(kind=MPI_ADDRESS_KIND) :: attribute_val_out, extra_state - integer :: ierr - end subroutine MPI_WIN_NULL_DELETE_FN - -end interface diff --git a/ompi/mpi/fortran/use-mpi-f08/conversion-fn-null-f08-interface.h b/ompi/mpi/fortran/use-mpi-f08/conversion-fn-null-f08-interface.h deleted file mode 100644 index c653de6f49b..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/conversion-fn-null-f08-interface.h +++ /dev/null @@ -1,35 +0,0 @@ -! -*- f90 -*- -! Copyright (c) 2006-2014 Cisco Systems, Inc. All rights reserved. -! $COPYRIGHT$ -! -! Additional copyrights may follow -! -! $HEADER$ -! - -! Note about these declarations: these are "external" functions in -! mpif-common.h. However, if we don't declare them here, compilers will add -! them to the "mpi" module namespace, and result in linker errors if MPI -! F90 applications try to use them. because the implementations of -! these functions are not in the MPI module namespace -- they're the F77 -! functions. - -! -! F08 handle pre-defined conversion callback function interface -! - -interface - - subroutine MPI_CONVERSION_FN_NULL(userbuf, datatype, count, filebuf, & - position, extra_state, ierror) - use mpi_f08_types - implicit none - character(len=*), intent(in) :: filebuf - character(len=*), intent(out) :: userbuf - type(MPI_Datatype) :: datatype - integer, intent(in) :: count, ierror - integer(kind=MPI_OFFSET_KIND), intent(in) :: position - integer(kind=MPI_ADDRESS_KIND), intent(in) :: extra_state - end subroutine MPI_CONVERSION_FN_NULL - -end interface diff --git a/ompi/mpi/fortran/use-mpi-f08/mpi-f08-callbacks.F90 b/ompi/mpi/fortran/use-mpi-f08/mpi-f08-callbacks.F90 new file mode 100644 index 00000000000..d992702ef2e --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/mpi-f08-callbacks.F90 @@ -0,0 +1,142 @@ +! -*- f90 -*- +! Copyright (c) 2016 Research Organization for Information Science +! and Technology (RIST). All rights reserved. +! $COPYRIGHT$ + +#include "ompi/mpi/fortran/configure-fortran-output.h" + +module mpi_f08_callbacks + +! MPI3.1, p270, 5-19 + +contains + +subroutine MPI_COMM_DUP_FN(oldcomm,comm_keyval,extra_state, & + attribute_val_in,attribute_val_out,flag,ierror) + use mpi_f08_types + implicit none + type(MPI_Comm) :: oldcomm + integer :: comm_keyval, ierror + integer(kind=MPI_ADDRESS_KIND) :: extra_state, attribute_val_in, attribute_val_out + logical :: flag + + flag = .true. + attribute_val_out = attribute_val_in + ierror = MPI_SUCCESS +end subroutine + +subroutine MPI_COMM_NULL_COPY_FN(oldcomm,comm_keyval,extra_state, & + attribute_val_in,attribute_val_out,flag,ierror) + use mpi_f08_types + implicit none + type(MPI_Comm) :: oldcomm + integer :: comm_keyval, ierror + integer(kind=MPI_ADDRESS_KIND) :: extra_state, attribute_val_in, attribute_val_out + logical :: flag + + flag = .false. + ierror = MPI_SUCCESS +end subroutine + +subroutine MPI_COMM_NULL_DELETE_FN(comm,comm_keyval, & + attribute_val, extra_state, ierror) + use mpi_f08_types + implicit none + type(MPI_Comm) :: comm + integer :: comm_keyval, ierror + integer(kind=MPI_ADDRESS_KIND) :: attribute_val, extra_state + + ierror = MPI_SUCCESS +end subroutine + +subroutine MPI_TYPE_DUP_FN(oldtype,type_keyval,extra_state, & + attribute_val_in,attribute_val_out,flag,ierror) + use mpi_f08_types + implicit none + type(MPI_Datatype) :: oldtype + integer :: type_keyval, ierror + integer(kind=MPI_ADDRESS_KIND) :: extra_state, attribute_val_in, attribute_val_out + logical :: flag + + flag = .true. + attribute_val_out = attribute_val_in + ierror = MPI_SUCCESS +end subroutine + +subroutine MPI_TYPE_NULL_COPY_FN(oldtype,type_keyval,extra_state, & + attribute_val_in,attribute_val_out,flag,ierror) + use mpi_f08_types + implicit none + type(MPI_Datatype) :: oldtype + integer :: type_keyval, ierror + integer(kind=MPI_ADDRESS_KIND) :: extra_state, attribute_val_in, attribute_val_out + logical :: flag + + flag = .false. + ierror = MPI_SUCCESS +end subroutine + +subroutine MPI_TYPE_NULL_DELETE_FN(datatype,type_keyval, & + attribute_val, extra_state, ierror) + use mpi_f08_types + implicit none + type(MPI_Datatype) :: datatype + integer :: type_keyval, ierror + integer(kind=MPI_ADDRESS_KIND) :: attribute_val, extra_state + + ierror = MPI_SUCCESS +end subroutine + +subroutine MPI_WIN_DUP_FN(oldwin,win_keyval,extra_state, & + attribute_val_in,attribute_val_out,flag,ierror) + use mpi_f08_types + implicit none + type(MPI_Win) :: oldwin + integer :: win_keyval, ierror + integer(kind=MPI_ADDRESS_KIND) :: extra_state, attribute_val_in, attribute_val_out + logical :: flag + + flag = .true. + attribute_val_out = attribute_val_in + ierror = MPI_SUCCESS +end subroutine + +subroutine MPI_WIN_NULL_COPY_FN(oldwin,win_keyval,extra_state, & + attribute_val_in,attribute_val_out,flag,ierror) + use mpi_f08_types + implicit none + type(MPI_Win) :: oldwin + integer :: win_keyval, ierror + integer(kind=MPI_ADDRESS_KIND) :: extra_state, attribute_val_in, attribute_val_out + logical :: flag + + flag = .false. + ierror = MPI_SUCCESS +end subroutine + +subroutine MPI_WIN_NULL_DELETE_FN(win,win_keyval, & + attribute_val, extra_state, ierror) + use mpi_f08_types + implicit none + type(MPI_Win) :: win + integer :: win_keyval, ierror + integer(kind=MPI_ADDRESS_KIND) :: attribute_val, extra_state + + ierror = MPI_SUCCESS +end subroutine + +subroutine MPI_CONVERSION_FN_NULL(userbuf, datatype, count, & + filebuf, position, extra_state, ierror) + use, intrinsic :: iso_c_binding, only : c_ptr + use mpi_f08_types + implicit none + type(c_ptr), value :: userbuf, filebuf + type(MPI_Datatype) :: datatype + integer :: count, ierror + integer(kind=MPI_OFFSET_KIND) :: position + integer(kind=MPI_ADDRESS_KIND) :: extra_state + + ! Do nothing +end subroutine + +end module mpi_f08_callbacks diff --git a/ompi/mpi/fortran/use-mpi-f08/mpi-f08.F90 b/ompi/mpi/fortran/use-mpi-f08/mpi-f08.F90 index a7afe220167..43b6cb09109 100644 --- a/ompi/mpi/fortran/use-mpi-f08/mpi-f08.F90 +++ b/ompi/mpi/fortran/use-mpi-f08/mpi-f08.F90 @@ -13,6 +13,8 @@ ! Copyright (c) 2006-2014 Cisco Systems, Inc. All rights reserved. ! Copyright (c) 2009-2012 Los Alamos National Security, LLC. ! All rights reserved. +! Copyright (c) 2016 Research Organization for Information Science +! and Technology (RIST). All rights reserved. ! $COPYRIGHT$ ! ! Additional copyrights may follow @@ -27,6 +29,7 @@ module mpi_f08 use mpi_f08_types use mpi_f08_interfaces ! this module contains the mpi_f08 interface declarations use pmpi_f08_interfaces ! this module contains the pmpi_f08 interface declarations + use mpi_f08_callbacks ! this module contains the mpi_f08 attribute callback subroutines ! ! Declaration of the interfaces to the ompi impl files @@ -35,14 +38,6 @@ module mpi_f08 #include "mpi-f-interfaces-bind.h" #include "pmpi-f-interfaces-bind.h" -! The MPI attribute callback functions - - include "attr-fn-f08-callback-interfaces.h" - -! The MPI_CONVERSION_FN_NULL function - - include "conversion-fn-null-f08-interface.h" - ! The sizeof interfaces include "sizeof_f08.h"