fortran/use-mpi-f08: add CFI support for pack subroutines

Signed-off-by: Gilles Gouaillardet <gilles@rist.or.jp>

Author: ggouaillardet

ompi/mpi/fortran/use-mpi-f08/bindings/mpi-f-interfaces-bind.h.in

@@ -581,10 +581,10 @@ end subroutine ompi_get_elements_x_f
 
 subroutine ompi_pack_f(inbuf,incount,datatype,outbuf,outsize, &
                        position,comm,ierror) &
-   BIND(C, name="ompi_pack_f")
+   BIND(C, name="ompi_pack_@OMPI_F08_BINDINGS_EXTENSION@")
    implicit none
-   OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf
-   OMPI_FORTRAN_IGNORE_TKR_TYPE :: outbuf
+   OMPI_F08_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf
+   OMPI_F08_IGNORE_TKR_TYPE :: outbuf
    INTEGER, INTENT(IN) :: incount, outsize
    INTEGER, INTENT(IN) :: datatype
    INTEGER, INTENT(INOUT) :: position
@@ -594,13 +594,13 @@ end subroutine ompi_pack_f
 
 subroutine ompi_pack_external_f(datarep,inbuf,incount,datatype, &
                                 outbuf,outsize,position,ierror,datarep_len) &
-   BIND(C, name="ompi_pack_external_f")
+   BIND(C, name="ompi_pack_external_@OMPI_F08_BINDINGS_EXTENSION@")
    use, intrinsic :: ISO_C_BINDING, only : C_CHAR
    use :: mpi_f08_types, only : MPI_ADDRESS_KIND
    implicit none
    CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: datarep
-   OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf
-   OMPI_FORTRAN_IGNORE_TKR_TYPE :: outbuf
+   OMPI_F08_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf
+   OMPI_F08_IGNORE_TKR_TYPE :: outbuf
    INTEGER, INTENT(IN) :: incount
    INTEGER, INTENT(IN) :: datatype
    INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: outsize
@@ -855,10 +855,10 @@ end subroutine ompi_type_vector_f
 
 subroutine ompi_unpack_f(inbuf,insize,position,outbuf,outcount, &
                          datatype,comm,ierror) &
-   BIND(C, name="ompi_unpack_f")
+   BIND(C, name="ompi_unpack_@OMPI_F08_BINDINGS_EXTENSION@")
    implicit none
-   OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf
-   OMPI_FORTRAN_IGNORE_TKR_TYPE :: outbuf
+   OMPI_F08_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf
+   OMPI_F08_IGNORE_TKR_TYPE :: outbuf
    INTEGER, INTENT(IN) :: insize, outcount
    INTEGER, INTENT(INOUT) :: position
    INTEGER, INTENT(IN) :: datatype
@@ -868,13 +868,13 @@ end subroutine ompi_unpack_f
 
 subroutine ompi_unpack_external_f(datarep,inbuf,insize,position, &
                                   outbuf,outcount,datatype,ierror,datarep_len) &
-   BIND(C, name="ompi_unpack_external_f")
+   BIND(C, name="ompi_unpack_external_@OMPI_F08_BINDINGS_EXTENSION@")
    use, intrinsic :: ISO_C_BINDING, only : C_CHAR
    use :: mpi_f08_types, only : MPI_ADDRESS_KIND
    implicit none
    CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: datarep
-   OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf
-   OMPI_FORTRAN_IGNORE_TKR_TYPE :: outbuf
+   OMPI_F08_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf
+   OMPI_F08_IGNORE_TKR_TYPE :: outbuf
    INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: insize
    INTEGER(MPI_ADDRESS_KIND), INTENT(INOUT) :: position
    INTEGER, INTENT(IN) :: outcount

ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-interfaces.h.in

@@ -714,39 +714,39 @@ end subroutine MPI_Get_elements_x_f08
 end interface  MPI_Get_elements_x
 
 interface  MPI_Pack
-subroutine MPI_Pack_f08(inbuf,incount,datatype,outbuf,outsize,position,comm,ierror)
+subroutine MPI_Pack_f08@OMPI_F08_BINDINGS_TS_SUFFIX@(inbuf,incount,datatype,outbuf,outsize,position,comm,ierror)
    use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm
    implicit none
