This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.
Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
---|---|---|
Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |
Other format: | [Raw text] |
Hi all, attached patch fixes some issue in caf/single.c that were reported as pure style issues, but uncovered at least one significant error when handling sending data to a remote image when the memory and associated token was not allocated yet. The send_by_ref-routine stored the new token only on the stack when the component to allocate was scalar which lead to crashes, when that token was later on accessed. Furthermore was the memory and the token lost. This patch fixes the issue. Bootstraps and regtests ok on x86_64-linux/F23. Ok for trunk? Regards, Andre -- Andre Vehreschild * Email: vehre ad gmx dot de
Attachment:
pr77663_v1.clog
Description: Text document
diff --git a/gcc/testsuite/gfortran.dg/coarray_send_by_ref_1.f08 b/gcc/testsuite/gfortran.dg/coarray_send_by_ref_1.f08 new file mode 100644 index 0000000..73f91e0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_send_by_ref_1.f08 @@ -0,0 +1,29 @@ +! { dg-do run } +! { dg-options "-fcoarray=lib -lcaf_single" } + +program check_caf_send_by_ref + + implicit none + + type T + integer, allocatable :: scal + integer, allocatable :: array(:) + end type T + + type(T), save :: obj[*] + integer :: me, np, i + + me = this_image() + np = num_images() + + obj[np]%scal = 42 + + ! Check the token for the scalar is set. + if (obj[np]%scal /= 42) call abort() + + ! Now the same for arrays. + obj[np]%array = [(i * np + me, i = 1, 15)] + if (any(obj[np]%array /= [(i * np + me, i = 1, 15)])) call abort() + +end program check_caf_send_by_ref + diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c index c472446..55171fd 100644 --- a/libgfortran/caf/single.c +++ b/libgfortran/caf/single.c @@ -87,6 +87,7 @@ caf_internal_error (const char *msg, int *stat, char *errmsg, if ((size_t)errmsg_len > len) memset (&errmsg[len], ' ', errmsg_len - len); } + va_end (args); return; } else @@ -149,6 +150,13 @@ _gfortran_caf_register (size_t size, caf_register_t type, caf_token_t *token, if (unlikely (local == NULL || *token == NULL)) { + /* Freeing the memory conditionally seems pointless, but + caf_internal_error () may return, when a stat is given and then the + memory may be lost. */ + if (local) + free (local); + if (*token) + free (*token); caf_internal_error (alloc_fail_msg, stat, errmsg, errmsg_len); return; } @@ -1465,7 +1473,7 @@ _gfortran_caf_get_by_ref (caf_token_t token, bool array_extent_fixed = false; realloc_needed = realloc_required = GFC_DESCRIPTOR_DATA (dst) == NULL; - assert (!realloc_needed || (realloc_needed && dst_reallocatable)); + assert (!realloc_needed || dst_reallocatable); if (stat) *stat = 0; @@ -1909,14 +1917,14 @@ send_by_ref (caf_reference_t *ref, size_t *i, size_t *src_index, GFC_DESCRIPTOR_DATA (&static_dst) = NULL; GFC_DESCRIPTOR_DTYPE (&static_dst) = GFC_DESCRIPTOR_DTYPE (src); - /* The component may be allocated now, because it is a + /* The component can be allocated now, because it is a scalar. */ - single_token = *(caf_single_token_t*) - (ds + ref->u.c.caf_token_offset); _gfortran_caf_register (ref->item_size, CAF_REGTYPE_COARRAY_ALLOC, - (caf_token_t *)&single_token, + ds + ref->u.c.caf_token_offset, &static_dst, stat, NULL, 0); + single_token = *(caf_single_token_t *) + (ds + ref->u.c.caf_token_offset); /* In case of an error in allocation return. When stat is NULL, then register_component() terminates on error. */ if (stat != NULL && *stat) @@ -2005,15 +2013,13 @@ send_by_ref (caf_reference_t *ref, size_t *i, size_t *src_index, /* The size of the array is given by size. */ _gfortran_caf_register (size * ref->item_size, CAF_REGTYPE_COARRAY_ALLOC, - (void **)&single_token, + ds + ref->u.c.caf_token_offset, dst, stat, NULL, 0); /* In case of an error in allocation return. When stat is NULL, then register_component() terminates on error. */ if (stat != NULL && *stat) return; /* The memptr, descriptor and the token are set below. */ - *(caf_single_token_t *)(ds + ref->u.c.caf_token_offset) - = single_token; } single_token = *(caf_single_token_t*)(ds + ref->u.c.caf_token_offset); send_by_ref (ref->next, i, src_index, single_token,
Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
---|---|---|
Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |