Checking in the files to complete the MPI errhandler functions

This commit was SVN r1053.

include/mpi.h

@@ -262,6 +262,7 @@ enum {
 #define MPI_ERRHANDLER_NULL ((MPI_Errhandler) &(lam_mpi_errhandler_null))
 #define MPI_INFO_NULL ((MPI_Info) 0)
 #define MPI_WIN_NULL ((MPI_Win) 0)
+#define MPI_FILE_NULL ((MPI_File) 0)
 
 #define MPI_STATUS_IGNORE ((MPI_Status *) 0)
 #define MPI_STATUSES_IGNORE ((MPI_Status *) 0)

src/mpi/c/file_call_errhandler.c

@@ -6,11 +6,27 @@
 
 #include "mpi.h"
 #include "mpi/c/bindings.h"
+#include "errhandler/errhandler.h"
+#include "communicator/communicator.h"
+#include "file/file.h"
 
 #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES
 #pragma weak MPI_File_call_errhandler = PMPI_File_call_errhandler
 #endif
 
 int MPI_File_call_errhandler(MPI_File fh, int errorcode) {
-    return MPI_SUCCESS;
+  /* Error checking */
+
+  if (MPI_PARAM_CHECK) {
+    if (NULL == fh ||
+        MPI_FILE_NULL == fh) {
+      return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
+                                   "MPI_File_call_errhandler");
+    }
+  }
+
+  /* Invoke the errhandler */
+
+  return LAM_ERRHANDLER_INVOKE(fh, errorcode,
+                               "MPI_File_call_errhandler");
 }

src/mpi/c/file_create_errhandler.c

@@ -6,6 +6,9 @@
 
 #include "mpi.h"
 #include "mpi/c/bindings.h"
+#include "communicator/communicator.h"
+#include "errhandler/errhandler.h"
+#include "file/file.h"
 
 #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES
 #pragma weak MPI_File_create_errhandler = PMPI_File_create_errhandler
@@ -13,5 +16,27 @@
 
 int MPI_File_create_errhandler(MPI_File_errhandler_fn *function,
 		                        MPI_Errhandler *errhandler) {
-    return MPI_SUCCESS;
+  int err = MPI_SUCCESS;
+
+  /* Error checking */
+
+  if (MPI_PARAM_CHECK) {
+    if (NULL == function || 
+        NULL == errhandler) {
+      return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
+                                   "MPI_File_create_errhandler");
+    }
+  }
+
+  /* Create and cache the errhandler.  Sets a refcount of 1. */
+
+  *errhandler = 
+    lam_errhandler_create(LAM_ERRHANDLER_TYPE_FILE,
+                          (lam_errhandler_fortran_handler_fn_t*) function);
+  if (NULL == *errhandler) {
+    err = MPI_ERR_INTERN;
+  }
+
+  LAM_ERRHANDLER_RETURN(err, MPI_COMM_WORLD, MPI_ERR_INTERN,
+                        "MPI_File_create_errhandler");
 }

src/mpi/c/file_get_errhandler.c

@@ -6,11 +6,33 @@
 
 #include "mpi.h"
 #include "mpi/c/bindings.h"
+#include "communicator/communicator.h"
+#include "errhandler/errhandler.h"
+#include "file/file.h"
 
 #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES
 #pragma weak MPI_File_get_errhandler = PMPI_File_get_errhandler
 #endif
 
 int MPI_File_get_errhandler( MPI_File file, MPI_Errhandler *errhandler) {
-    return MPI_SUCCESS;
+  /* Error checking */
+
+  if (MPI_PARAM_CHECK) {
+    if (NULL == file || 
+        MPI_FILE_NULL == file) {
+      return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
+                                   "MPI_File_get_errhandler");
+    } else if (NULL == errhandler) {
+      return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
+                                   "MPI_File_get_errhandler");
+    }
+  }
+
+  /* Return the errhandler.  Do not increase the refcount here; we
+     only refcount on communicators */
+
+  *errhandler = file->error_handler;
+
+  /* All done */
+  return MPI_SUCCESS;
 }

src/mpi/c/file_set_errhandler.c

@@ -6,11 +6,39 @@
 
 #include "mpi.h"
 #include "mpi/c/bindings.h"
+#include "communicator/communicator.h"
+#include "errhandler/errhandler.h"
+#include "file/file.h"
 
 #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES
 #pragma weak MPI_File_set_errhandler = PMPI_File_set_errhandler
 #endif
 
 int MPI_File_set_errhandler( MPI_File file, MPI_Errhandler errhandler) {
-    return MPI_SUCCESS;
+  /* Error checking */
+
+  if (MPI_PARAM_CHECK) {
+    if (NULL == file || 
+        MPI_FILE_NULL == file) {
+      return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
+                                   "MPI_File_set_errhandler");
+    } else if (NULL == errhandler ||
+               MPI_ERRHANDLER_NULL == errhandler ||
+               LAM_ERRHANDLER_TYPE_FILE != errhandler->eh_mpi_object_type) {
+      return LAM_ERRHANDLER_INVOKE(file, MPI_ERR_ARG,
+                               "MPI_File_set_errhandler");
+    }
+  }
+
+  /* Ditch the old errhandler, and decrement its refcount */
+
+  OBJ_RELEASE(file->error_handler);
+
+  /* We have a valid comm and errhandler, so increment its refcount */
+
+  file->error_handler = errhandler;
+  OBJ_RETAIN(file->error_handler);
+
+  /* All done */
+  return MPI_SUCCESS;
 }

