OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/67451 ([F08] ICE with sourced allocation from coarray.)

Browse Source 
gcc/testsuite/ChangeLog:

2016-02-03  Andre Vehreschild  <vehre@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.


gcc/fortran/ChangeLog:

2016-02-03  Andre Vehreschild  <vehre@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.

From-SVN: r233101
This commit is contained in:
Andre Vehreschild 2016-02-03 11:39:09 +01:00
parent d8208e6d4c
commit 781d83d96d
7 changed files with 133 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
gcc/fortran/ChangeLog
View File

@ -1,3 +1,13 @@
2016-02-03 Andre Vehreschild <vehre@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 <nathan@codesourcery.com>
* lang.opt (fopenacc-dim=): New option.

9
gcc/fortran/trans-expr.c
View File

@ -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));
}
}

18
gcc/fortran/trans-stmt.c
View File

@ -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;

8
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,11 @@
2016-02-03 Andre Vehreschild <vehre@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.lawrence@arm.com>
* gcc.dg/vect/vect-outer-1-big-array.c: Drop vect_multiple_sizes;

26
gcc/testsuite/gfortran.dg/coarray_allocate_2.f08 Normal file
View File

@ -0,0 +1,26 @@
! { dg-do run }
! { dg-options "-fcoarray=single" }
!
! Contributed by Ian Harvey <ian_harvey@bigpond.com>
! Extended by Andre Vehreschild <vehre@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

28
gcc/testsuite/gfortran.dg/coarray_allocate_3.f08 Normal file
View File

@ -0,0 +1,28 @@
! { dg-do run }
! { dg-options "-fcoarray=single" }
!
! Contributed by Ian Harvey <ian_harvey@bigpond.com>
! Extended by Andre Vehreschild <vehre@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

43
gcc/testsuite/gfortran.dg/coarray_allocate_4.f08 Normal file
View File

@ -0,0 +1,43 @@
! { dg-do run }
! { dg-options "-fcoarray=single" }
!
! Contributed by Gerhard Steinmetz <gerhard.steinmetz.fortran@t-online.de>
! Andre Vehreschild <vehre@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