Hi Janus,
thanks for the quick review. Committed as r242490.
Regards,
Andre
On Tue, 15 Nov 2016 22:24:43 +0100
Janus Weil <ja...@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
--
Andre Vehreschild * Email: vehre ad gmx dot de
Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog (Revision 242489)
+++ gcc/fortran/ChangeLog (Arbeitskopie)
@@ -1,3 +1,11 @@
+2016-11-16 Andre Vehreschild <ve...@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 <tkoe...@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 <ve...@gcc.gnu.org>
+
+ PR fortran/78356
+ * gfortran.dg/class_allocate_23.f08: New test.
+
2016-11-16 Richard Biener <rguent...@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
+
