diff mbox

[Fortran,pr78356,v1,7,Regression,OOP] segfault allocating polymorphic variable with polymorphic component with allocatable component

Message ID 20161116144619.3f27bd85@vepi2
State New
Headers show

Commit Message

Andre Vehreschild Nov. 16, 2016, 1:46 p.m. UTC 
Hi Janus,

thanks for the quick review. Committed as r242490.

Regards,
	Andre

On Tue, 15 Nov 2016 22:24:43 +0100
Janus Weil <janus@gcc.gnu.org> wrote:

> Hi Andre,
> 
> > attached patch fixes the issue raised. The issue here was, that a copy of
> > the base class was generated and its address passed to the
> > _vptr->copy()-method, which then accessed memory, that was not present in
> > the copy being an object of the base class. The patch fixes this by making
> > sure the temporary handle is a pointer to the data to copy.
> >
> > Sorry, when that is not clear. I am not feeling so well today. So here in
> > terms of pseudo code. This code was formerly generated:
> >
> > struct ac {};
> > struct a : struct ac { integer *i; };
> >
> > a src, dst;
> > ac temp;
> >
> > temp = src; // temp is now only a copy of ac
> >
> > _vptr.copy(&temp, &dst); // temp does not denote memory having a pointer to
> > i
> >
> > After the patch, this code is generated:
> >
> > // types as above
> > a src, dst;
> > ac *temp; // !!! Now a pointer
> >
> > temp = &src;
> > _vptr.copy(temp, &dst); // temp now points to memory that has a pointer to i
> >                         // and is valid for copying.
> >
> > Bootstraps and regtests ok on x86_64-linux/F23. Ok for trunk?  
> 
> ok with me. Thanks for the quick fix!
> 
> Cheers,
> Janus
diff mbox

Patch

Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog	(Revision 242489)
+++ gcc/fortran/ChangeLog	(Arbeitskopie)
@@ -1,3 +1,11 @@ 
+2016-11-16  Andre Vehreschild  <vehre@gcc.gnu.org>
+
+	PR fortran/78356
+	* class.c (gfc_is_class_scalar_expr): Prevent taking an array ref for
+	a component ref.
+	* trans-expr.c (gfc_trans_assignment_1): Ensure a reference to the
+	object to copy is generated, when assigning class objects.
+
 2016-11-14  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	* dump-parse-tree.c (show_code):  Add prototype.
Index: gcc/fortran/class.c
===================================================================
--- gcc/fortran/class.c	(Revision 242489)
+++ gcc/fortran/class.c	(Arbeitskopie)
@@ -378,7 +378,8 @@ 
 	&& CLASS_DATA (e->symtree->n.sym)
 	&& !CLASS_DATA (e->symtree->n.sym)->attr.dimension
 	&& (e->ref == NULL
-	    || (strcmp (e->ref->u.c.component->name, "_data") == 0
+	    || (e->ref->type == REF_COMPONENT
+		&& strcmp (e->ref->u.c.component->name, "_data") == 0
 		&& e->ref->next == NULL)))
     return true;
 
@@ -390,7 +391,8 @@ 
 	    && CLASS_DATA (ref->u.c.component)
 	    && !CLASS_DATA (ref->u.c.component)->attr.dimension
 	    && (ref->next == NULL
-		|| (strcmp (ref->next->u.c.component->name, "_data") == 0
+		|| (ref->next->type == REF_COMPONENT
+		    && strcmp (ref->next->u.c.component->name, "_data") == 0
 		    && ref->next->next == NULL)))
 	return true;
     }
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(Revision 242489)
+++ gcc/fortran/trans-expr.c	(Arbeitskopie)
@@ -9628,6 +9628,7 @@ 
   int n;
   bool maybe_workshare = false;
   symbol_attribute lhs_caf_attr, rhs_caf_attr, lhs_attr;
+  bool is_poly_assign;
 
   /* Assignment of the form lhs = rhs.  */
   gfc_start_block (&block);