src/mpi/c/win_call_errhandler.c

@@ -6,11 +6,27 @@
 
 #include "mpi.h"
 #include "mpi/c/bindings.h"
+#include "errhandler/errhandler.h"
+#include "communicator/communicator.h"
+#include "win/win.h"
 
 #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES
 #pragma weak MPI_Win_call_errhandler = PMPI_Win_call_errhandler
 #endif
 
 int MPI_Win_call_errhandler(MPI_Win win, int errorcode) {
-    return MPI_SUCCESS;
+  /* Error checking */
+
+  if (MPI_PARAM_CHECK) {
+    if (NULL == win ||
+        MPI_WIN_NULL == win) {
+      return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
+                                   "MPI_Win_call_errhandler");
+    }
+  }
+
+  /* Invoke the errhandler */
+
+  return LAM_ERRHANDLER_INVOKE(win, errorcode,
+                               "MPI_Win_call_errhandler");
 }

src/mpi/c/win_create_errhandler.c

@@ -6,6 +6,9 @@
 
 #include "mpi.h"
 #include "mpi/c/bindings.h"
+#include "errhandler/errhandler.h"
+#include "communicator/communicator.h"
+#include "win/win.h"
 
 #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES
 #pragma weak MPI_Win_create_errhandler = PMPI_Win_create_errhandler
@@ -13,5 +16,27 @@
 
 int MPI_Win_create_errhandler(MPI_Win_errhandler_fn *function,
                               MPI_Errhandler *errhandler) {
-    return MPI_SUCCESS;
+  int err = MPI_SUCCESS;
+
+  /* Error checking */
+
+  if (MPI_PARAM_CHECK) {
+    if (NULL == function || 
+        NULL == errhandler) {
+      return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
+                                   "MPI_Win_create_errhandler");
+    }
+  }
+
+  /* Create and cache the errhandler.  Sets a refcount of 1. */
+
+  *errhandler = 
+    lam_errhandler_create(LAM_ERRHANDLER_TYPE_WIN,
+                          (lam_errhandler_fortran_handler_fn_t*) function);
+  if (NULL == *errhandler) {
+    err = MPI_ERR_INTERN;
+  }
+
+  LAM_ERRHANDLER_RETURN(err, MPI_COMM_WORLD, MPI_ERR_INTERN,
+                        "MPI_Win_create_errhandler");
 }

src/mpi/c/win_get_errhandler.c

@@ -6,11 +6,34 @@
 
 #include "mpi.h"
 #include "mpi/c/bindings.h"
+#include "errhandler/errhandler.h"
+#include "communicator/communicator.h"
+#include "win/win.h"
 
 #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES
 #pragma weak MPI_Win_get_errhandler = PMPI_Win_get_errhandler
 #endif
 
 int MPI_Win_get_errhandler(MPI_Win win, MPI_Errhandler *errhandler) {
-    return MPI_SUCCESS;
+  /* Error checking */
+
+  if (MPI_PARAM_CHECK) {
+    if (NULL == win || 
+        MPI_WIN_NULL == win) {
+      return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
+                                   "MPI_Win_get_errhandler");
+    } else if (NULL == errhandler) {
+      return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
+                                   "MPI_Win_get_errhandler");
+    }
+  }
+
+  /* Return the errhandler.  Do not increase the refcount here; we
+     only refcount on communicators */
+
+  *errhandler = win->error_handler;
+
+  /* All done */
+
+  return MPI_SUCCESS;
 }

src/mpi/c/win_set_errhandler.c

@@ -6,11 +6,40 @@
 
 #include "mpi.h"
 #include "mpi/c/bindings.h"
+#include "errhandler/errhandler.h"
+#include "communicator/communicator.h"
+#include "win/win.h"
 
 #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES
 #pragma weak MPI_Win_set_errhandler = PMPI_Win_set_errhandler
 #endif
 
 int MPI_Win_set_errhandler(MPI_Win win, MPI_Errhandler errhandler) {
-    return MPI_SUCCESS;
+  /* Error checking */
+
+  if (MPI_PARAM_CHECK) {
+    if (NULL == win || 
+        MPI_WIN_NULL == win) {
+      return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
+                                   "MPI_Win_set_errhandler");
+    } else if (NULL == errhandler ||
+               MPI_ERRHANDLER_NULL == errhandler ||
+               LAM_ERRHANDLER_TYPE_WIN != errhandler->eh_mpi_object_type) {
+      return LAM_ERRHANDLER_INVOKE(win, MPI_ERR_ARG,
+                               "MPI_Win_set_errhandler");
+    }
+  }
+
+  /* Ditch the old errhandler, and decrement its refcount */
+
+  OBJ_RELEASE(win->error_handler);
+
+  /* We have a valid comm and errhandler, so increment its refcount */
+
+  win->error_handler = errhandler;
+  OBJ_RETAIN(win->error_handler);
+
+  /* All done */
+  
+  return MPI_SUCCESS;
 }