1
1

mpi_f08: correctly implements MPI_{COMM,TYPE,WIN}_{DUP,NULL_{COPY,DELETE}}_FN

Fixes open-mpi/ompi#1323
Этот коммит содержится в:
Gilles Gouaillardet 2016-02-02 13:36:55 +09:00
родитель 728a97c558
Коммит cda094afc7
5 изменённых файлов: 149 добавлений и 201 удалений

Просмотреть файл

@ -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

Просмотреть файл

@ -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

Просмотреть файл

@ -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

Просмотреть файл

@ -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

Просмотреть файл

@ -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"