-   @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ inbuf, outbuf
-   @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: inbuf
-   @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: outbuf
+   @OMPI_F08_IGNORE_TKR_PREDECL@ inbuf, outbuf
+   @OMPI_F08_IGNORE_TKR_TYPE@, INTENT(IN) :: inbuf
+   @OMPI_F08_IGNORE_TKR_TYPE@ :: outbuf
    INTEGER, INTENT(IN) :: incount, outsize
    TYPE(MPI_Datatype), INTENT(IN) :: datatype
    INTEGER, INTENT(INOUT) :: position
    TYPE(MPI_Comm), INTENT(IN) :: comm
    INTEGER, OPTIONAL, INTENT(OUT) :: ierror
-end subroutine MPI_Pack_f08
+end subroutine MPI_Pack_f08@OMPI_F08_BINDINGS_TS_SUFFIX@
 end interface  MPI_Pack
 
 interface  MPI_Pack_external
-subroutine MPI_Pack_external_f08(datarep,inbuf,incount,datatype,outbuf,outsize, &
+subroutine MPI_Pack_external_f08@OMPI_F08_BINDINGS_TS_SUFFIX@(datarep,inbuf,incount,datatype,outbuf,outsize, &
                                  position,ierror)
    use :: mpi_f08_types, only : MPI_Datatype, MPI_ADDRESS_KIND
    implicit none
    CHARACTER(LEN=*), INTENT(IN) :: datarep
-   @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ inbuf, outbuf
-   @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: inbuf
-   @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: outbuf
+   @OMPI_F08_IGNORE_TKR_PREDECL@ inbuf, outbuf
+   @OMPI_F08_IGNORE_TKR_TYPE@, INTENT(IN) :: inbuf
+   @OMPI_F08_IGNORE_TKR_TYPE@ :: outbuf
    INTEGER, INTENT(IN) :: incount
    TYPE(MPI_Datatype), INTENT(IN) :: datatype
    INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: outsize
    INTEGER(MPI_ADDRESS_KIND), INTENT(INOUT) :: position
    INTEGER, OPTIONAL, INTENT(OUT) :: ierror
-end subroutine MPI_Pack_external_f08
+end subroutine MPI_Pack_external_f08@OMPI_F08_BINDINGS_TS_SUFFIX@
 end interface  MPI_Pack_external
 
 interface  MPI_Pack_external_size
-subroutine MPI_Pack_external_size_f08(datarep,incount,datatype,size,ierror &
+subroutine MPI_Pack_external_size_f08@OMPI_F08_BINDINGS_TS_SUFFIX@(datarep,incount,datatype,size,ierror &
            )
    use :: mpi_f08_types, only : MPI_Datatype, MPI_ADDRESS_KIND
    implicit none
@@ -755,7 +755,7 @@ subroutine MPI_Pack_external_size_f08(datarep,incount,datatype,size,ierror &
    CHARACTER(LEN=*), INTENT(IN) :: datarep
    INTEGER(MPI_ADDRESS_KIND), INTENT(OUT) :: size
    INTEGER, OPTIONAL, INTENT(OUT) :: ierror
-end subroutine MPI_Pack_external_size_f08
+end subroutine MPI_Pack_external_size_f08@OMPI_F08_BINDINGS_TS_SUFFIX@
 end interface  MPI_Pack_external_size
 
 interface  MPI_Pack_size
@@ -1026,37 +1026,37 @@ end subroutine MPI_Type_vector_f08
 end interface  MPI_Type_vector
 
 interface  MPI_Unpack
-subroutine MPI_Unpack_f08(inbuf,insize,position,outbuf,outcount,datatype,comm, &
+subroutine MPI_Unpack_f08@OMPI_F08_BINDINGS_TS_SUFFIX@(inbuf,insize,position,outbuf,outcount,datatype,comm, &
                           ierror)
    use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm
    implicit none
-   @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ inbuf, outbuf
-   @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: inbuf
-   @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: outbuf
+   @OMPI_F08_IGNORE_TKR_PREDECL@ inbuf, outbuf
+   @OMPI_F08_IGNORE_TKR_TYPE@, INTENT(IN) :: inbuf
+   @OMPI_F08_IGNORE_TKR_TYPE@ :: outbuf
    INTEGER, INTENT(IN) :: insize, outcount
    INTEGER, INTENT(INOUT) :: position
    TYPE(MPI_Datatype), INTENT(IN) :: datatype
    TYPE(MPI_Comm), INTENT(IN) :: comm
    INTEGER, OPTIONAL, INTENT(OUT) :: ierror
-end subroutine MPI_Unpack_f08
+end subroutine MPI_Unpack_f08@OMPI_F08_BINDINGS_TS_SUFFIX@
 end interface  MPI_Unpack
 
 interface  MPI_Unpack_external
-subroutine MPI_Unpack_external_f08(datarep,inbuf,insize,position,outbuf,outcount, &
+subroutine MPI_Unpack_external_f08@OMPI_F08_BINDINGS_TS_SUFFIX@(datarep,inbuf,insize,position,outbuf,outcount, &
                                    datatype,ierror &
            )
    use :: mpi_f08_types, only : MPI_Datatype, MPI_ADDRESS_KIND
    implicit none
    CHARACTER(LEN=*), INTENT(IN) :: datarep
-   @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ inbuf, outbuf
-   @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: inbuf
-   @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: outbuf
+   @OMPI_F08_IGNORE_TKR_PREDECL@ inbuf, outbuf
+   @OMPI_F08_IGNORE_TKR_TYPE@, INTENT(IN) :: inbuf
+   @OMPI_F08_IGNORE_TKR_TYPE@ :: outbuf
    INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: insize
    INTEGER(MPI_ADDRESS_KIND), INTENT(INOUT) :: position
    INTEGER, INTENT(IN) :: outcount
    TYPE(MPI_Datatype), INTENT(IN) :: datatype
    INTEGER, OPTIONAL, INTENT(OUT) :: ierror
-end subroutine MPI_Unpack_external_f08
+end subroutine MPI_Unpack_external_f08@OMPI_F08_BINDINGS_TS_SUFFIX@
 end interface  MPI_Unpack_external
 
 interface  MPI_Allgather

ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-rename.h.in

@@ -137,9 +137,11 @@
 #define MPI_Get_elements_x PMPI_Get_elements_x
 #define MPI_Get_elements_x_f08 PMPI_Get_elements_x_f08
 #define MPI_Pack PMPI_Pack
-#define MPI_Pack_f08 PMPI_Pack_f08
+#define MPI_Pack_f08 PMPI_Pack_f08@OMPI_F08_BINDINGS_TS_SUFFIX@
+#define MPI_Pack_f08ts PMPI_Pack_f08s
 #define MPI_Pack_external PMPI_Pack_external
-#define MPI_Pack_external_f08 PMPI_Pack_external_f08
+#define MPI_Pack_external_f08 PMPI_Pack_external_f08@OMPI_F08_BINDINGS_TS_SUFFIX@
+#define MPI_Pack_external_f08ts PMPI_Pack_external_f08ts
 #define MPI_Pack_external_size PMPI_Pack_external_size
 #define MPI_Pack_external_size_f08 PMPI_Pack_external_size_f08
 #define MPI_Pack_size PMPI_Pack_size
@@ -189,9 +191,11 @@
 #define MPI_Type_vector PMPI_Type_vector
 #define MPI_Type_vector_f08 PMPI_Type_vector_f08
 #define MPI_Unpack PMPI_Unpack
-#define MPI_Unpack_f08 PMPI_Unpack_f08
+#define MPI_Unpack_f08 PMPI_Unpack_f08@OMPI_F08_BINDINGS_TS_SUFFIX@
+#define MPI_Unpack_f08ts PMPI_Unpack_f08ts
 #define MPI_Unpack_external PMPI_Unpack_external
-#define MPI_Unpack_external_f08 PMPI_Unpack_external_f08
+#define MPI_Unpack_external_f08 PMPI_Unpack_external_f08@OMPI_F08_BINDINGS_TS_SUFFIX@
+#define MPI_Unpack_external_f08ts PMPI_Unpack_external_f08ts
 #define MPI_Allgather PMPI_Allgather
 #define MPI_Allgather_f08 PMPI_Allgather_f08
 #define MPI_Iallgather PMPI_Iallgather
@@ -840,6 +844,10 @@
 #define MPI_Ssend_f08 MPI_Ssend_f08@OMPI_F08_BINDINGS_TS_SUFFIX@
 #define MPI_Ssend_init_f08 MPI_Ssend_init_f08@OMPI_F08_BINDINGS_TS_SUFFIX@
 #define MPI_Get_address_f08 MPI_Get_address_f08@OMPI_F08_BINDINGS_TS_SUFFIX@
+#define MPI_Pack_f08 MPI_Pack_f08@OMPI_F08_BINDINGS_TS_SUFFIX@
+#define MPI_Pack_external_f08 MPI_Pack_external_f08@OMPI_F08_BINDINGS_TS_SUFFIX@
+#define MPI_Unpack_f08 MPI_Unpack_f08@OMPI_F08_BINDINGS_TS_SUFFIX@
+#define MPI_Unpack_external_f08 MPI_Unpack_external_f08@OMPI_F08_BINDINGS_TS_SUFFIX@
 #define MPI_Free_mem_f08 MPI_Free_mem_f08@OMPI_F08_BINDINGS_TS_SUFFIX@
 #define MPI_F_sync_reg_f08 MPI_F_sync_reg_f08@OMPI_F08_BINDINGS_TS_SUFFIX@
 #define MPI_Imrecv_f08 MPI_Imrecv_f08@OMPI_F08_BINDINGS_TS_SUFFIX@

ompi/mpi/fortran/use-mpi-f08/pack_external_f08.F90

@@ -18,8 +18,8 @@ subroutine MPI_Pack_external_f08(datarep,inbuf,incount,datatype,outbuf,outsize,
    use :: ompi_mpifh_bindings, only : ompi_pack_external_f
    implicit none
    CHARACTER(LEN=*), INTENT(IN) :: datarep
-   OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf
-   OMPI_FORTRAN_IGNORE_TKR_TYPE :: outbuf
+   OMPI_F08_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf
+   OMPI_F08_IGNORE_TKR_TYPE :: outbuf
    INTEGER, INTENT(IN) :: incount
    TYPE(MPI_Datatype), INTENT(IN) :: datatype
    INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: outsize

ompi/mpi/fortran/use-mpi-f08/pack_f08.F90

@@ -16,8 +16,8 @@ subroutine MPI_Pack_f08(inbuf,incount,datatype,outbuf,outsize,position,comm,ierr
    use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm
    use :: ompi_mpifh_bindings, only : ompi_pack_f
    implicit none
-   OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf
-   OMPI_FORTRAN_IGNORE_TKR_TYPE :: outbuf
+   OMPI_F08_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf
+   OMPI_F08_IGNORE_TKR_TYPE :: outbuf
    INTEGER, INTENT(IN) :: incount, outsize
    TYPE(MPI_Datatype), INTENT(IN) :: datatype
    INTEGER, INTENT(INOUT) :: position

ompi/mpi/fortran/use-mpi-f08/ts/Makefile.am

@@ -47,6 +47,8 @@ libusempif08_ts_la_SOURCES = \
         isend_ts.c \
         issend_ts.c \
         mrecv_ts.c \
+        pack_ts.c \
+        pack_external_ts.c \
         recv_ts.c \
         recv_init_ts.c \
         rsend_ts.c \
@@ -56,4 +58,6 @@ libusempif08_ts_la_SOURCES = \
         sendrecv_ts.c \
         sendrecv_replace_ts.c \
         ssend_ts.c \
-        ssend_init_ts.c
+        ssend_init_ts.c \
+        unpack_ts.c \
+        unpack_external_ts.c

ompi/mpi/fortran/use-mpi-f08/ts/bindings.h

@@ -92,6 +92,24 @@ void ompi_ssend_init_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype,
 
 void ompi_get_address_ts(CFI_cdesc_t *x, MPI_Aint *address, MPI_Fint *ierr);
 
+void ompi_pack_ts(CFI_cdesc_t* x1, MPI_Fint *incount, MPI_Fint *datatype,
+                  CFI_cdesc_t* x2, MPI_Fint *outsize, MPI_Fint *position,
+                  MPI_Fint *comm, MPI_Fint *ierr);
+
+void ompi_pack_external_ts(char *datarep, CFI_cdesc_t* x1, MPI_Fint *incount,
+                           MPI_Fint *datatype, CFI_cdesc_t* x2,
+                           MPI_Aint *outsize, MPI_Aint *position,
+                           MPI_Fint *ierr, int datarep_len);
+
+void ompi_unpack_ts(CFI_cdesc_t* x1, MPI_Fint *insize, MPI_Fint *position,
+                           CFI_cdesc_t* x2, MPI_Fint *outcount, MPI_Fint *datatype,
+                           MPI_Fint *comm, MPI_Fint *ierr);
+
+void ompi_unpack_external_ts(char *datarep, CFI_cdesc_t* x1, MPI_Aint *insize,
+                             MPI_Aint *position, CFI_cdesc_t* x2,
+                             MPI_Fint *outcount, MPI_Fint *datatype,
+                             MPI_Fint *ierr, int datarep_len);
+
 void ompi_free_mem_ts(CFI_cdesc_t *x, MPI_Fint *ierr);
 
 void ompi_f_sync_reg_ts(CFI_cdesc_t *x);

ompi/mpi/fortran/use-mpi-f08/ts/pack_external_ts.c

@@ -0,0 +1,82 @@
+/*
+ * Copyright (c) 2004-2005 The Trustees of Indiana University and Indiana
+ *                         University Research and Technology
+ *                         Corporation.  All rights reserved.
+ * Copyright (c) 2004-2005 The University of Tennessee and The University
+ *                         of Tennessee Research Foundation.  All rights
+ *                         reserved.
+ * Copyright (c) 2004-2005 High Performance Computing Center Stuttgart,
+ *                         University of Stuttgart.  All rights reserved.
+ * Copyright (c) 2004-2005 The Regents of the University of California.
+ *                         All rights reserved.
+ * Copyright (c) 2011-2012 Cisco Systems, Inc.  All rights reserved.
+ * Copyright (c) 2015-2019 Research Organization for Information Science
+ *                         and Technology (RIST).  All rights reserved.
+ * $COPYRIGHT$
+ *
+ * Additional copyrights may follow
+ *
+ * $HEADER$
+ */
+
+#include "ompi_config.h"
+
+#include "ompi/communicator/communicator.h"
+#include "ompi/errhandler/errhandler.h"
+#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h"
+#include "ompi/constants.h"
+#include "ompi/mpi/fortran/base/constants.h"
+#include "ompi/mpi/fortran/base/fortran_base_strings.h"
+
+static const char FUNC_NAME[] = "MPI_Pack_external";
+
+void ompi_pack_external_ts(char *datarep, CFI_cdesc_t* x1, MPI_Fint *incount,
+                           MPI_Fint *datatype, CFI_cdesc_t* x2,
+                           MPI_Aint *outsize, MPI_Aint *position,
+                           MPI_Fint *ierr, int datarep_len)
+{
+    int ret, c_ierr;
+    char *c_datarep;
+    MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype);
+    void *inbuf = x1->base_addr;
+    char *outbuf = x2->base_addr;
+    int c_incount = OMPI_FINT_2_INT(*incount);
+
+    /* Convert the fortran string */
+
+    if (OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(datarep, datarep_len,
+                                                       &c_datarep))) {
+        c_ierr = OMPI_ERRHANDLER_INVOKE(MPI_COMM_SELF, ret, FUNC_NAME);
+        if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
+        return;
+    }
+
+    OMPI_CFI_2_C(x1, c_incount, c_type, c_datatype, c_ierr);
+    if (MPI_SUCCESS != c_ierr) {
+        if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
+        OMPI_ERRHANDLER_INVOKE(MPI_COMM_SELF, c_ierr, FUNC_NAME);
+        return;
+    }
+
+    OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr);
+    if (MPI_SUCCESS != c_ierr) {
+        if (c_datatype != c_type) {
+            ompi_datatype_destroy(&c_datatype);
+        }
+        if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
+        OMPI_ERRHANDLER_INVOKE(MPI_COMM_SELF, c_ierr, FUNC_NAME);
+        return;
+    }
+
+    c_ierr = PMPI_Pack_external(c_datarep, OMPI_F2C_BOTTOM(inbuf),
+                               c_incount,
+                               c_datatype, outbuf,
+                               *outsize,
+                               position);
+    if (c_datatype != c_type) {
+        ompi_datatype_destroy(&c_datatype);
+    }
+    if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
+
+    free(c_datarep);
+}