f08: resolve osx link constant issues

maint/local_python/binding_common.py

@@ -55,14 +55,9 @@ def split_line_with_break(s, tail, N=100):
     if RE.match(r'(\s*)', s):
         n_lead = len(RE.m.group(1)) + 4
 
-    if len(s) < N:
-        tlist.append(s)
-        n = len(s)
-    elif RE.match(r'(.*?\()(.*)', s):
-        # line with function pattern, match indent at opening parenthesis
-        s_lead, s_next = RE.m.group(1,2)
-        n_lead = len(s_lead)
-
+    # -------------
+    def break_s_next(s_lead, s_next):
+        nonlocal tlist, n
         for a in s_next.split(', '):
             if n == 0:
                 # first line
@@ -86,10 +81,19 @@ def split_line_with_break(s, tail, N=100):
                     tlist = [' ' * n_lead, a]
                     n = n_lead + len(a)
         # leave last segment with tail
-    else:
-        # only break long function declaration or call for now
+
+    # -------------
+    if len(s) < N:
         tlist.append(s)
         n = len(s)
+    elif RE.match(r'(.*?\()(.*)', s):
+        # line with function pattern, match indent at opening parenthesis
+        s_lead, s_next = RE.m.group(1,2)
+        n_lead = len(s_lead)
+
+        break_s_next(s_lead, s_next)
+    else:
+        break_s_next('', s)
 
     # tail is mostly for "__attribute__ ((weak, alias(...))));",
     # which contains , that we do not desire to break

maint/local_python/binding_f08.py

@@ -350,7 +350,7 @@ def process_status(p):
         if p['length'] is not None: 
             # always output parameter
             uses['MPI_STATUSES_IGNORE'] = 1
-            uses['MPIR_C_MPI_STATUSES_IGNORE'] = 1
+            uses['MPIR_F08_get_MPI_STATUSES_IGNORE_c'] = 1
             need_check_status_ignore = p
             arg_1 = ":STATUS:"
             arg_2 = ":STATUS:"
@@ -364,7 +364,7 @@ def process_status(p):
             if p['param_direction'] == 'out':
                 need_check_status_ignore = p
                 uses['MPI_STATUS_IGNORE'] = 1
-                uses['MPIR_C_MPI_STATUS_IGNORE'] = 1
+                uses['MPIR_F08_get_MPI_STATUS_IGNORE_c'] = 1
                 arg_1 = ":STATUS:"
                 arg_2 = ":STATUS:"
                 p['_status_convert'] = "status = status_c"
@@ -440,18 +440,18 @@ def process_array_check(p):
         if check:
             uses['c_associated'] = 1
             uses[check] = 1
-            uses['MPIR_C_%s' % check] = 1
+            uses['MPIR_F08_get_%s_c' % check] = 1
             convert_list_pre.append("IF (c_associated(%s, c_loc(%s))) THEN" % (arg_1, check))
-            convert_list_pre.append("    %s = MPIR_C_%s" % (arg_1, check))
+            convert_list_pre.append("    %s = MPIR_F08_get_%s_c()" % (arg_1, check))
             if check == "MPI_ERRCODES_IGNORE":
                 convert_list_pre.append("    has_errcodes_ignore = .true.")
             elif check == "MPI_UNWEIGHTED":
                 # also need check MPI_WEIGHTS_EMPTY
                 check = "MPI_WEIGHTS_EMPTY"
                 uses[check] = 1
-                uses['MPIR_C_%s' % check] = 1
+                uses['MPIR_F08_get_%s_c' % check] = 1
                 convert_list_pre.append("ELSE IF (c_associated(%s, c_loc(%s))) THEN" % (arg_1, check))
-                convert_list_pre.append("    %s = MPIR_C_%s" % (arg_1, check))
+                convert_list_pre.append("    %s = MPIR_F08_get_%s_c()" % (arg_1, check))
                 convert_list_pre.append("ELSE")
                 convert_list_pre.append("    %s = c_loc(%s)" % (arg_1, p['name']))
                 convert_list_pre.append("    has_%s = .true." % p['name'])
@@ -688,7 +688,7 @@ def dump_call(s, check_int_kind):
             else:
                 ignore = 'MPI_STATUSES_IGNORE'
             dump_F_if_open("c_associated(c_loc(%s), c_loc(%s))" % (p['name'], ignore))
-            s2 = re.sub(r':STATUS:', "MPIR_C_%s" % ignore, s)
+            s2 = re.sub(r':STATUS:', "MPIR_F08_get_%s_c()" % ignore, s)
             dump_fortran_line(s2)
             dump_F_else()
             if check_int_kind:
@@ -908,7 +908,7 @@ def dump_F_uses(uses):
             mpi_c_list_3.append(a)
         elif re.match(r'MPI_\w+_(function|FN|FN_NULL)(_c)?$', a, re.IGNORECASE):
             mpi_f08_list_4.append(a)
-        elif re.search(r'(STATUS.*IGNORE|ARGV.*NULL|ERRCODES_IGNORE|_UNWEIGHTED|WEIGHTS_EMPTY|MPI_IN_PLACE|MPI_BOTTOM)$', a, re.IGNORECASE):
+        elif re.search(r'(STATUS.*IGNORE|ARGV.*NULL|ERRCODES_IGNORE|_UNWEIGHTED|WEIGHTS_EMPTY|MPI_IN_PLACE|MPI_BOTTOM)', a, re.IGNORECASE):
             mpi_f08_list_3.append(a)
         elif re.match(r'MPI_[A-Z_]+$', a):
             mpi_f08_list_2.append(a)
@@ -921,21 +921,21 @@ def dump_F_uses(uses):
         else:
             mpi_c_list_2.append(a)
     if iso_c_binding_list:
-        G.out.append("USE, intrinsic :: iso_c_binding, ONLY : %s" % ', '.join(iso_c_binding_list))
+        dump_fortran_line("USE, intrinsic :: iso_c_binding, ONLY : %s" % ', '.join(iso_c_binding_list))
     if mpi_f08_list_1:
-        G.out.append("USE :: mpi_f08_types, ONLY : %s" % ', '.join(mpi_f08_list_1))
+        dump_fortran_line("USE :: mpi_f08_types, ONLY : %s" % ', '.join(mpi_f08_list_1))
     if mpi_f08_list_2:
-        G.out.append("USE :: mpi_f08_compile_constants, ONLY : %s" % ', '.join(mpi_f08_list_2))
+        dump_fortran_line("USE :: mpi_f08_compile_constants, ONLY : %s" % ', '.join(mpi_f08_list_2))
     if mpi_f08_list_3:
-        G.out.append("USE :: mpi_f08_link_constants, ONLY : %s" % ', '.join(mpi_f08_list_3))
+        dump_fortran_line("USE :: mpi_f08_link_constants, ONLY : %s" % ', '.join(mpi_f08_list_3))
     if mpi_f08_list_4:
-        G.out.append("USE :: mpi_f08_callbacks, ONLY : %s" % ', '.join(mpi_f08_list_4))
+        dump_fortran_line("USE :: mpi_f08_callbacks, ONLY : %s" % ', '.join(mpi_f08_list_4))
     if mpi_c_list_1:
-        G.out.append("USE :: mpi_c_interface_types, ONLY : %s" % ', '.join(mpi_c_list_1))
+        dump_fortran_line("USE :: mpi_c_interface_types, ONLY : %s" % ', '.join(mpi_c_list_1))
     if mpi_c_list_2:
-        G.out.append("USE :: mpi_c_interface, ONLY : %s" % ', '.join(mpi_c_list_2))
+        dump_fortran_line("USE :: mpi_c_interface, ONLY : %s" % ', '.join(mpi_c_list_2))
     if mpi_c_list_3:
-        G.out.append("USE :: mpi_c_interface_glue, ONLY : %s" % ', '.join(mpi_c_list_3))
+        dump_fortran_line("USE :: mpi_c_interface_glue, ONLY : %s" % ', '.join(mpi_c_list_3))
 
 def dump_F_if_open(cond):
     G.out.append("IF (%s) THEN" % cond)

src/binding/fortran/use_mpi_f08/mpi_f08_link_constants.f90

@@ -24,13 +24,6 @@ module mpi_f08_link_constants
 type(MPI_Status), bind(C, name="MPIR_F08_MPI_STATUS_IGNORE_OBJ"), target :: MPI_STATUS_IGNORE
 type(MPI_Status), dimension(1), bind(C, name="MPIR_F08_MPI_STATUSES_IGNORE_OBJ"), target :: MPI_STATUSES_IGNORE
 
