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

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

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

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
+

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

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,