From 0f0565b1438c82118f1f31f6880c509c472c3bf5 Mon Sep 17 00:00:00 2001 From: Andre Vehreschild Date: Sat, 1 Oct 2016 16:00:57 +0200 Subject: [PATCH] re PR libfortran/77663 (libgfortran/caf/single.c: three minor problems and a lost token) gcc/testsuite/ChangeLog: 2016-10-01 Andre Vehreschild PR fortran/77663 * gfortran.dg/coarray_send_by_ref_1.f08: New test. libgfortran/ChangeLog: 2016-10-01 Andre Vehreschild PR fortran/77663 * caf/single.c (caf_internal_error): Fix not terminating va-list. (_gfortran_caf_register): Free memory also when other allocs failed. (_gfortran_caf_get_by_ref): Fixed style. (send_by_ref): Token is now stored at the correct position preventing inaccessible tokens, memory loss and possibly crashes. From-SVN: r240695 --- gcc/testsuite/ChangeLog | 5 ++++ .../gfortran.dg/coarray_send_by_ref_1.f08 | 29 +++++++++++++++++++ libgfortran/ChangeLog | 9 ++++++ libgfortran/caf/single.c | 23 +++++++++------ 4 files changed, 57 insertions(+), 9 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/coarray_send_by_ref_1.f08 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index d19b03fee63..feb787754c7 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2016-10-01 Andre Vehreschild + + PR fortran/77663 + * gfortran.dg/coarray_send_by_ref_1.f08: New test. + 2016-10-01 Jakub Jelinek PR c/77490 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 00000000000..73f91e03993 --- /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/ChangeLog b/libgfortran/ChangeLog index c58ad5d0ca0..5430ed18850 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,12 @@ +2016-10-01 Andre Vehreschild + + PR fortran/77663 + * caf/single.c (caf_internal_error): Fix not terminating va-list. + (_gfortran_caf_register): Free memory also when other allocs failed. + (_gfortran_caf_get_by_ref): Fixed style. + (send_by_ref): Token is now stored at the correct position preventing + inaccessible tokens, memory loss and possibly crashes. + 2016-09-28 Jerry DeLisle PR libgfortran/77707 diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c index c4724460290..00b71208473 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,12 @@ 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,