-type(c_ptr), bind(C, name="MPIR_C_MPI_STATUS_IGNORE") :: MPIR_C_MPI_STATUS_IGNORE
-type(c_ptr), bind(C, name="MPIR_C_MPI_STATUSES_IGNORE") :: MPIR_C_MPI_STATUSES_IGNORE
-
-! Though these two variables are required by MPI-3 Standard, they are not used in MPICH
-type(c_ptr), bind(C, name="MPI_F08_STATUS_IGNORE")   :: MPI_F08_STATUS_IGNORE   ! Point to MPI_STATUS_IGNORE
-type(c_ptr), bind(C, name="MPI_F08_STATUSES_IGNORE") :: MPI_F08_STATUSES_IGNORE ! Point to MPI_STATUSES_IGNORE
-
 
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 !
@@ -41,17 +34,13 @@ module mpi_f08_link_constants
 character(len=1), dimension(1), target :: MPI_ARGV_NULL
 character(len=1), dimension(1,1), target :: MPI_ARGVS_NULL
 
-type(c_ptr), bind(C, name="MPIR_C_MPI_ARGV_NULL") :: MPIR_C_MPI_ARGV_NULL
-type(c_ptr), bind(C, name="MPIR_C_MPI_ARGVS_NULL") :: MPIR_C_MPI_ARGVS_NULL
-
 
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 !
 !  MPI_ERRCODES_IGNORE
 !
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 integer, dimension(1), target :: MPI_ERRCODES_IGNORE
-type(c_ptr), bind(C, name="MPIR_C_MPI_ERRCODES_IGNORE") :: MPIR_C_MPI_ERRCODES_IGNORE
 
 
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -64,9 +53,6 @@ module mpi_f08_link_constants
 integer, dimension(1), target :: MPI_UNWEIGHTED
 integer, dimension(1), target :: MPI_WEIGHTS_EMPTY
 
-type(c_ptr), protected, bind(C, name="MPIR_C_MPI_UNWEIGHTED")    :: MPIR_C_MPI_UNWEIGHTED
-type(c_ptr), protected, bind(C, name="MPIR_C_MPI_WEIGHTS_EMPTY") :: MPIR_C_MPI_WEIGHTS_EMPTY
-
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 !
 !  MPI_IN_PLACE
@@ -83,4 +69,57 @@ module mpi_f08_link_constants
 ! A.1.1 p. 663
 integer(c_int), bind(C, name="MPIR_F08_MPI_BOTTOM"), target :: MPI_BOTTOM
 
+INTERFACE
+
+FUNCTION MPIR_F08_get_MPI_STATUS_IGNORE_c() &
+    bind (C, name="MPIR_F08_get_MPI_STATUS_IGNORE") result(p)
+    USE, intrinsic :: iso_c_binding, ONLY : c_ptr
+    IMPLICIT NONE
+    TYPE(c_ptr) :: p
+END FUNCTION
+
+FUNCTION MPIR_F08_get_MPI_STATUSES_IGNORE_c() &
+    bind (C, name="MPIR_F08_get_MPI_STATUSES_IGNORE") result(p)
+    USE, intrinsic :: iso_c_binding, ONLY : c_ptr
+    IMPLICIT NONE
+    TYPE(c_ptr) :: p
+END FUNCTION
+
+FUNCTION MPIR_F08_get_MPI_ARGV_NULL_c() &
+    bind (C, name="MPIR_F08_get_MPI_ARGV_NULL") result(p)
+    USE, intrinsic :: iso_c_binding, ONLY : c_ptr
+    IMPLICIT NONE
+    TYPE(c_ptr) :: p
+END FUNCTION
+
+FUNCTION MPIR_F08_get_MPI_ARGVS_NULL_c() &
+    bind (C, name="MPIR_F08_get_MPI_ARGVS_NULL") result(p)
+    USE, intrinsic :: iso_c_binding, ONLY : c_ptr
+    IMPLICIT NONE
+    TYPE(c_ptr) :: p
+END FUNCTION
+
+FUNCTION MPIR_F08_get_MPI_ERRCODES_IGNORE_c() &
+    bind (C, name="MPIR_F08_get_MPI_ERRCODES_IGNORE") result(p)
+    USE, intrinsic :: iso_c_binding, ONLY : c_ptr
+    IMPLICIT NONE
+    TYPE(c_ptr) :: p
+END FUNCTION
+
+FUNCTION MPIR_F08_get_MPI_UNWEIGHTED_c() &
+    bind (C, name="MPIR_F08_get_MPI_UNWEIGHTED") result(p)
+    USE, intrinsic :: iso_c_binding, ONLY : c_ptr
+    IMPLICIT NONE
+    TYPE(c_ptr) :: p
+END FUNCTION
+
+FUNCTION MPIR_F08_get_MPI_WEIGHTS_EMPTY_c() &
+    bind (C, name="MPIR_F08_get_MPI_WEIGHTS_EMPTY") result(p)
+    USE, intrinsic :: iso_c_binding, ONLY : c_ptr
+    IMPLICIT NONE
+    TYPE(c_ptr) :: p
+END FUNCTION
+
+END INTERFACE
+
 end module mpi_f08_link_constants

