diff mbox

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

Message ID 20161115172658.5608e616@vepi2
State Superseded
Headers show

Commit Message

Andre Vehreschild Nov. 15, 2016, 4:26 p.m. UTC 
Hi all,

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?

Regards,
	Andre
-- 
Andre Vehreschild * Email: vehre ad gmx dot de
gcc/fortran/ChangeLog:

2016-11-15  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.

gcc/testsuite/ChangeLog:

2016-11-15  Andre Vehreschild  <vehre@gcc.gnu.org>

	PR fortran/78356
	* gfortran.dg/class_allocate_23.f08: New test.

Comments

Janus Weil Nov. 15, 2016, 9:24 p.m. UTC | #1 
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

diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index b42ec40..9db86b4 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -378,7 +378,8 @@  gfc_is_class_scalar_expr (gfc_expr *e)
 	&& 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 @@  gfc_is_class_scalar_expr (gfc_expr *e)
 	    && 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;
     }
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 48296b8..1331b07 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -9628,6 +9628,7 @@  gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
   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_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
 	  || 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 @@  gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
       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_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
 	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
diff --git a/gcc/testsuite/gfortran.dg/class_allocate_23.f08 b/gcc/testsuite/gfortran.dg/class_allocate_23.f08
new file mode 100644
index 0000000..5c83fbe
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_allocate_23.f08
@@ -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
+