From 4d97203e9de941c263eb04339bbc7587c6b3e63c Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <vehre@gmx.de>
Date: Wed, 2 Oct 2024 15:35:50 +0200
Subject: [PATCH] Purge communicator before free on mpich4+.

Mpich from 4.0 on seems to bug when there is a message dangling on
freeing the communicator.
---
 src/runtime-libraries/mpi/mpi_caf.c | 17 +++++++++++++++++
 1 file changed, 17 insertions(+)

diff --git a/src/runtime-libraries/mpi/mpi_caf.c b/src/runtime-libraries/mpi/mpi_caf.c
index ce63f724..a3866675 100644
--- a/src/runtime-libraries/mpi/mpi_caf.c
+++ b/src/runtime-libraries/mpi/mpi_caf.c
@@ -1104,6 +1104,23 @@ finalize_internal(int status_code)
     ierr = MPI_Finalize(); chk_err(ierr);
   }
 #else
+#ifdef MPICH
+  {
+    int probe_flag;
+    MPI_Status status;
+    do {
+      ierr = MPI_Iprobe(MPI_ANY_SOURCE, MPI_ANY_TAG, CAF_COMM_WORLD, &probe_flag,
+                        &status); /* error is not of interest. */
+      if (probe_flag) {
+        int cnt;
+        MPI_Get_count(&status, MPI_BYTE, &cnt);
+        void * buf = alloca(cnt);
+        ierr = MPI_Recv(buf, cnt, MPI_BYTE, status.MPI_SOURCE, status.MPI_TAG,
+                        CAF_COMM_WORLD, &status); chk_err(ierr);
+      }
+    } while (probe_flag);
+  }
+#endif
   ierr = MPI_Comm_free(&CAF_COMM_WORLD); chk_err(ierr);
 
   CAF_Win_unlock_all(*stat_tok);