src/binding/fortran/use_mpi_f08/wrappers_c/cdesc.c

@@ -5,12 +5,7 @@
 
 #include "cdesc.h"
 #include <limits.h>
-
-MPI_Status *MPIR_C_MPI_STATUS_IGNORE = MPI_STATUS_IGNORE;
-MPI_Status *MPIR_C_MPI_STATUSES_IGNORE = MPI_STATUSES_IGNORE;
-char **MPIR_C_MPI_ARGV_NULL = MPI_ARGV_NULL;
-char ***MPIR_C_MPI_ARGVS_NULL = MPI_ARGVS_NULL;
-int *MPIR_C_MPI_ERRCODES_IGNORE = MPI_ERRCODES_IGNORE;
+#include <assert.h>
 
 /* Fortran 2008 specifies a maximum rank of 15 */
 #define MAX_RANK  (15)
@@ -30,12 +25,12 @@ int cdesc_create_datatype(CFI_cdesc_t * cdesc, MPI_Aint oldcount, MPI_Datatype o
 #ifdef HAVE_ERROR_CHECKING
     {
         int size;
-        MPIR_Assert(cdesc->rank <= MAX_RANK);
+        assert(cdesc->rank <= MAX_RANK);
         PMPI_Type_size(oldtype, &size);
         /* When cdesc->elem_len != size, things suddenly become complicated. Generally, it is hard to create
          * a composite datatype based on two datatypes. Currently we don't support it and doubt it is useful.
          */
-        MPIR_Assert(cdesc->elem_len == size);
+        assert(cdesc->elem_len == size);
     }
 #endif
 

src/binding/fortran/use_mpi_f08/wrappers_c/cdesc.h

@@ -6,6 +6,7 @@
 #ifndef CDESC_H_INCLUDED
 #define CDESC_H_INCLUDED
 
+#include "mpichconf.h"
 #include <stdio.h>
 #include <stdlib.h>
 #include <ISO_Fortran_binding.h>
@@ -16,11 +17,8 @@
 #define MPIO_Request MPI_Request
 #endif
 
-extern MPI_Status *MPIR_C_MPI_STATUS_IGNORE;
-extern MPI_Status *MPIR_C_MPI_STATUSES_IGNORE;
-extern char **MPIR_C_MPI_ARGV_NULL;
-extern char ***MPIR_C_MPI_ARGVS_NULL;
-extern int *MPIR_C_MPI_ERRCODES_IGNORE;
+extern int MPIR_F08_MPI_IN_PLACE;
+extern int MPIR_F08_MPI_BOTTOM;
 
 extern int cdesc_create_datatype(CFI_cdesc_t * cdesc, MPI_Aint oldcount, MPI_Datatype oldtype,
                                  MPI_Datatype * newtype);
@@ -36,4 +34,12 @@ extern int MPIR_Comm_spawn_multiple_c(int count, char *array_of_commands_f, char
                                       int argv_elem_len);
 extern int MPIR_F_sync_reg_cdesc(CFI_cdesc_t * buf);
 
+void *MPIR_F08_get_MPI_STATUS_IGNORE(void);
+void *MPIR_F08_get_MPI_STATUSES_IGNORE(void);
+void *MPIR_F08_get_MPI_ARGV_NULL(void);
+void *MPIR_F08_get_MPI_ARGVS_NULL(void);
+void *MPIR_F08_get_MPI_ERRCODES_IGNORE(void);
+void *MPIR_F08_get_MPI_UNWEIGHTED(void);
+void *MPIR_F08_get_MPI_WEIGHTS_EMPTY(void);
+
 #endif /* CDESC_H_INCLUDED */

src/binding/fortran/use_mpi_f08/wrappers_c/utils.c

@@ -6,6 +6,18 @@
 #include "cdesc.h"
 #include <string.h>
 
+int MPIR_F08_MPI_IN_PLACE MPICH_API_PUBLIC;
+int MPIR_F08_MPI_BOTTOM MPICH_API_PUBLIC;
+
+/* MPI_F08_STATUS_IGNORE and MPI_F08_STATUSES_IGNORE are required by MPI-3.0.
+ * the obj variables are linked in mpi_f08_link_constants module via bind(c).
+ */
+MPI_F08_status MPIR_F08_MPI_STATUS_IGNORE_OBJ MPICH_API_PUBLIC;
+MPI_F08_status MPIR_F08_MPI_STATUSES_IGNORE_OBJ[1] MPICH_API_PUBLIC;
+
+MPI_F08_status *MPI_F08_STATUS_IGNORE MPICH_API_PUBLIC = &MPIR_F08_MPI_STATUS_IGNORE_OBJ;
+MPI_F08_status *MPI_F08_STATUSES_IGNORE MPICH_API_PUBLIC = &MPIR_F08_MPI_STATUSES_IGNORE_OBJ[0];
+
 /*
   Convert an array of strings in Fortran Format to an array of strings in C format (i.e., char* a[]).
 
@@ -93,3 +105,38 @@ extern int MPIR_Fortran_array_of_string_f2c(const char *strs_f, char ***strs_c,
   fn_fail:
     goto fn_exit;
 }
+
+void *MPIR_F08_get_MPI_STATUS_IGNORE(void)
+{
+    return (void *) MPI_STATUS_IGNORE;
+}
+
+void *MPIR_F08_get_MPI_STATUSES_IGNORE(void)
+{
+    return (void *) MPI_STATUSES_IGNORE;
+}
+
+void *MPIR_F08_get_MPI_ARGV_NULL(void)
+{
+    return (void *) MPI_ARGV_NULL;
+}
+
+void *MPIR_F08_get_MPI_ARGVS_NULL(void)
+{
+    return (void *) MPI_ARGVS_NULL;
+}
+
+void *MPIR_F08_get_MPI_ERRCODES_IGNORE(void)
+{
+    return (void *) MPI_ERRCODES_IGNORE;
+}
+
+void *MPIR_F08_get_MPI_UNWEIGHTED(void)
+{
+    return (void *) MPI_UNWEIGHTED;
+}
+
+void *MPIR_F08_get_MPI_WEIGHTS_EMPTY(void)
+{
+    return (void *) MPI_WEIGHTS_EMPTY;
+}

src/include/mpi.h.in

@@ -792,14 +792,9 @@ typedef struct {
 #define MPI_F_TAG 3
 #define MPI_F_ERROR 4
 
-extern MPI_F08_status MPIR_F08_MPI_STATUS_IGNORE_OBJ MPICH_API_PUBLIC;
-extern MPI_F08_status MPIR_F08_MPI_STATUSES_IGNORE_OBJ[1] MPICH_API_PUBLIC;
-extern int MPIR_F08_MPI_IN_PLACE MPICH_API_PUBLIC;
-extern int MPIR_F08_MPI_BOTTOM MPICH_API_PUBLIC;
-
-/* Pointers to above objects */
-extern MPI_F08_status *MPI_F08_STATUS_IGNORE MPICH_API_PUBLIC;
-extern MPI_F08_status *MPI_F08_STATUSES_IGNORE MPICH_API_PUBLIC;
+/* Provided in libmpifort.so */
+extern MPI_F08_status *MPI_F08_STATUS_IGNORE;
+extern MPI_F08_status *MPI_F08_STATUSES_IGNORE;
 
 /* For supported thread levels */
 #define MPI_THREAD_SINGLE 0

src/mpi/init/init_bindings.c

@@ -20,29 +20,3 @@ void MPII_init_binding_cxx(void)
     MPIR_Process.cxx_call_op_fn = 0;
 #endif
 }
