Implemented MPI_Errhandler_f2c and MPI_Errhandler_c2f

This commit was SVN r947.

src/errhandler/errhandler.c

@@ -10,20 +10,7 @@
 #include "file/file.h"
 #include "errhandler/errhandler.h"
 #include "errhandler/errhandler_predefined.h"
-
-
-/* define class information */
-
-static void lam_errhandler_construct(lam_errhandler_t *eh);
-static void lam_errhandler_destruct(lam_errhandler_t *eh);
-
-
-lam_class_t lam_errhandler_t_class = {
-    "lam_errhandler_t",
-    OBJ_CLASS(lam_object_t),
-    (lam_construct_t) lam_errhandler_construct,
-    (lam_destruct_t) lam_errhandler_destruct
-};
+#include "lfc/lam_pointer_array.h"
 
 
 /*
@@ -32,6 +19,21 @@ lam_class_t lam_errhandler_t_class = {
 lam_pointer_array_t *lam_errhandler_f_to_c_table;
 
 
+/*
+ * Class information
+ */
+static void lam_errhandler_construct(lam_errhandler_t *eh);
+static void lam_errhandler_destruct(lam_errhandler_t *eh);
+
+
+static lam_class_t lam_errhandler_t_class = {
+    "lam_errhandler_t",
+    OBJ_CLASS(lam_object_t),
+    (lam_construct_t) lam_errhandler_construct,
+    (lam_destruct_t) lam_errhandler_destruct
+};
+
+
 /*
  * MPI_ERRHANDLER_NULL
  */

src/errhandler/errhandler.h

@@ -9,6 +9,7 @@
 
 #include "mpi.h"
 #include "lfc/lam_object.h"
+#include "lfc/lam_pointer_array.h"
 
 /* This must correspond to the fortran MPI_ERRHANDLER_NULL index */
 #define LAM_ERRHANDLER_NULL_FORTRAN 0
@@ -86,6 +87,10 @@ extern lam_errhandler_t lam_mpi_errors_are_fatal;
  */
 extern lam_errhandler_t lam_mpi_errors_return;
 
+/**
+ * Table for Fortran <-> C errhandler handle conversion
+ */
+extern lam_pointer_array_t *lam_errhandler_f_to_c_table;
 
 
 /**

src/mpi/c/errhandler_c2f.c

@@ -6,11 +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_Errhandler_c2f = PMPI_Errhandler_c2f
 #endif
 
-MPI_Fint MPI_Errhandler_c2f(MPI_Errhandler errhandler) {
-    return (MPI_Fint)0;
+
+MPI_Fint MPI_Errhandler_c2f(MPI_Errhandler errhandler)
+{
+  /* Error checking */
+
+  if (MPI_PARAM_CHECK) {
+    if (NULL == errhandler ||
+        MPI_ERRHANDLER_NULL == errhandler ||
+        LAM_ERRHANDLER_TYPE_COMM != errhandler->eh_mpi_object_type) {
+      return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
+                                   "MPI_Errhandler_c2f");
+    }
+  }
+
+  /* All done */
+
+  return (MPI_Fint) errhandler->eh_f_to_c_index;
 }

src/mpi/c/errhandler_f2c.c

@@ -6,11 +6,27 @@
 
 #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_f2c = PMPI_Errhandler_f2c
 #endif
 
-MPI_Errhandler MPI_Errhandler_f2c(MPI_Fint errhandler) {
-    return (MPI_Errhandler)0;
+
+MPI_Errhandler MPI_Errhandler_f2c(MPI_Fint errhandler_f)
+{
+  int eh_index = (int) errhandler_f;
+
+  /* Error checking */
+
+  if (MPI_PARAM_CHECK) {
+    if (0 > eh_index || eh_index >= lam_errhandler_f_to_c_table->size) {
+      return MPI_ERRHANDLER_NULL;
+    }
+  }
+
+  /* All done */
+
+  return lam_errhandler_f_to_c_table->addr[eh_index];
 }

src/mpi/checklist.txt

@@ -48,7 +48,7 @@ MPI_Cartdim_get
 MPI_Close_port
 MPI_Comm_accept
 MPI_Comm_c2f
-MPI_Comm_call_errhandler    Jeff
+MPI_Comm_call_errhandler    DONE
 MPI_Comm_compare            Edgar
 MPI_Comm_connect
 MPI_Comm_create_errhandler  DONE
@@ -78,9 +78,9 @@ MPI_Comm_spawn_multiple
 MPI_Comm_split              Edgar
 MPI_Comm_test_inter         Edgar
 MPI_Dims_create
-MPI_Errhandler_c2f
+MPI_Errhandler_c2f          DONE
 MPI_Errhandler_create       DONE
-MPI_Errhandler_f2c
+MPI_Errhandler_f2c          DONE
 MPI_Errhandler_free         DONE
 MPI_Errhandler_get          DONE
 MPI_Errhandler_set          DONE