From cce2f17588840ed67dae9c17507fe5957f87b85a Mon Sep 17 00:00:00 2001 From: degomme Date: Mon, 8 Apr 2019 11:54:19 +0200 Subject: [PATCH] fortran : avoid removing groups and communicators from the lookup table if they are not really freed and possibly shared with other processes (comm_world). --- src/smpi/bindings/smpi_f77.cpp | 13 +++++++------ src/smpi/bindings/smpi_f77_comm.cpp | 7 +++---- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/src/smpi/bindings/smpi_f77.cpp b/src/smpi/bindings/smpi_f77.cpp index 407ff14246..0c25e440c4 100644 --- a/src/smpi/bindings/smpi_f77.cpp +++ b/src/smpi/bindings/smpi_f77.cpp @@ -98,7 +98,7 @@ void mpi_group_incl_(int* group, int* n, int* ranks, int* group_out, int* ierr) *ierr = MPI_Group_incl(simgrid::smpi::Group::f2c(*group), *n, ranks, &tmp); if(*ierr == MPI_SUCCESS) { - *group_out = tmp->add_f(); + *group_out = tmp->c2f(); } } @@ -508,11 +508,12 @@ void mpi_op_commutative_ (int* op, int* commute, int* ierr){ } void mpi_group_free_ (int* group, int* ierr){ - MPI_Group tmp = simgrid::smpi::Group::f2c(*group); - *ierr = MPI_Group_free(&tmp); - if(*ierr == MPI_SUCCESS) { - simgrid::smpi::F2C::free_f(*group); - } + MPI_Group tmp = simgrid::smpi::Group::f2c(*group); + if(tmp != MPI_COMM_WORLD->group() && tmp != MPI_GROUP_EMPTY){ + simgrid::smpi::Group::unref(tmp); + simgrid::smpi::F2C::free_f(*group); + } + *ierr = MPI_SUCCESS; } void mpi_group_size_ (int* group, int *size, int* ierr){ diff --git a/src/smpi/bindings/smpi_f77_comm.cpp b/src/smpi/bindings/smpi_f77_comm.cpp index 750ea02a62..219ea38f71 100644 --- a/src/smpi/bindings/smpi_f77_comm.cpp +++ b/src/smpi/bindings/smpi_f77_comm.cpp @@ -37,12 +37,11 @@ void mpi_comm_create_(int* comm, int* group, int* newcomm, int* ierr) { void mpi_comm_free_(int* comm, int* ierr) { MPI_Comm tmp = simgrid::smpi::Comm::f2c(*comm); - - *ierr = MPI_Comm_free(&tmp); - - if(*ierr == MPI_SUCCESS) { + if(tmp != MPI_COMM_WORLD && tmp != MPI_COMM_NULL) { + simgrid::smpi::Comm::destroy(tmp); simgrid::smpi::Comm::free_f(*comm); } + *ierr = MPI_SUCCESS; } void mpi_comm_split_(int* comm, int* color, int* key, int* comm_out, int* ierr) { -- 2.20.1