diff mbox

[Fortran,pr77663,v1] libgfortran/caf/single.c: three minor problems and a lost token

Message ID 20161001160124.402ee26a@vepi2
State New
Headers show

Commit Message

Andre Vehreschild Oct. 1, 2016, 2:01 p.m. UTC 
Hi Paul,

thanks for the fast review. Committed as r240695.

Regards,
	Andre

On Sat, 1 Oct 2016 14:42:35 +0200
Paul Richard Thomas <paul.richard.thomas@gmail.com> wrote:

> Hi Andre,
> 
> It looks fine to me - OK for trunk.
> 
> Thanks for the patch
> 
> Paul
> 
> On 1 October 2016 at 13:30, Andre Vehreschild <vehre@gmx.de> wrote:
> > 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  
> 
> 
>
diff mbox

Patch

Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog	(Revision 240694)
+++ gcc/testsuite/ChangeLog	(Arbeitskopie)
@@ -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
Index: gcc/testsuite/gfortran.dg/coarray_send_by_ref_1.f08
===================================================================
--- gcc/testsuite/gfortran.dg/coarray_send_by_ref_1.f08	(nicht existent)
+++ gcc/testsuite/gfortran.dg/coarray_send_by_ref_1.f08	(Arbeitskopie)
@@ -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
+
Index: libgfortran/ChangeLog
===================================================================
--- libgfortran/ChangeLog	(Revision 240694)
+++ libgfortran/ChangeLog	(Arbeitskopie)
@@ -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
Index: libgfortran/caf/single.c
===================================================================
--- libgfortran/caf/single.c	(Revision 240694)
+++ libgfortran/caf/single.c	(Arbeitskopie)
@@ -87,6 +87,7 @@ 
 	  if ((size_t)errmsg_len > len)
 	    memset (&errmsg[len], ' ', errmsg_len - len);
 	}
+      va_end (args);
       return;
     }
   else
@@ -149,6 +150,13 @@ 
 
   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 @@ 
   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 @@ 
 		  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 @@ 
 	      /* 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,