A few more errhandler things; should be complete for comms now (still

have fortran issues to do)

This commit was SVN r945.

src/errhandler/errhandler.c

@@ -39,6 +39,7 @@ lam_errhandler_t lam_mpi_errhandler_null = {
     { NULL, 0 },
 
     "MPI_ERRHANDLER_NULL",
+    true,
     false,
     LAM_ERRHANDLER_TYPE_COMM,
     { NULL }
@@ -52,6 +53,7 @@ lam_errhandler_t lam_mpi_errors_are_fatal = {
     { NULL, 0 },
 
     "MPI_ERRORS_ARE_FATAL",
+    true,
     false,
     LAM_ERRHANDLER_TYPE_COMM,
     { lam_mpi_errors_are_fatal_handler },
@@ -66,6 +68,7 @@ lam_errhandler_t lam_mpi_errors_return = {
     { NULL, 0 },
 
     "MPI_ERRORS_ARE_RETURN",
+    true,
     false,
     LAM_ERRHANDLER_TYPE_COMM,
     { lam_mpi_errors_return_handler },

src/errhandler/errhandler.h

@@ -49,8 +49,9 @@ struct lam_errhandler_t {
 
   lam_errhandler_type_t eh_mpi_object_type;
 
-  /* Is this a fortran function? */
+  /* Flags about the error handler */
 
+  bool eh_is_intrinsic;
   bool eh_fortran_function;
 
   /* Function pointers */
@@ -214,4 +215,18 @@ extern "C" {
 }
 #endif
 
+
+/**
+ * Check to see if an errhandler is intrinsic.
+ *
+ * @param errhandler The errhandler to check
+ *
+ * @returns true If the errhandler is intrinsic
+ * @returns false If the errhandler is not intrinsic
+ */
+static inline bool lam_errhandler_is_intrinsic(lam_errhandler_t *errhandler)
+{
+  return errhandler->eh_is_intrinsic;
+}
+
 #endif /* LAM_ERRHANDLER_H */

src/mpi/c/comm_call_errhandler.c

@@ -6,12 +6,28 @@
 
 #include "mpi.h"
 #include "mpi/c/bindings.h"
+#include "errhandler/errhandler.h"
+#include "communicator/communicator.h"
 
 #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES
 #pragma weak MPI_Comm_call_errhandler = PMPI_Comm_call_errhandler
 #endif
     
 
-int MPI_Comm_call_errhandler(MPI_Comm comm, int errorcode) {
-    return MPI_SUCCESS;
+int MPI_Comm_call_errhandler(MPI_Comm comm, int errorcode)
+{
+  /* Error checking */
+
+  if (MPI_PARAM_CHECK) {
+    if (NULL == comm ||
+        MPI_COMM_NULL == comm) {
+      return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
+                                   "MPI_Comm_call_errhandler");
+    }
+  }
+
+  /* Invoke the errhandler */
+
+  return LAM_ERRHANDLER_INVOKE(comm, errorcode,
+                               "MPI_Comm_call_errhandler");
 }

src/mpi/c/comm_get_errhandler.c

@@ -22,10 +22,10 @@ int MPI_Comm_get_errhandler(MPI_Comm comm, MPI_Errhandler *errhandler)
     if (NULL == comm || 
         MPI_COMM_NULL == comm) {
       return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
-                                   "MPI_Comm_set_errhandler");
+                                   "MPI_Comm_get_errhandler");
     } else if (NULL == errhandler) {
       return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
-                                   "MPI_Comm_create_errhandler");
+                                   "MPI_Comm_get_errhandler");
     }
   }
 

src/mpi/c/comm_set_errhandler.c

@@ -34,6 +34,8 @@ int MPI_Comm_set_errhandler(MPI_Comm comm, MPI_Errhandler errhandler)
   /* We have a valid comm and errhandler */
 
   comm->error_handler = errhandler;
+
+  /* All done */
   
   return MPI_SUCCESS;
 }

src/mpi/c/errhandler_create.c

@@ -12,6 +12,10 @@
 #endif
 
 int MPI_Errhandler_create(MPI_Handler_function *function,
-		                   MPI_Errhandler *errhandler) {
-    return MPI_SUCCESS;
+                          MPI_Errhandler *errhandler)
+{
+  /* This is a deprecated -- just turn around and call the real
+     function */
+
+  return MPI_Comm_create_errhandler(function, errhandler);
 }

src/mpi/c/errhandler_free.c

@@ -6,6 +6,8 @@
 
 #include "mpi.h"
 #include "mpi/c/bindings.h"
+#include "errhandler/errhandler.h"
+#include "communicator/communicator.h"
 
 #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES
 #pragma weak MPI_Errhandler_free = PMPI_Errhandler_free
@@ -14,5 +16,22 @@
 
 int MPI_Errhandler_free(MPI_Errhandler *errhandler)
 {
+  /* Error checking */
+
+  if (MPI_PARAM_CHECK) {
+    if (NULL == errhandler ||
+        lam_errhandler_is_intrinsic(*errhandler)) {
+      return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
+                                   "MPI_Errhandler_free");
+    }
+  }
+
+  /* We have a valid errhandler, release it */
+
+  OBJ_RELEASE(*errhandler);
+  *errhandler = MPI_ERRHANDLER_NULL;
+
+  /* All done */
+
   return MPI_SUCCESS;
 }

src/mpi/checklist.txt

@@ -61,7 +61,7 @@ MPI_Comm_f2c
 MPI_Comm_free_keyval
 MPI_Comm_free               Edgar
 MPI_Comm_get_attr
-MPI_Comm_get_errhandler     Jeff
+MPI_Comm_get_errhandler     DONE
 MPI_Comm_get_name           Edgar
 MPI_Comm_get_parent
 MPI_Comm_group              Edgar
@@ -70,7 +70,7 @@ MPI_Comm_rank               Edgar
 MPI_Comm_remote_group       Edgar
 MPI_Comm_remote_size        Edgar
 MPI_Comm_set_attr
-MPI_Comm_set_errhandler     Jeff
+MPI_Comm_set_errhandler     DONE
 MPI_Comm_set_name           Edgar
 MPI_Comm_size               Edgar
 MPI_Comm_spawn
@@ -81,7 +81,7 @@ MPI_Dims_create
 MPI_Errhandler_c2f
 MPI_Errhandler_create       DONE
 MPI_Errhandler_f2c
-MPI_Errhandler_free         Jeff
+MPI_Errhandler_free         DONE
 MPI_Errhandler_get          DONE
 MPI_Errhandler_set          DONE
 MPI_Error_class