open-mpi · jsquyres · Jan 2, 2022 · Jan 3, 2022 · Jan 6, 2022 · Jan 6, 2022
diff --git a/.gitignore b/.gitignore
@@ -190,7 +190,6 @@ ompi/include/mpif-c-constants.h
 ompi/include/mpif-common.h
 ompi/include/mpi-ext.h
 ompi/include/mpif-ext.h
-ompi/include/mpif-f08-types.h
 ompi/include/mpif-handles.h
 ompi/include/mpif-io-constants.h
 ompi/include/mpif-constants.h

diff --git a/config/ompi_fortran_check_ignore_tkr.m4 b/config/ompi_fortran_check_ignore_tkr.m4
@@ -13,7 +13,7 @@ dnl                         All rights reserved.
 dnl Copyright (c) 2007      Los Alamos National Security, LLC.  All rights
 dnl                         reserved.
 dnl Copyright (c) 2007      Sun Microsystems, Inc.  All rights reserved.
-dnl Copyright (c) 2009-2015 Cisco Systems, Inc.  All rights reserved.
+dnl Copyright (c) 2009-2022 Cisco Systems, Inc.  All rights reserved.
 dnl $COPYRIGHT$
 dnl
 dnl Additional copyrights may follow
@@ -72,7 +72,7 @@ AC_DEFUN([_OMPI_FORTRAN_CHECK_IGNORE_TKR], [
 
     # Vendor-neutral, TYPE(*) syntax
     OMPI_FORTRAN_CHECK_IGNORE_TKR_SUB(
-         [!], [type(*)],
+         [!], [type(*), dimension(*)],
          [TYPE(*), DIMENSION(*)],
          [happy=1], [happy=0])
 
@@ -185,7 +185,7 @@ AC_DEFUN([OMPI_FORTRAN_CHECK_IGNORE_TKR_SUB], [
 
   subroutine force_assumed_shape(a, count)
     integer :: count
-    real, dimension(:,:) :: a
+    complex, dimension(:,:) :: a
     call foo(a, count)
   end subroutine force_assumed_shape
 

diff --git a/config/ompi_fortran_check_use_only.m4 b/config/ompi_fortran_check_use_only.m4
@@ -42,14 +42,19 @@ AC_DEFUN([OMPI_FORTRAN_CHECK_USE_ONLY],[
        [AC_LANG_PUSH([Fortran])
         cat > aaa.f90 << EOF
 MODULE aaa
-INTEGER :: CMON(1)
-COMMON/CMMON/CMON
+! These 2 have the same names as variables in bbb
+! but they should not clash if we only import global_aaa
+INTEGER :: local1
+REAL :: local2
 INTEGER :: global_aaa
 END MODULE aaa
 EOF
         cat > bbb.f90 << EOF
 MODULE bbb
-integer, bind(C, name="cmmon_") :: CMON
+! These 2 have the same names as variables in aaa
+! but they should not clash if we only import global_bbb
+INTEGER :: local1
+COMPLEX :: local2
 INTEGER :: global_bbb
 END MODULE bbb
 EOF

diff --git a/config/ompi_fortran_get_alignment.m4 b/config/ompi_fortran_get_alignment.m4
@@ -136,44 +136,78 @@ EOF
 # OMPI_FORTRAN_F08_GET_HANDLE_ALIGNMENT(type, variable to set)
 # ------------------------------------------
 AC_DEFUN([OMPI_FORTRAN_F08_GET_HANDLE_ALIGNMENT],[
+    unset happy
+    OPAL_VAR_SCOPE_PUSH([happy ompi_conftest_h])
+
     # Use of m4_translit suggested by Eric Blake:
     # http://lists.gnu.org/archive/html/bug-autoconf/2010-10/msg00016.html
     AS_VAR_PUSHDEF([type_var],
        m4_translit([[ompi_cv_fortran_alignment_$1]], [*], [p]))
 
     AC_CACHE_CHECK([alignment of Fortran $1], type_var,
-        [AC_LANG_PUSH([Fortran])
-         AC_LINK_IFELSE([AC_LANG_SOURCE([[module alignment_mod
-type, BIND(C) :: test_mpi_handle
-  integer :: MPI_VAL
-end type test_mpi_handle
-type(test_mpi_handle) :: t1
-type(test_mpi_handle) :: t2
-end module
-
-program falignment
-   use alignment_mod
-   OPEN(UNIT=10, FILE="conftestval")
-   if (LOC(t1) > LOC(t2)) then
-      write (10,'(I5)') LOC(t1)-LOC(t2)
-   else
-      write (10,'(I5)') LOC(t2)-LOC(t1)
-   endif
-   CLOSE(10)
-
-end program]])],
-                          [AS_IF([test "$cross_compiling" = "yes"],
-                                 [AC_MSG_ERROR([Can not determine alignment of $1 when cross-compiling])],
-                                 [OPAL_LOG_COMMAND([./conftest],
-                                                   [AS_VAR_SET(type_var, [`cat conftestval`])],
-                                                   [AC_MSG_ERROR([Could not determine alignment of $1])])])],
-
-                          [AC_MSG_WARN([Could not determine alignment of $1])
-                           AC_MSG_WARN([See config.log for details])
-                           AC_MSG_ERROR([Cannot continue])])
-         rm -rf conftest* *.mod 2> /dev/null
-         AC_LANG_POP([Fortran])])
+       [OMPI_FORTRAN_MAKE_C_FUNCTION([ompi_ac_align_fn], [align])
+        # Fortran module
+        cat > conftestf.f <<EOF
+      program falign
+      external align
+      type, BIND(C) :: test_mpi_handle
+        integer :: MPI_VAL
+      end type test_mpi_handle
+      type(test_mpi_handle) :: w,x,y,z
+      CHARACTER a,b,c
+      common /foo/a,w,b,x,y,c,z
+      call align(w,x,y,z)
+      end
+EOF
+
+        # C module
+        if test -f conftest.h; then
+            ompi_conftest_h="#include \"conftest.h\""
+        else
+            ompi_conftest_h=""
+        fi
+        cat > conftest.c <<EOF
+#include <stdio.h>
+#include <stdlib.h>
+
+void $ompi_ac_align_fn(char *w, char *x, char *y, char *z)
+{
+    unsigned long aw, ax, ay, az;
+    FILE *f = fopen("conftestval", "w");
+    if (!f) exit(1);
+    aw = (unsigned long) w;
+    ax = (unsigned long) x;
+    ay = (unsigned long) y;
+    az = (unsigned long) z;
+    if (! ((aw%16)||(ax%16)||(ay%16)||(az%16))) fprintf(f, "%d\n", 16);
+    else if (! ((aw%12)||(ax%12)||(ay%12)||(az%12))) fprintf(f, "%d\n", 12);
+    else if (! ((aw%8)||(ax%8)||(ay%8)||(az%8))) fprintf(f, "%d\n", 8);
+    else if (! ((aw%4)||(ax%4)||(ay%4)||(az%4))) fprintf(f, "%d\n", 4);
+    else if (! ((aw%2)||(ax%2)||(ay%2)||(az%2))) fprintf(f, "%d\n", 2);
+    else fprintf(f, "%d\n", 1);
+    fclose(f);
+}
+EOF
+
+        OPAL_LOG_COMMAND([$CC $CFLAGS -I. -c conftest.c],
+            [OPAL_LOG_COMMAND([$FC $FCFLAGS conftestf.f conftest.o -o conftest $LDFLAGS $LIBS],
+                [happy="yes"], [happy="no"])], [happy="no"])
+
+        if test "$happy" = "no" ; then
+            AC_MSG_RESULT([Error!])
+            AC_MSG_ERROR([Could not determine alignment of $1])
+        fi
+
+        AS_IF([test "$cross_compiling" = "yes"],
+            [AC_MSG_RESULT([Error!])
+             AC_MSG_ERROR([Can not determine alignment of $1 when cross-compiling])],
+            [OPAL_LOG_COMMAND([./conftest],
+                [AS_VAR_SET(type_var, [`cat conftestval`])],
+                [AC_MSG_RESULT([Error!])
+                 AC_MSG_ERROR([Could not determine alignment of $1])])])
+        rm -rf conftest*])
 
     AS_VAR_COPY([$2], [type_var])
     AS_VAR_POPDEF([type_var])dnl
+    OPAL_VAR_SCOPE_POP
 ])dnl
diff --git a/ompi/include/Makefile.am b/ompi/include/Makefile.am
@@ -41,7 +41,8 @@ include_HEADERS += \
         mpif-handles.h \
         mpif-io-constants.h \
         mpif-io-handles.h \
-        mpif-sentinels.h
+        mpif-sentinels.h \
+        mpif-status.h
 
 endif
 
@@ -125,7 +126,7 @@ CLEANFILES = mpif-sizeof.f90
 distclean-local:
 	rm -f mpi-ext.h mpif-ext.h mpi_portable_platform.h \
 	    mpif-sizeof.h \
-	    mpif-c-constants-decl.h mpif-c-constants.h mpif-f08-types.h
+	    mpif-c-constants-decl.h mpif-c-constants.h
 
 mpi_portable_platform.h: $(top_srcdir)/opal/include/opal/opal_portable_platform_real.h
 	-@rm -f mpi_portable_platform.h

diff --git a/ompi/include/mpif-sentinels.h b/ompi/include/mpif-sentinels.h
@@ -33,36 +33,42 @@
 !     that we already have overloaded F90 bindings for all available
 !     types), so any type is fine.
       integer MPI_BOTTOM
+      common/mpi_fortran_bottom/MPI_BOTTOM
+      bind(C, name="mpi_fortran_bottom")/mpi_fortran_bottom/
+
 !     MPI_IN_PLACE has the same rationale as MPI_BOTTOM.
       integer MPI_IN_PLACE
+      common/mpi_fortran_in_place/MPI_IN_PLACE
+      bind(C, name="mpi_fortran_in_place")/mpi_fortran_in_place/
+
 !     Making MPI_ARGV_NULL be the same type as the parameter that is
 !     exepected in the F90 binding for MPI_COMM_SPAWN means that we
 !     don't need another interface for MPI_COMM_SPAWN.
       character MPI_ARGV_NULL(1)
+      common/mpi_fortran_argv_null/MPI_ARGV_NULL
+      bind(C, name="mpi_fortran_argv_null")/mpi_fortran_argv_null/
+
 !     Ditto for MPI_ARGVS_NULL / MPI_COMM_SPAWN_MULTIPLE.
       character MPI_ARGVS_NULL(1, 1)
+      common/mpi_fortran_argvs_null/MPI_ARGVS_NULL
+      bind(C, name="mpi_fortran_argvs_null")/mpi_fortran_argvs_null/
+
 !     MPI_ERRCODES_IGNORE has similar rationale to MPI_ARGV_NULL.  The
 !     F77 functions are all smart enough to check that the errcodes
 !     parameter is not ERRCODES_IGNORE before assigning values into it
 !     (hence, the fact that this is an array of only 1 element does not
 !     matter -- we'll never overrun it because we never assign values
 !     into it).
       integer MPI_ERRCODES_IGNORE(1)
-!     MPI_STATUS_IGNORE has similar rationale to MPI_ERRCODES_IGNORE.
-      integer MPI_STATUS_IGNORE(MPI_STATUS_SIZE)
-!     Ditto for MPI_STATUSES_IGNORE
-      integer MPI_STATUSES_IGNORE(MPI_STATUS_SIZE, 1)
+      common/mpi_fortran_errc_ign/MPI_ERRCODES_IGNORE
+      bind(C, name="mpi_fortran_errcodes_ignore")/mpi_fortran_errc_ign/
+
 !     Ditto for MPI_UNWEIGHTED
       integer MPI_UNWEIGHTED(1)
+      common/mpi_fortran_unwghtd/MPI_UNWEIGHTED
+      bind(C, name="mpi_fortran_unweighted")/mpi_fortran_unwghtd/
+
 !     Ditto for MPI_WEIGHTS_EMPTY
       integer MPI_WEIGHTS_EMPTY(1)
-
-      common/mpi_fortran_bottom/MPI_BOTTOM
-      common/mpi_fortran_in_place/MPI_IN_PLACE
-      common/mpi_fortran_argv_null/MPI_ARGV_NULL
-      common/mpi_fortran_argvs_null/MPI_ARGVS_NULL
-      common/mpi_fortran_errcodes_ignore/MPI_ERRCODES_IGNORE
-      common/mpi_fortran_status_ignore/MPI_STATUS_IGNORE
-      common/mpi_fortran_statuses_ignore/MPI_STATUSES_IGNORE
-      common/mpi_fortran_unweighted/MPI_UNWEIGHTED
-      common/mpi_fortran_weights_empty/MPI_WEIGHTS_EMPTY
+      common/mpi_fortran_wghts_empty/MPI_WEIGHTS_EMPTY
+      bind(C, name="mpi_fortran_weights_empty")/mpi_fortran_wghts_empty/
diff --git a/ompi/include/mpif-status.h b/ompi/include/mpif-status.h
@@ -0,0 +1,29 @@
+! -*- fortran -*-
+!
+! Copyright (c) 2004-2006 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) 2006-2017 Cisco Systems, Inc.  All rights reserved
+! $COPYRIGHT$
+!
+! Additional copyrights may follow
+!
+! $HEADER$
+!
+
+      ! MPI_STATUS[ES]_IGNORE are also sentinels, but they are different
+      ! types than they are in mpi_f08.
+      integer MPI_STATUS_IGNORE(MPI_STATUS_SIZE)
+      common/mpi_fortran_st_ign/MPI_STATUS_IGNORE
+      bind(C, name="mpi_fortran_status_ignore")/mpi_fortran_st_ign/
+
+      integer MPI_STATUSES_IGNORE(MPI_STATUS_SIZE, 1)
+      common/mpi_fortran_sts_ign/MPI_STATUSES_IGNORE
+      bind(C, name="mpi_fortran_statuses_ignore")/mpi_fortran_sts_ign/
diff --git a/ompi/include/mpif.h.in b/ompi/include/mpif.h.in
@@ -61,3 +61,4 @@
       include 'mpif-externals.h'
       include 'mpif-sentinels.h'
       include 'mpif-sizeof.h'
+      include 'mpif-status.h'
diff --git a/ompi/mpi/fortran/base/gen-mpi-mangling.pl b/ompi/mpi/fortran/base/gen-mpi-mangling.pl
@@ -32,14 +32,12 @@
 
 my $file_c_constants_decl = "mpif-c-constants-decl.h";
 my $file_c_constants = "mpif-c-constants.h";
-my $file_f08_types = "mpif-f08-types.h";
 
 # If we are not building fortran, then just make empty files
 if ($caps_arg + $plain_arg + $single_underscore_arg +
     $double_underscore_arg == 0) {
     system("touch $file_c_constants_decl");
     system("touch $file_c_constants");
-    system("touch $file_f08_types");
     exit(0);
 }
 
@@ -108,22 +106,6 @@
 
 ###############################################################
 
-sub mangle {
-    my $name = shift;
-
-    if ($plain_arg) {
-        return $name;
-    } elsif ($caps_arg) {
-        return uc($name);
-    } elsif ($single_underscore_arg) {
-        return $name . "_";
-    } elsif ($double_underscore_arg) {
-        return $name . "__";
-    } else {
-        die "Unknown name mangling type";
-    }
-}
-
 sub gen_c_constants_decl {
     open(OUT, ">$file_c_constants_decl") ||
         die "Can't write to $file_c_constants_decl";
@@ -139,13 +121,13 @@ sub gen_c_constants_decl {
  */
 
 /* Note that the rationale for the types of each of these variables is
-   discussed in ompi/include/mpif-common.h.  Do not change the types
+   discussed in ompi/include/mpif-sentinels.h.  Do not change the types
    without also changing ompi/runtime/ompi_mpi_init.c and
-   ompi/include/mpif-common.h. */\n\n";
+   ompi/include/mpif-sentinels.h. */\n\n";
 
     foreach my $key (sort(keys(%{$fortran}))) {
         my $f = $fortran->{$key};
-        my $m = mangle($f->{c_name});
+        my $m = $f->{c_name};
         print OUT "extern $f->{c_type} $m;
 #define OMPI_IS_FORTRAN_" . uc($key) . "(addr) \\
         (addr == (void*) &$m)\n\n";
@@ -170,37 +152,14 @@ sub gen_c_constants {
 
     foreach my $key (sort(keys(%{$fortran}))) {
         my $f = $fortran->{$key};
-        my $m = mangle($f->{c_name});
-        print OUT "$f->{c_type} $m;\n";
-    }
-
-    close (OUT);
-}
-
-sub gen_f08_types {
-    open(OUT, ">$file_f08_types") ||
-        die "Can't write to $file_f08_types";
-
-    print OUT "! WARNING: This is a generated file!  Edits will be lost! */
-!
-! Copyright (c) 2015      Research Organization for Information Science
-!                         and Technology (RIST). All rights reserved.
-! Copyright (c) 2015      Cisco Systems, Inc.  All rights reserved.
-! \$COPYRIGHT\$
-!
-! This file was generated by gen-mpi-mangling.pl
-!\n\n";
-
-    foreach my $key (sort(keys(%{$fortran}))) {
-        my $f = $fortran->{$key};
-        print OUT "$f->{f_type}, bind(C, name=\"".mangle($f->{c_name})."\") :: $f->{f_name}\n";
+        my $m = $f->{c_name};
+        print OUT "$f->{c_type} $m = {0};\n";
     }
 
     close (OUT);
 }
 
 gen_c_constants_decl();
 gen_c_constants();
-gen_f08_types();
 
 exit(0);
diff --git a/ompi/mpi/fortran/base/gen-mpi-sizeof.pl b/ompi/mpi/fortran/base/gen-mpi-sizeof.pl
@@ -72,9 +72,11 @@
 
 #############################################################################
 
+my $optional_name_modifier;
 my $optional_ierror_param;
 my $optional_ierror_statement;
 if (lc($ierror_arg) eq "optional") {
+    $optional_name_modifier = "_opt";
     $optional_ierror_param = ", OPTIONAL";
     $optional_ierror_statement = "IF (present(ierror)) ";
 }
@@ -89,7 +91,7 @@ sub queue_sub {
     my ($f_type, $suffix, $import_type) = @_;
 
     # Leave off the MPI/PMI prefix; we'll add that when outputting
-    my $sub_name = "Sizeof_$suffix";
+    my $sub_name = "Sizeof_$suffix$optional_name_modifier";
 
     # Make a hash for this subroutine
     my $subr;