re PR fortran/63861 (OpenACC coarray ICE (also with OpenMP?))
2015-01-27 Tobias Burnus <burnus@net-b.de> PR fortran/63861 gcc/fortran/ * trans-openmp.c (gfc_has_alloc_comps, gfc_trans_omp_clauses): Fix handling for scalar coarrays. * trans-types.c (gfc_get_element_type): Add comment. gcc/testsuite/ * gfortran.dg/goacc/coarray_2.f90: New. From-SVN: r220189
This commit is contained in:
parent
e23f28927f
commit
710700abb8
|
@ -1,3 +1,10 @@
|
|||
2015-01-27 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
PR fortran/63861
|
||||
* trans-openmp.c (gfc_has_alloc_comps, gfc_trans_omp_clauses):
|
||||
Fix handling for scalar coarrays.
|
||||
* trans-types.c (gfc_get_element_type): Add comment.
|
||||
|
||||
2015-01-27 Rainer Orth <ro@CeBiTec.Uni-Bielefeld.DE>
|
||||
|
||||
PR fortran/64771
|
||||
|
|
|
@ -189,7 +189,7 @@ gfc_has_alloc_comps (tree type, tree decl)
|
|||
return false;
|
||||
}
|
||||
|
||||
while (GFC_DESCRIPTOR_TYPE_P (type) || GFC_ARRAY_TYPE_P (type))
|
||||
if (GFC_DESCRIPTOR_TYPE_P (type) || GFC_ARRAY_TYPE_P (type))
|
||||
type = gfc_get_element_type (type);
|
||||
|
||||
if (TREE_CODE (type) != RECORD_TYPE)
|
||||
|
@ -1989,7 +1989,10 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
|
|||
OMP_CLAUSE_DECL (node3)
|
||||
= gfc_conv_descriptor_data_get (decl);
|
||||
OMP_CLAUSE_SIZE (node3) = size_int (0);
|
||||
if (n->sym->attr.pointer)
|
||||
|
||||
/* We have to check for n->sym->attr.dimension because
|
||||
of scalar coarrays. */
|
||||
if (n->sym->attr.pointer && n->sym->attr.dimension)
|
||||
{
|
||||
stmtblock_t cond_block;
|
||||
tree size
|
||||
|
@ -2019,16 +2022,19 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
|
|||
else_b));
|
||||
OMP_CLAUSE_SIZE (node) = size;
|
||||
}
|
||||
else
|
||||
else if (n->sym->attr.dimension)
|
||||
OMP_CLAUSE_SIZE (node)
|
||||
= gfc_full_array_size (block, decl,
|
||||
GFC_TYPE_ARRAY_RANK (type));
|
||||
tree elemsz
|
||||
= TYPE_SIZE_UNIT (gfc_get_element_type (type));
|
||||
elemsz = fold_convert (gfc_array_index_type, elemsz);
|
||||
OMP_CLAUSE_SIZE (node)
|
||||
= fold_build2 (MULT_EXPR, gfc_array_index_type,
|
||||
OMP_CLAUSE_SIZE (node), elemsz);
|
||||
if (n->sym->attr.dimension)
|
||||
{
|
||||
tree elemsz
|
||||
= TYPE_SIZE_UNIT (gfc_get_element_type (type));
|
||||
elemsz = fold_convert (gfc_array_index_type, elemsz);
|
||||
OMP_CLAUSE_SIZE (node)
|
||||
= fold_build2 (MULT_EXPR, gfc_array_index_type,
|
||||
OMP_CLAUSE_SIZE (node), elemsz);
|
||||
}
|
||||
}
|
||||
else
|
||||
OMP_CLAUSE_DECL (node) = decl;
|
||||
|
|
|
@ -1172,6 +1172,10 @@ gfc_conv_array_bound (gfc_expr * expr)
|
|||
return NULL_TREE;
|
||||
}
|
||||
|
||||
/* Return the type of an element of the array. Note that scalar coarrays
|
||||
are special. In particular, for GFC_ARRAY_TYPE_P, the original argument
|
||||
(with POINTER_TYPE stripped) is returned. */
|
||||
|
||||
tree
|
||||
gfc_get_element_type (tree type)
|
||||
{
|
||||
|
|
|
@ -1,3 +1,8 @@
|
|||
2015-01-27 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
PR fortran/63861
|
||||
* gfortran.dg/goacc/coarray_2.f90: New.
|
||||
|
||||
2015-01-27 Jan Hubicka <hubicka@ucw.cz>
|
||||
|
||||
PR ipa/60871
|
||||
|
|
|
@ -0,0 +1,108 @@
|
|||
! { dg-do compile }
|
||||
! { dg-additional-options "-fcoarray=lib" }
|
||||
!
|
||||
! PR fortran/63861
|
||||
|
||||
module test
|
||||
contains
|
||||
subroutine oacc1(a)
|
||||
implicit none
|
||||
integer :: i
|
||||
integer, codimension[*] :: a
|
||||
!$acc declare device_resident (a)
|
||||
!$acc data copy (a)
|
||||
!$acc end data
|
||||
!$acc data deviceptr (a)
|
||||
!$acc end data
|
||||
!$acc parallel private (a)
|
||||
!$acc end parallel
|
||||
!$acc host_data use_device (a)
|
||||
!$acc end host_data
|
||||
!$acc parallel loop reduction(+:a)
|
||||
do i = 1,5
|
||||
enddo
|
||||
!$acc end parallel loop
|
||||
!$acc parallel loop
|
||||
do i = 1,5
|
||||
enddo
|
||||
!$acc end parallel loop
|
||||
!$acc update device (a)
|
||||
!$acc update host (a)
|
||||
!$acc update self (a)
|
||||
end subroutine oacc1
|
||||
|
||||
subroutine oacc2(a)
|
||||
implicit none
|
||||
integer :: i
|
||||
integer, allocatable, codimension[:] :: a
|
||||
!$acc declare device_resident (a)
|
||||
!$acc data copy (a)
|
||||
!$acc end data
|
||||
!$acc parallel private (a)
|
||||
!$acc end parallel
|
||||
! FIXME:
|
||||
! !$acc parallel loop reduction(+:a)
|
||||
! This involves an assignment, which shall not reallocate
|
||||
! the LHS variable. Version without reduction:
|
||||
!$acc parallel loop
|
||||
do i = 1,5
|
||||
enddo
|
||||
!$acc end parallel loop
|
||||
!$acc parallel loop
|
||||
do i = 1,5
|
||||
enddo
|
||||
!$acc end parallel loop
|
||||
!$acc update device (a)
|
||||
!$acc update host (a)
|
||||
!$acc update self (a)
|
||||
end subroutine oacc2
|
||||
|
||||
subroutine oacc3(a)
|
||||
implicit none
|
||||
integer :: i
|
||||
integer, codimension[*] :: a(:)
|
||||
!$acc declare device_resident (a)
|
||||
!$acc data copy (a)
|
||||
!$acc end data
|
||||
!$acc data deviceptr (a)
|
||||
!$acc end data
|
||||
!$acc parallel private (a)
|
||||
!$acc end parallel
|
||||
!$acc host_data use_device (a)
|
||||
!$acc end host_data
|
||||
!$acc parallel loop reduction(+:a)
|
||||
do i = 1,5
|
||||
enddo
|
||||
!$acc end parallel loop
|
||||
!$acc parallel loop
|
||||
do i = 1,5
|
||||
enddo
|
||||
!$acc end parallel loop
|
||||
!$acc update device (a)
|
||||
!$acc update host (a)
|
||||
!$acc update self (a)
|
||||
end subroutine oacc3
|
||||
|
||||
subroutine oacc4(a)
|
||||
implicit none
|
||||
integer :: i
|
||||
integer, allocatable, codimension[:] :: a(:)
|
||||
!$acc declare device_resident (a)
|
||||
!$acc data copy (a)
|
||||
!$acc end data
|
||||
!$acc parallel private (a)
|
||||
!$acc end parallel
|
||||
!$acc parallel loop reduction(+:a)
|
||||
do i = 1,5
|
||||
enddo
|
||||
!$acc end parallel loop
|
||||
!$acc parallel loop
|
||||
do i = 1,5
|
||||
enddo
|
||||
!$acc end parallel loop
|
||||
!$acc update device (a)
|
||||
!$acc update host (a)
|
||||
!$acc update self (a)
|
||||
end subroutine oacc4
|
||||
end module test
|
||||
! { dg-excess-errors "sorry, unimplemented: directive not yet implemented" }
|
Loading…
Reference in New Issue