Hi Paul,
thanks for the review. Committed as:
r233099 for ggc-5, and
r233101 for trunk.
Regards,
Andre
On Tue, 2 Feb 2016 19:44:00 +0100
Paul Richard Thomas <paul.richard.tho...@gmail.com> wrote:
> Hi Andre,
>
> This one looks good too. As every day goes by, I see more and more why
> Tobias was so keen to incorporate all objects into a single descriptor
> type :-)
>
> OK for 5-branch.
>
> Thanks for both the patches
>
> Paul
>
> On 1 February 2016 at 13:34, Andre Vehreschild <ve...@gmx.de> wrote:
> > Oh, well, now with attachments. I am sorry.
> >
> > - Andre
> >
> > On Mon, 1 Feb 2016 13:20:24 +0100
> > Andre Vehreschild <ve...@gmx.de> wrote:
> >
> >> Hi all,
> >>
> >> here is the backport of the patch for pr67451 for gcc-5. Because the
> >> structure of the allocate() in trunk is quite different the patch looks
> >> somewhat different, too, but essentially does the same.
> >>
> >> Bootstrapped and regtests ok on x86_64-linux-gnu/F23.
> >>
> >> Ok for gcc-5-branch?
> >>
> >> Here is the link to the mainline patch:
> >> https://gcc.gnu.org/ml/fortran/2016-01/msg00093.html
> >>
> >> Regards,
> >> Andre
> >>
> >> On Fri, 29 Jan 2016 19:17:24 +0100
> >> Andre Vehreschild <ve...@gmx.de> wrote:
> >>
> >> > Hi all,
> >> >
> >> > attached is a patch to fix a regression in current gfortran when a
> >> > coarray is used in the source=-expression of an allocate(). The ICE was
> >> > caused by the class information, i.e., _vptr and so on, not at the
> >> > expected place. The patch fixes this.
> >> >
> >> > The patch also fixes pr69418, which I will flag as a duplicate in a
> >> > second.
> >> >
> >> > Bootstrapped and regtested ok on x86_64-linux-gnu/F23.
> >> >
> >> > Ok for trunk?
> >> >
> >> > Backport to gcc-5 is pending, albeit more difficult, because the
> >> > allocate() implementation on 5 is not as advanced the one in 6.
> >> >
> >> > Regards,
> >> > Andre
> >>
> >>
> >
> >
> > --
> > Andre Vehreschild * Email: vehre ad gmx dot de
>
>
>
--
Andre Vehreschild * Email: vehre ad gmx dot de
Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog (Revision 233098)
+++ gcc/fortran/ChangeLog (Arbeitskopie)
@@ -1,3 +1,13 @@
+2016-02-03 Andre Vehreschild <ve...@gcc.gnu.org>
+
+ PR fortran/67451
+ PR fortran/69418
+ * trans-expr.c (gfc_copy_class_to_class): For coarrays just the
+ pointer is passed. Take it as is without trying to deref the
+ _data component.
+ * trans-stmt.c (gfc_trans_allocate): Take care of coarrays as
+ argument to source=-expression.
+
2016-01-30 Bud Davis <jmda...@link.com>
Mikael Morin <mik...@gcc.gnu.org>
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c (Revision 233098)
+++ gcc/fortran/trans-expr.c (Arbeitskopie)
@@ -1019,6 +1019,7 @@
tree fcn;
tree fcn_type;
tree from_data;
+ tree from_class_base = NULL;
tree from_len;
tree to_data;
tree to_len;
@@ -1035,21 +1036,41 @@
from_len = to_len = NULL_TREE;
if (from != NULL_TREE)
- fcn = gfc_class_vtab_copy_get (from);
+ {
+ /* Check that from is a class. When the class is part of a coarray,
+ then from is a common pointer and is to be used as is. */
+ tmp = POINTER_TYPE_P (TREE_TYPE (from)) && !DECL_P (from)
+ ? TREE_OPERAND (from, 0) : from;
+ if (GFC_CLASS_TYPE_P (TREE_TYPE (tmp))
+ || (DECL_P (tmp) && GFC_DECL_CLASS (tmp)))
+ {
+ from_class_base = from;
+ from_data = gfc_class_data_get (from_class_base);
+ }
+ else
+ {
+ /* For arrays two component_refs can be present. */
+ if (TREE_CODE (tmp) == COMPONENT_REF)
+ tmp = TREE_OPERAND (tmp, 0);
+ if (TREE_CODE (tmp) == COMPONENT_REF)
+ tmp = TREE_OPERAND (tmp, 0);
+ from_class_base = tmp;
+ from_data = from;
+ }
+ fcn = gfc_class_vtab_copy_get (from_class_base);
+ }
else
- fcn = gfc_class_vtab_copy_get (to);
+ {
+ fcn = gfc_class_vtab_copy_get (to);
+ from_data = gfc_class_vtab_def_init_get (to);
+ }
fcn_type = TREE_TYPE (TREE_TYPE (fcn));
- if (from != NULL_TREE)
- from_data = gfc_class_data_get (from);
- else
- from_data = gfc_class_vtab_def_init_get (to);
-
if (unlimited)
{
- if (from != NULL_TREE && unlimited)
- from_len = gfc_class_len_get (from);
+ if (from_class_base != NULL_TREE)
+ from_len = gfc_class_len_get (from_class_base);
else
from_len = integer_zero_node;
}
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c (Revision 233098)
+++ gcc/fortran/trans-stmt.c (Arbeitskopie)
@@ -5180,7 +5180,7 @@
_vptr, _len and element_size for expr3. */
if (code->expr3)
{
- bool vtab_needed = false;
+ bool vtab_needed = false, is_coarray = gfc_is_coarray (code->expr3);
/* expr3_tmp gets the tree when code->expr3.mold is set, i.e.,
the expression is only needed to get the _vptr, _len a.s.o. */
tree expr3_tmp = NULL_TREE;
@@ -5245,7 +5245,8 @@
{
tree var;
- tmp = build_fold_indirect_ref_loc (input_location,
+ tmp = is_coarray ? se.expr
+ : build_fold_indirect_ref_loc (input_location,
se.expr);
/* We need a regular (non-UID) symbol here, therefore give a
@@ -5297,6 +5298,16 @@
else if (expr3_tmp != NULL_TREE
&& (VAR_P (expr3_tmp) ||!code->expr3->ref))
tmp = gfc_class_vptr_get (expr3_tmp);
+ else if (is_coarray && expr3 != NULL_TREE)
+ {
+ /* Get the ref to coarray's data. May be wrapped in a
+ NOP_EXPR. */
+ tmp = POINTER_TYPE_P (TREE_TYPE (expr3)) ? TREE_OPERAND (expr3, 0)
+ : tmp;
+ /* Get to the base variable, i.e., strip _data.data. */
+ tmp = TREE_OPERAND (TREE_OPERAND (tmp, 0), 0);
+ tmp = gfc_class_vptr_get (tmp);
+ }
else
{
rhs = gfc_find_and_cut_at_last_class_ref (code->expr3);
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog (Revision 233098)
+++ gcc/testsuite/ChangeLog (Arbeitskopie)
@@ -1,3 +1,11 @@
+2016-02-03 Andre Vehreschild <ve...@gcc.gnu.org>
+
+ PR fortran/67451
+ PR fortran/69418
+ * gfortran.dg/coarray_allocate_2.f08: New test.
+ * gfortran.dg/coarray_allocate_3.f08: New test.
+ * gfortran.dg/coarray_allocate_4.f08: New test.
+
2016-02-02 Alan Modra <amo...@gmail.com>
PR target/69548
Index: gcc/testsuite/gfortran.dg/coarray_allocate_2.f08
===================================================================
--- gcc/testsuite/gfortran.dg/coarray_allocate_2.f08 (nicht existent)
+++ gcc/testsuite/gfortran.dg/coarray_allocate_2.f08 (Arbeitskopie)
@@ -0,0 +1,26 @@
+! { dg-do run }
+! { dg-options "-fcoarray=single" }
+!
+! Contributed by Ian Harvey <ian_har...@bigpond.com>
+! Extended by Andre Vehreschild <ve...@gcc.gnu.org>
+! to test that coarray references in allocate work now
+! PR fortran/67451
+
+ program main
+ implicit none
+ type foo
+ integer :: bar = 99
+ end type
+ class(foo), allocatable :: foobar[:]
+ class(foo), allocatable :: some_local_object
+ allocate(foobar[*])
+
+ allocate(some_local_object, source=foobar)
+
+ if (.not. allocated(foobar)) call abort()
+ if (.not. allocated(some_local_object)) call abort()
+
+ deallocate(some_local_object)
+ deallocate(foobar)
+ end program
+
Index: gcc/testsuite/gfortran.dg/coarray_allocate_3.f08
===================================================================
--- gcc/testsuite/gfortran.dg/coarray_allocate_3.f08 (nicht existent)
+++ gcc/testsuite/gfortran.dg/coarray_allocate_3.f08 (Arbeitskopie)
@@ -0,0 +1,28 @@
+! { dg-do run }
+! { dg-options "-fcoarray=single" }
+!
+! Contributed by Ian Harvey <ian_har...@bigpond.com>
+! Extended by Andre Vehreschild <ve...@gcc.gnu.org>
+! to test that coarray references in allocate work now
+! PR fortran/67451
+
+ program main
+ implicit none
+ type foo
+ integer :: bar = 99
+ end type
+ class(foo), dimension(:), allocatable :: foobar[:]
+ class(foo), dimension(:), allocatable :: some_local_object
+ allocate(foobar(10)[*])
+
+ allocate(some_local_object(10), source=foobar)
+
+ if (.not. allocated(foobar)) call abort()
+ if (lbound(foobar, 1) /= 1 .OR. ubound(foobar, 1) /= 10) call abort()
+ if (.not. allocated(some_local_object)) call abort()
+ if (any(some_local_object(:)%bar /= [99, 99, 99, 99, 99, 99, 99, 99, 99, 99])) call abort()
+
+ deallocate(some_local_object)
+ deallocate(foobar)
+ end program
+
Index: gcc/testsuite/gfortran.dg/coarray_allocate_4.f08
===================================================================
--- gcc/testsuite/gfortran.dg/coarray_allocate_4.f08 (nicht existent)
+++ gcc/testsuite/gfortran.dg/coarray_allocate_4.f08 (Arbeitskopie)
@@ -0,0 +1,43 @@
+! { dg-do run }
+! { dg-options "-fcoarray=single" }
+!
+! Contributed by Gerhard Steinmetz <gerhard.steinmetz.fort...@t-online.de>
+! Andre Vehreschild <ve...@gcc.gnu.org>
+! Check that PR fortran/69451 is fixed.
+
+program main
+
+implicit none
+
+type foo
+end type
+
+class(foo), allocatable :: p[:]
+class(foo), pointer :: r
+class(*), allocatable, target :: z
+
+allocate(p[*])
+
+call s(p, z)
+select type (z)
+ class is (foo)
+ r => z
+ class default
+ call abort()
+end select
+
+if (.not. associated(r)) call abort()
+
+deallocate(r)
+deallocate(p)
+
+contains
+
+subroutine s(x, z)
+ class(*) :: x[*]
+ class(*), allocatable:: z
+ allocate (z, source=x)
+end
+
+end
+
Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog (Revision 233100)
+++ gcc/fortran/ChangeLog (Arbeitskopie)
@@ -1,3 +1,13 @@
+2016-02-03 Andre Vehreschild <ve...@gcc.gnu.org>
+
+ PR fortran/67451
+ PR fortran/69418
+ * trans-expr.c (gfc_copy_class_to_class): For coarrays just the
+ pointer is passed. Take it as is without trying to deref the
+ _data component.
+ * trans-stmt.c (gfc_trans_allocate): Take care of coarrays as
+ argument to source=-expression.
+
2016-02-02 Nathan Sidwell <nat...@codesourcery.com>
* lang.opt (fopenacc-dim=): New option.
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c (Revision 233100)
+++ gcc/fortran/trans-expr.c (Arbeitskopie)
@@ -1103,7 +1103,14 @@
}
else
{
- from_data = gfc_class_data_get (from);
+ /* Check that from is a class. When the class is part of a coarray,
+ then from is a common pointer and is to be used as is. */
+ tmp = POINTER_TYPE_P (TREE_TYPE (from))
+ ? build_fold_indirect_ref (from) : from;
+ from_data =
+ (GFC_CLASS_TYPE_P (TREE_TYPE (tmp))
+ || (DECL_P (tmp) && GFC_DECL_CLASS (tmp)))
+ ? gfc_class_data_get (from) : from;
is_from_desc = GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (from_data));
}
}
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c (Revision 233100)
+++ gcc/fortran/trans-stmt.c (Arbeitskopie)
@@ -5358,7 +5358,8 @@
expression. */
if (code->expr3)
{
- bool vtab_needed = false, temp_var_needed = false;
+ bool vtab_needed = false, temp_var_needed = false,
+ is_coarray = gfc_is_coarray (code->expr3);
/* Figure whether we need the vtab from expr3. */
for (al = code->ext.alloc.list; !vtab_needed && al != NULL;
@@ -5392,9 +5393,9 @@
with the POINTER_PLUS_EXPR in this case. */
if (code->expr3->ts.type == BT_CLASS
&& TREE_CODE (se.expr) == NOP_EXPR
- && TREE_CODE (TREE_OPERAND (se.expr, 0))
- == POINTER_PLUS_EXPR)
- //&& ! GFC_CLASS_TYPE_P (TREE_TYPE (se.expr)))
+ && (TREE_CODE (TREE_OPERAND (se.expr, 0))
+ == POINTER_PLUS_EXPR
+ || is_coarray))
se.expr = TREE_OPERAND (se.expr, 0);
}
/* Create a temp variable only for component refs to prevent
@@ -5435,7 +5436,7 @@
if (se.expr != NULL_TREE && temp_var_needed)
{
tree var, desc;
- tmp = GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr)) ?
+ tmp = GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr)) || is_coarray ?
se.expr
: build_fold_indirect_ref_loc (input_location, se.expr);
@@ -5448,7 +5449,7 @@
{
/* When an array_ref was in expr3, then the descriptor is the
first operand. */
- if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
+ if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)) || is_coarray)
{
desc = TREE_OPERAND (tmp, 0);
}
@@ -5460,11 +5461,12 @@
e3_is = E3_DESC;
}
else
- desc = se.expr;
+ desc = !is_coarray ? se.expr
+ : TREE_OPERAND (TREE_OPERAND (se.expr, 0), 0);
/* We need a regular (non-UID) symbol here, therefore give a
prefix. */
var = gfc_create_var (TREE_TYPE (tmp), "source");
- if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
+ if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)) || is_coarray)
{
gfc_allocate_lang_decl (var);
GFC_DECL_SAVED_DESCRIPTOR (var) = desc;
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog (Revision 233100)
+++ gcc/testsuite/ChangeLog (Arbeitskopie)
@@ -1,3 +1,11 @@
+2016-02-03 Andre Vehreschild <ve...@gcc.gnu.org>
+
+ PR fortran/67451
+ PR fortran/69418
+ * gfortran.dg/coarray_allocate_2.f08: New test.
+ * gfortran.dg/coarray_allocate_3.f08: New test.
+ * gfortran.dg/coarray_allocate_4.f08: New test.
+
2016-02-03 Alan Lawrence <alan.lawre...@arm.com>
* gcc.dg/vect/vect-outer-1-big-array.c: Drop vect_multiple_sizes;
Index: gcc/testsuite/gfortran.dg/coarray_allocate_2.f08
===================================================================
--- gcc/testsuite/gfortran.dg/coarray_allocate_2.f08 (nicht existent)
+++ gcc/testsuite/gfortran.dg/coarray_allocate_2.f08 (Arbeitskopie)
@@ -0,0 +1,26 @@
+! { dg-do run }
+! { dg-options "-fcoarray=single" }
+!
+! Contributed by Ian Harvey <ian_har...@bigpond.com>
+! Extended by Andre Vehreschild <ve...@gcc.gnu.org>
+! to test that coarray references in allocate work now
+! PR fortran/67451
+
+ program main
+ implicit none
+ type foo
+ integer :: bar = 99
+ end type
+ class(foo), allocatable :: foobar[:]
+ class(foo), allocatable :: some_local_object
+ allocate(foobar[*])
+
+ allocate(some_local_object, source=foobar)
+
+ if (.not. allocated(foobar)) call abort()
+ if (.not. allocated(some_local_object)) call abort()
+
+ deallocate(some_local_object)
+ deallocate(foobar)
+ end program
+
Index: gcc/testsuite/gfortran.dg/coarray_allocate_3.f08
===================================================================
--- gcc/testsuite/gfortran.dg/coarray_allocate_3.f08 (nicht existent)
+++ gcc/testsuite/gfortran.dg/coarray_allocate_3.f08 (Arbeitskopie)
@@ -0,0 +1,28 @@
+! { dg-do run }
+! { dg-options "-fcoarray=single" }
+!
+! Contributed by Ian Harvey <ian_har...@bigpond.com>
+! Extended by Andre Vehreschild <ve...@gcc.gnu.org>
+! to test that coarray references in allocate work now
+! PR fortran/67451
+
+ program main
+ implicit none
+ type foo
+ integer :: bar = 99
+ end type
+ class(foo), dimension(:), allocatable :: foobar[:]
+ class(foo), dimension(:), allocatable :: some_local_object
+ allocate(foobar(10)[*])
+
+ allocate(some_local_object, source=foobar)
+
+ if (.not. allocated(foobar)) call abort()
+ if (lbound(foobar, 1) /= 1 .OR. ubound(foobar, 1) /= 10) call abort()
+ if (.not. allocated(some_local_object)) call abort()
+ if (any(some_local_object(:)%bar /= [99, 99, 99, 99, 99, 99, 99, 99, 99, 99])) call abort()
+
+ deallocate(some_local_object)
+ deallocate(foobar)
+ end program
+
Index: gcc/testsuite/gfortran.dg/coarray_allocate_4.f08
===================================================================
--- gcc/testsuite/gfortran.dg/coarray_allocate_4.f08 (nicht existent)
+++ gcc/testsuite/gfortran.dg/coarray_allocate_4.f08 (Arbeitskopie)
@@ -0,0 +1,43 @@
+! { dg-do run }
+! { dg-options "-fcoarray=single" }
+!
+! Contributed by Gerhard Steinmetz <gerhard.steinmetz.fort...@t-online.de>
+! Andre Vehreschild <ve...@gcc.gnu.org>
+! Check that PR fortran/69451 is fixed.
+
+program main
+
+implicit none
+
+type foo
+end type
+
+class(foo), allocatable :: p[:]
+class(foo), pointer :: r
+class(*), allocatable, target :: z
+
+allocate(p[*])
+
+call s(p, z)
+select type (z)
+ class is (foo)
+ r => z
+ class default
+ call abort()
+end select
+
+if (.not. associated(r)) call abort()
+
+deallocate(r)
+deallocate(p)
+
+contains
+
+subroutine s(x, z)
+ class(*) :: x[*]
+ class(*), allocatable:: z
+ allocate (z, source=x)
+end
+
+end
+
