From 781d83d96d15ee03d845d6f2894d1d76ee24e79a Mon Sep 17 00:00:00 2001 From: Andre Vehreschild Date: Wed, 3 Feb 2016 11:39:09 +0100 Subject: [PATCH] re PR fortran/67451 ([F08] ICE with sourced allocation from coarray.) gcc/testsuite/ChangeLog: 2016-02-03 Andre Vehreschild 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. gcc/fortran/ChangeLog: 2016-02-03 Andre Vehreschild 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. From-SVN: r233101 --- gcc/fortran/ChangeLog | 10 ++++++ gcc/fortran/trans-expr.c | 9 ++++- gcc/fortran/trans-stmt.c | 18 +++++----- gcc/testsuite/ChangeLog | 8 +++++ gcc/testsuite/gfortran.dg/coarray_allocate_2.f08 | 26 ++++++++++++++ gcc/testsuite/gfortran.dg/coarray_allocate_3.f08 | 28 +++++++++++++++ gcc/testsuite/gfortran.dg/coarray_allocate_4.f08 | 43 ++++++++++++++++++++++++ 7 files changed, 133 insertions(+), 9 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/coarray_allocate_2.f08 create mode 100644 gcc/testsuite/gfortran.dg/coarray_allocate_3.f08 create mode 100644 gcc/testsuite/gfortran.dg/coarray_allocate_4.f08 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 36b4ddb..dc0b8f2 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2016-02-03 Andre Vehreschild + + 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 * lang.opt (fopenacc-dim=): New option. diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 08b20e6..87af7ac 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -1103,7 +1103,14 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited) } 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)); } } diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 310d2cd..5143c31 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -5358,7 +5358,8 @@ gfc_trans_allocate (gfc_code * code) 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 @@ gfc_trans_allocate (gfc_code * code) 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 @@ gfc_trans_allocate (gfc_code * code) 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 @@ gfc_trans_allocate (gfc_code * code) { /* 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 @@ gfc_trans_allocate (gfc_code * code) 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; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 28a5a85..03376d5 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2016-02-03 Andre Vehreschild + + 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 * gcc.dg/vect/vect-outer-1-big-array.c: Drop vect_multiple_sizes; diff --git a/gcc/testsuite/gfortran.dg/coarray_allocate_2.f08 b/gcc/testsuite/gfortran.dg/coarray_allocate_2.f08 new file mode 100644 index 0000000..7a712a9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_allocate_2.f08 @@ -0,0 +1,26 @@ +! { dg-do run } +! { dg-options "-fcoarray=single" } +! +! Contributed by Ian Harvey +! Extended by Andre Vehreschild +! 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 + diff --git a/gcc/testsuite/gfortran.dg/coarray_allocate_3.f08 b/gcc/testsuite/gfortran.dg/coarray_allocate_3.f08 new file mode 100644 index 0000000..46f34c0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_allocate_3.f08 @@ -0,0 +1,28 @@ +! { dg-do run } +! { dg-options "-fcoarray=single" } +! +! Contributed by Ian Harvey +! Extended by Andre Vehreschild +! 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 + diff --git a/gcc/testsuite/gfortran.dg/coarray_allocate_4.f08 b/gcc/testsuite/gfortran.dg/coarray_allocate_4.f08 new file mode 100644 index 0000000..a36d796 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_allocate_4.f08 @@ -0,0 +1,43 @@ +! { dg-do run } +! { dg-options "-fcoarray=single" } +! +! Contributed by Gerhard Steinmetz +! Andre Vehreschild +! 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 + -- 2.7.4