-
-/* ** F08 binding **************/
-#ifdef HAVE_F08_BINDING
-int *MPIR_C_MPI_UNWEIGHTED MPICH_API_PUBLIC;
-int *MPIR_C_MPI_WEIGHTS_EMPTY MPICH_API_PUBLIC;
-
-MPI_F08_status MPIR_F08_MPI_STATUS_IGNORE_OBJ;
-MPI_F08_status MPIR_F08_MPI_STATUSES_IGNORE_OBJ[1];
-int MPIR_F08_MPI_IN_PLACE;
-int MPIR_F08_MPI_BOTTOM;
-
-/* Although the two STATUS pointers are required but the MPI3.0,  they are not used in MPICH F08 binding */
-MPI_F08_status *MPI_F08_STATUS_IGNORE = &MPIR_F08_MPI_STATUS_IGNORE_OBJ;
-MPI_F08_status *MPI_F08_STATUSES_IGNORE = &MPIR_F08_MPI_STATUSES_IGNORE_OBJ[0];
-
-void MPII_init_binding_f08(void)
-{
-    MPIR_C_MPI_UNWEIGHTED = MPI_UNWEIGHTED;
-    MPIR_C_MPI_WEIGHTS_EMPTY = MPI_WEIGHTS_EMPTY;
-}
-
-#else
-void MPII_init_binding_f08(void)
-{
-}
-#endif