[svn-r8153] COMML_FORGET was called after the communicator was freed, so the...

[svn-r8153] COMML_FORGET was called after the communicator was freed, so the communicator's next pointer was invalid.  Fixes #1451.

configure.in

@@ -4120,18 +4120,13 @@ if test "$enable_f77" = yes ; then
         "$ac_cv_sizeof_void_p" -gt "$pac_cv_f77_sizeof_integer" ; then
         AC_DEFINE(HAVE_AINT_LARGER_THAN_FINT,1,[Define if addresses are larger than Fortran integers])
     fi
-    if test "$ac_cv_sizeof_void_p" != 0 -a \
-        "$ac_cv_sizeof_void_p" != "$pac_cv_f77_sizeof_integer" ; then
-	AC_DEFINE(HAVE_AINT_DIFFERENT_THAN_FINT,1,[Define if addresses are a different size than Fortran integers])
-    fi
-    
     # Include a defined value for Fint is int
     if test "$MPI_FINT" = "int" ; then
         AC_DEFINE(HAVE_FINT_IS_INT,1,[Define if Fortran integer are the same size as C ints])
     elif test "$SIZEOF_F77_INTEGER" != "$ac_cv_sizeof_int" ; then
         # Make this fatal because we do not want to build a broken fortran
-	# interface (was error)
-        AC_MSG_WARN([Fortran integers and C ints are not the same size.  The current Fortran binding does not support this case.  Either force the Fortran compiler to use integers of $ac_cv_sizeof_int bytes, or use --disable-f77 on the configure line for MPICH2.])
+	# interface
+        AC_MSG_ERROR([Fortran integers and C ints are not the same size.  The current Fortran binding does not support this case.  Either force the Fortran compiler to use integers of $ac_cv_sizeof_int bytes, or use --disable-f77 on the configure line for MPICH2.])
     fi
 
     #

src/binding/f77/mpi_fortimpl.h

@@ -5,24 +5,17 @@
  */
 #include "mpichconf.h"
 
-/* Handle different mechanisms for passing Fortran CHARACTER to routines.
- * 
- * In the case where MPI_Fint is a different size from int, it appears that
- * compilers use an int, rather than an MPI_Fint, for the length.  However,
- * there is no standard for this, so some compiler may choose to use
- * an MPI_Fint instead of an int.  In that case, we will need an additional
- * case.
- */
+/* Handle different mechanisms for passing Fortran CHARACTER to routines */
 #ifdef USE_FORT_MIXED_STR_LEN
-#define FORT_MIXED_LEN_DECL   , int
+#define FORT_MIXED_LEN_DECL   , MPI_Fint
 #define FORT_END_LEN_DECL
-#define FORT_MIXED_LEN(a)     , int a
+#define FORT_MIXED_LEN(a)     , MPI_Fint a
 #define FORT_END_LEN(a)
 #else
 #define FORT_MIXED_LEN_DECL
-#define FORT_END_LEN_DECL     , int
+#define FORT_END_LEN_DECL     , MPI_Fint
 #define FORT_MIXED_LEN(a)
-#define FORT_END_LEN(a)       , int a
+#define FORT_END_LEN(a)       , MPI_Fint a
 #endif
 
 /* ------------------------------------------------------------------------- */

src/include/mpiimpl.h

@@ -2129,9 +2129,6 @@ extern void MPIR_Keyval_set_cxx( int, void (*)(void), void (*)(void) );
 extern void MPIR_Op_set_cxx( MPI_Op, void (*)(void) );
 extern void MPIR_Errhandler_set_cxx( MPI_Errhandler, void (*)(void) );
 #endif
-#if defined(HAVE_FORTRAN_BINDING) && !defined(HAVE_FINT_IS_INT)
-void MPIR_Op_set_fc( MPI_Op );
-#endif
 
 int MPIR_Group_create( int, MPID_Group ** );
 int MPIR_Group_release(MPID_Group *group_ptr);

src/mpi/coll/allreduce.c

