2011-08-26 Tobias Burnus <burnus@net-b.de>
* caf/libcaf.h (_gfortran_caf_deregister): Update prototype.
* caf/mpi.c (_gfortran_caf_deregister): Modify prototype,
actually free memory and add error diagnostic.
* caf/single.c (_gfortran_caf_deregister): Ditto.
@@ -69,7 +69,7 @@ void _gfortran_caf_finalize (void);
void * _gfortran_caf_register (ptrdiff_t, caf_register_t, void **, int *,
char *, int);
-int _gfortran_caf_deregister (void **);
+void _gfortran_caf_deregister (void **, int *, char *, int);
void _gfortran_caf_sync_all (int *, char *, int);
@@ -103,7 +103,7 @@ _gfortran_caf_finalize (void)
{
while (caf_static_list != NULL)
{
- free(caf_static_list->token[caf_this_image-1]);
+ free (caf_static_list->token[caf_this_image-1]);
caf_static_list = caf_static_list->prev;
}
@@ -187,10 +187,36 @@ error:
}
-int
-_gfortran_caf_deregister (void **token __attribute__ ((unused)))
+void
+_gfortran_caf_deregister (void **token, int *stat, char *errmsg, int errmsg_len)
{
- return 0;
+ if (unlikely (caf_is_finalized))
+ {
+ const char msg[] = "Failed to deallocate coarray - "
+ "there are stopped images";
+ if (stat)
+ {
+ *stat = STAT_STOPPED_IMAGE;
+
+ if (errmsg_len > 0)
+ {
+ int len = ((int) sizeof (msg) - 1 > errmsg_len)
+ ? errmsg_len : (int) sizeof (msg) - 1;
+ memcpy (errmsg, msg, len);
+ if (errmsg_len > len)
+ memset (&errmsg[len], ' ', errmsg_len-len);
+ }
+ return;
+ }
+ caf_runtime_error (msg);
+ }
+
+ _gfortran_caf_sync_all (NULL, NULL, 0);
+
+ if (stat)
+ *stat = 0;
+
+ free (token[caf_this_image-1]);
}
@@ -267,7 +293,7 @@ _gfortran_caf_sync_images (int count, int images[], int *stat, char *errmsg,
}
/* Handle SYNC IMAGES(*). */
- if (unlikely(caf_is_finalized))
+ if (unlikely (caf_is_finalized))
ierr = STAT_STOPPED_IMAGE;
else
ierr = MPI_Barrier (MPI_COMM_WORLD);
@@ -121,10 +121,15 @@ _gfortran_caf_register (ptrdiff_t size, caf_register_t type, void **token,
}
-int
-_gfortran_caf_deregister (void **token __attribute__ ((unused)))
+void
+_gfortran_caf_deregister (void **token, int *stat,
+ char *errmsg __attribute__ ((unused)),
+ int errmsg_len __attribute__ ((unused)))
{
- return 0;
+ free (*token);
+
+ if (stat)
+ *stat = 0;
}