@@ -9648,6 +9649,19 @@ 
 	  || gfc_is_alloc_class_scalar_function (expr2)))
     expr2->must_finalize = 1;
 
+  /* Checking whether a class assignment is desired is quite complicated and
+     needed at two locations, so do it once only before the information is
+     needed.  */
+  lhs_attr = gfc_expr_attr (expr1);
+  is_poly_assign = (use_vptr_copy || lhs_attr.pointer
+		    || (lhs_attr.allocatable && !lhs_attr.dimension))
+		   && (expr1->ts.type == BT_CLASS
+		       || gfc_is_class_array_ref (expr1, NULL)
+		       || gfc_is_class_scalar_expr (expr1)
+		       || gfc_is_class_array_ref (expr2, NULL)
+		       || gfc_is_class_scalar_expr (expr2));
+
+
   /* Only analyze the expressions for coarray properties, when in coarray-lib
      mode.  */
   if (flag_coarray == GFC_FCOARRAY_LIB)
@@ -9676,6 +9690,10 @@ 
       if (rss == gfc_ss_terminator)
 	/* The rhs is scalar.  Add a ss for the expression.  */
 	rss = gfc_get_scalar_ss (gfc_ss_terminator, expr2);
+      /* When doing a class assign, then the handle to the rhs needs to be a
+	 pointer to allow for polymorphism.  */
+      if (is_poly_assign && expr2->rank == 0 && !UNLIMITED_POLY (expr2))
+	rss->info->type = GFC_SS_REFERENCE;
 
       /* Associate the SS with the loop.  */
       gfc_add_ss_to_loop (&loop, lss);
@@ -9835,14 +9853,7 @@ 
 	gfc_add_block_to_block (&loop.post, &rse.post);
     }
 
-  lhs_attr = gfc_expr_attr (expr1);
-  if ((use_vptr_copy || lhs_attr.pointer
-       || (lhs_attr.allocatable && !lhs_attr.dimension))
-      && (expr1->ts.type == BT_CLASS
-	  || (gfc_is_class_array_ref (expr1, NULL)
-	      || gfc_is_class_scalar_expr (expr1))
-	  || (gfc_is_class_array_ref (expr2, NULL)
-	      || gfc_is_class_scalar_expr (expr2))))
+  if (is_poly_assign)
     {
       tmp = trans_class_assignment (&body, expr1, expr2, &lse, &rse,
 				    use_vptr_copy || (lhs_attr.allocatable
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog	(Revision 242489)
+++ gcc/testsuite/ChangeLog	(Arbeitskopie)
@@ -1,3 +1,8 @@ 
+2016-11-16  Andre Vehreschild  <vehre@gcc.gnu.org>
+
+	PR fortran/78356
+	* gfortran.dg/class_allocate_23.f08: New test.
+
 2016-11-16  Richard Biener  <rguenther@suse.de>
 
 	PR middle-end/78333
Index: gcc/testsuite/gfortran.dg/class_allocate_23.f08
===================================================================
--- gcc/testsuite/gfortran.dg/class_allocate_23.f08	(nicht existent)
+++ gcc/testsuite/gfortran.dg/class_allocate_23.f08	(Arbeitskopie)
@@ -0,0 +1,31 @@ 
+! { dg-do run }
+!
+! Test that pr78356 is fixed.
+! Contributed by Janus Weil and Andrew Benson
+
+program p
+  implicit none
+  type ac
+  end type
+  type, extends(ac) :: a
+     integer, allocatable :: b
+  end type
+  type n
+     class(ac), allocatable :: acr(:)
+  end type
+  type(n) :: s,t
+  allocate(a :: s%acr(1))
+  call nncp(s,t)
+  select type (cl => t%acr(1))
+    class is (a)
+      if (allocated(cl%b)) error stop
+    class default
+      error stop
+  end select
+contains
+  subroutine nncp(self,tg)
+    type(n) :: self, tg
+    allocate(tg%acr(1),source=self%acr(1))
+  end
+end
+