@@ -144,9 +144,6 @@ int MPIR_Allreduce_intra (
     MPIU_THREADPRIV_DECL;
 #ifdef HAVE_CXX_BINDING
     int is_cxx_uop = 0;
-#endif
-#if defined(HAVE_FORTRAN_BINDING) && !defined(HAVE_FINT_IS_INT)
-    int is_f77_uop = 0;
 #endif
     MPIU_CHKLMEM_DECL(3);
     
@@ -287,12 +284,8 @@ int MPIR_Allreduce_intra (
 #endif
             if ((op_ptr->language == MPID_LANG_C))
                 uop = (MPI_User_function *) op_ptr->function.c_function;
-            else {
+            else
                 uop = (MPI_User_function *) op_ptr->function.f77_function;
-#ifndef HAVE_FINT_IS_INT
-		is_f77_uop = 1;
-#endif
-	    }
         }
         
         /* need to allocate temporary buffer to store incoming data*/

src/mpi/coll/op_create.c

@@ -46,20 +46,6 @@ void MPIR_Op_set_cxx( MPI_Op op, void (*opcall)(void) )
 				    MPI_Datatype, MPI_User_function *))opcall;
 }
 #endif
-#if defined(HAVE_FORTRAN_BINDING) && !defined(HAVE_FINT_IS_INT)
-/* Normally, the C and Fortran versions are the same, by design in the
-   MPI Standard.  However, if MPI_Fint and int are not the same size (e.g.,
-   MPI_Fint was made 8 bytes but int is 4 bytes), then the C and Fortran
-   versions must be distinquished. */
-void MPIR_Op_set_fc( MPI_Op op )
-{
-    MPID_Op *op_ptr;
-    
-    MPID_Op_get_ptr( op, op_ptr );
-    op_ptr->language = MPID_LANG_FORTRAN;
-}
-#endif
-
 #endif
 
 #undef FUNCNAME

src/mpi/coll/reduce.c

@@ -53,9 +53,6 @@ static int MPIR_Reduce_binomial (
     MPI_Comm comm;
 #ifdef HAVE_CXX_BINDING
     int is_cxx_uop = 0;
-#endif
-#if defined(HAVE_FORTRAN_BINDING) && !defined(HAVE_FINT_IS_INT)
-    int is_f77_uop = 0;
 #endif
     MPIU_CHKLMEM_DECL(2);
     MPIU_THREADPRIV_DECL;
@@ -96,12 +93,8 @@ static int MPIR_Reduce_binomial (
 #endif
         if ((op_ptr->language == MPID_LANG_C))
             uop = (MPI_User_function *) op_ptr->function.c_function;
-        else {
+        else
             uop = (MPI_User_function *) op_ptr->function.f77_function;
-#ifndef HAVE_FINT_IS_INT
-	    is_f77_uop = 1;
-#endif
-	}
     }
 
     /* I think this is the worse case, so we can avoid an assert() 
@@ -192,21 +185,9 @@ static int MPIR_Reduce_binomial (
                         (*MPIR_Process.cxx_call_op_fn)( tmp_buf, recvbuf, 
                                                         count, datatype, uop );
                     }
-                    else {
+                    else 
 #endif
-#if defined(HAVE_FORTRAN_BINDING) && !defined(HAVE_FINT_IS_INT)
-			if (is_f77_uop) {
-			    MPI_Fint lcount = (MPI_Fint)count;
-			    MPI_Fint ldtype = (MPI_Fint)datatype;
-			    (*uop)(tmp_buf, recvbuf, &lcount, &ldtype);
-			}
-			else {
-			    (*uop)(tmp_buf, recvbuf, &count, &datatype);
-			}
-#else
                         (*uop)(tmp_buf, recvbuf, &count, &datatype);
-#endif
-		    }
                 }
                 else {
 #ifdef HAVE_CXX_BINDING
@@ -214,22 +195,9 @@ static int MPIR_Reduce_binomial (
                         (*MPIR_Process.cxx_call_op_fn)( recvbuf, tmp_buf,
                                                         count, datatype, uop );
                     }
-                    else {
-#endif
-#if defined(HAVE_FORTRAN_BINDING) && !defined(HAVE_FINT_IS_INT)
-			if (is_f77_uop) {
-			    /* In this case, the integer types do not match */
-			    MPI_Fint lcount = (MPI_Fint)count;
-			    MPI_Fint ldtype = (MPI_Fint)datatype;
-			    (*uop)(recvbuf, tmp_buf, &lcount, &ldtype);
-			}
-			else {
-			    (*uop)(recvbuf, tmp_buf, &count, &datatype);
-			}
-#else
-			(*uop)(recvbuf, tmp_buf, &count, &datatype);
+                    else 
 #endif
