re PR libfortran/77663 (libgfortran/caf/single.c: three minor problems and a lost...

gcc/testsuite/ChangeLog:

2016-10-01  Andre Vehreschild  <vehre@gcc.gnu.org>

	PR fortran/77663
	* gfortran.dg/coarray_send_by_ref_1.f08: New test.

libgfortran/ChangeLog:

2016-10-01  Andre Vehreschild  <vehre@gcc.gnu.org>

	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

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index d19b03fee63b11b15e9bba344b4fda0a64de4b2f..feb787754c7cb29b288edc2ea963c15b5cba2f51 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2016-10-01  Andre Vehreschild  <vehre@gcc.gnu.org>
+
+       PR fortran/77663
+       * gfortran.dg/coarray_send_by_ref_1.f08: New test.
+
 2016-10-01  Jakub Jelinek  <jakub@redhat.com>
 
        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 (file)
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/ChangeLog b/libgfortran/ChangeLog
index c58ad5d0ca0dc3d53ef6e2bde0831c794546fdb4..5430ed188509ffc2ed5574f78f475b53d13fd20b 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,12 @@
+2016-10-01  Andre Vehreschild  <vehre@gcc.gnu.org>
+
+       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  <jvdelisle@gcc.gnu.org>
 
        PR libgfortran/77707

diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c
index c47244602904dad0fdf612ff14c709a2f7b2a0af..00b71208473819b4567639eddfa7cb55d372e942 100644 (file)
--- 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,