-		    }
+                        (*uop)(recvbuf, tmp_buf, &count, &datatype);
                     mpi_errno = MPIR_Localcopy(tmp_buf, count, datatype,
                                                recvbuf, count, datatype);
                     if (mpi_errno) { MPIU_ERR_POP(mpi_errno); }

src/mpi/coll/reduce_local.c

@@ -36,9 +36,6 @@ int MPIR_Reduce_local_impl(void *inbuf, void *inoutbuf, int count, MPI_Datatype
     MPI_User_function *uop;
 #ifdef HAVE_CXX_BINDING
     int is_cxx_uop = 0;
-#endif
-#if defined(HAVE_FORTRAN_BINDING) && !defined(HAVE_FINT_IS_INT)
-    int is_f77_uop = 0;
 #endif
     MPIU_THREADPRIV_DECL;
 
@@ -62,15 +59,10 @@ int MPIR_Reduce_local_impl(void *inbuf, void *inoutbuf, int count, MPI_Datatype
         else
 #endif
         {
-            if ((op_ptr->language == MPID_LANG_C)) {
+            if ((op_ptr->language == MPID_LANG_C))
                 uop = (MPI_User_function *) op_ptr->function.c_function;
-            }
-            else {
+            else
                 uop = (MPI_User_function *) op_ptr->function.f77_function;
-#ifndef HAVE_FINT_IS_INT
-                is_f77_uop = 1;
-#endif
-            }
         }
     }
 
@@ -82,18 +74,7 @@ int MPIR_Reduce_local_impl(void *inbuf, void *inoutbuf, int count, MPI_Datatype
     else
 #endif
     {
-#if defined(HAVE_FORTRAN_BINDING) && !defined(HAVE_FINT_IS_INT)
-        if (is_f77_uop) {
-            MPI_Fint lcount = (MPI_Fint)count;
-            MPI_Fint ldtype = (MPI_Fint)datatype;
-            (*uop)(inbuf, inoutbuf, &lcount, &ldtype);
-        }
-        else {
-            (*uop)(inbuf, inoutbuf, &count, &datatype);
-        }
-#else
         (*uop)(inbuf, inoutbuf, &count, &datatype);
-#endif
     }
 
     /* --BEGIN ERROR HANDLING-- */

src/mpi/comm/commutil.c

@@ -1336,16 +1336,16 @@ int MPIR_Comm_delete_internal(MPID_Comm * comm_ptr, int isDisconnect)
             }
         }
 
-        /* Check for predefined communicators - these should not
-           be freed */
-        if (! (HANDLE_GET_KIND(comm_ptr->handle) == HANDLE_KIND_BUILTIN) )
-            MPIU_Handle_obj_free( &MPID_Comm_mem, comm_ptr );
-
         /* Remove from the list of active communicators if
            we are supporting message-queue debugging.  We make this
            conditional on having debugger support since the
            operation is not constant-time */
         MPIR_COMML_FORGET( comm_ptr );
+
+        /* Check for predefined communicators - these should not
+           be freed */
+        if (! (HANDLE_GET_KIND(comm_ptr->handle) == HANDLE_KIND_BUILTIN) )
+            MPIU_Handle_obj_free( &MPID_Comm_mem, comm_ptr );
     }
     else {
         /* If the user attribute free function returns an error,

src/mpi/errhan/comm_call_errhandler.c

@@ -139,15 +139,8 @@ int MPI_Comm_call_errhandler(MPI_Comm comm, int errorcode)
 #ifdef HAVE_FORTRAN_BINDING
     case MPID_LANG_FORTRAN90:
     case MPID_LANG_FORTRAN:
-	{
-	    /* If int and MPI_Fint aren't the same size, we need to 
-	       convert.  As this is not performance critical, we
-	       do this even if MPI_Fint and int are the same size. */
-	    MPI_Fint ferr=errorcode;
-	    MPI_Fint commhandle=comm_ptr->handle;
 	(*comm_ptr->errhandler->errfn.F77_Handler_function)( 
-					    &commhandle, &ferr );
-	}
+	    (MPI_Fint *)&comm_ptr->handle, &errorcode );
 	break;
 #endif
     }

src/mpi/errhan/errutil.c

@@ -138,16 +138,6 @@ void MPIR_Errhandler_set_cxx( MPI_Errhandler errhand, void (*errcall)(void) )
 }
 #endif /* HAVE_CXX_BINDING */
 
-#if defined(HAVE_FORTRAN_BINDING) && !defined(HAVE_FINT_IS_INT)
-void MPIR_Errhandler_set_fc( MPI_Errhandler errhand )
-{
-    MPID_Errhandler *errhand_ptr;
-    
-    MPID_Errhandler_get_ptr( errhand, errhand_ptr );
-    errhand_ptr->language = MPID_LANG_FORTRAN;
-}
-
-#endif
 /* ------------------------------------------------------------------------- */
 /* These routines are called on error exit from most top-level MPI routines
    to invoke the appropriate error handler.  Also included is the routine
@@ -265,15 +255,9 @@ int MPIR_Err_return_comm( MPID_Comm  *comm_ptr, const char fcname[],
 #ifdef HAVE_FORTRAN_BINDING
 	case MPID_LANG_FORTRAN90:
 	case MPID_LANG_FORTRAN:
-	{
-	    /* If int and MPI_Fint aren't the same size, we need to 
-	       convert.  As this is not performance critical, we
-	       do this even if MPI_Fint and int are the same size. */
-	    MPI_Fint ferr=errcode;
-	    MPI_Fint commhandle=comm_ptr->handle;
-	    (*comm_ptr->errhandler->errfn.F77_Handler_function)( &commhandle, 
-								 &ferr );
-	}
+	    /* FIXME: If an MPI_Fint isn't an int, this code is wrong */
+	    (*comm_ptr->errhandler->errfn.F77_Handler_function)( 
+		(MPI_Fint *)&comm_ptr->handle, &errcode );
 	    break;
 #endif /* FORTRAN_BINDING */
 	}
@@ -342,15 +326,8 @@ int MPIR_Err_return_win( MPID_Win  *win_ptr, const char fcname[], int errcode )
 #ifdef HAVE_FORTRAN_BINDING
 	    case MPID_LANG_FORTRAN90:
 	    case MPID_LANG_FORTRAN:
-		{
-		    /* If int and MPI_Fint aren't the same size, we need to 
-		       convert.  As this is not performance critical, we
-		       do this even if MPI_Fint and int are the same size. */
-		    MPI_Fint ferr=errcode;
-		    MPI_Fint winhandle=win_ptr->handle;
-		    (*win_ptr->errhandler->errfn.F77_Handler_function)( 
-						       &winhandle, &ferr );
-		}
+		(*win_ptr->errhandler->errfn.F77_Handler_function)( 
+		    (MPI_Fint *)&win_ptr->handle, &errcode );
 		break;
 #endif /* FORTRAN_BINDING */
 	}

src/mpi/errhan/file_call_errhandler.c

@@ -113,9 +113,7 @@ int MPI_File_call_errhandler(MPI_File fh, int errorcode)
 	   the value is really const (but MPI didn't define error handlers 
 	   with const), this preserves the intent */
 	{ void *fh1 = (void *)&fh;
-	    MPI_Fint ferr = errorcode;  /* Needed if MPI_Fint and int aren't 
-					   the same size */
-	(*e->errfn.F77_Handler_function)( fh1, &ferr );
+	(*e->errfn.F77_Handler_function)( fh1, &errorcode );
 	}
 	break;
 #endif

src/mpi/errhan/win_call_errhandler.c

@@ -134,14 +134,8 @@ int MPI_Win_call_errhandler(MPI_Win win, int errorcode)
 #ifdef HAVE_FORTRAN_BINDING
     case MPID_LANG_FORTRAN90:
     case MPID_LANG_FORTRAN:
-	{
-	    /* If int and MPI_Fint aren't the same size, we need to 
-	       convert.  As this is not performance critical, we
-	       do this even if MPI_Fint and int are the same size. */
-	    MPI_Fint ferr=errorcode;
-	    MPI_Fint winhandle=win_ptr->handle;
-	(*win_ptr->errhandler->errfn.F77_Handler_function)( &winhandle, &ferr );
-	}
+	(*win_ptr->errhandler->errfn.F77_Handler_function)( 
+	    (MPI_Fint *)&win_ptr->handle, &errorcode );
 	break;
 #endif
     }