re PR fortran/46874 ([OpenMP] ICE in gfc_conv_descriptor_data_get, at fortran/trans-array.c:147)

PR fortran/46874
	* trans-openmp.c (gfc_trans_omp_array_reduction): Handle allocatable
	dummy variables.

	* libgomp.fortran/allocatable6.f90: New test.

From-SVN: r167798
This commit is contained in:
Jakub Jelinek 2010-12-14 14:56:25 +01:00 committed by Jakub Jelinek
parent ae9fd6b7cd
commit af3fcdb4ac
4 changed files with 76 additions and 8 deletions

View File

@ -1,3 +1,9 @@
2010-12-14 Jakub Jelinek <jakub@redhat.com>
PR fortran/46874
* trans-openmp.c (gfc_trans_omp_array_reduction): Handle allocatable
dummy variables.
2010-12-13 Janus Weil <janus@gcc.gnu.org>
PR fortran/46201

View File

@ -482,13 +482,23 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where)
gfc_symbol init_val_sym, outer_sym, intrinsic_sym;
gfc_expr *e1, *e2, *e3, *e4;
gfc_ref *ref;
tree decl, backend_decl, stmt;
tree decl, backend_decl, stmt, type, outer_decl;
locus old_loc = gfc_current_locus;
const char *iname;
gfc_try t;
decl = OMP_CLAUSE_DECL (c);
gfc_current_locus = where;
type = TREE_TYPE (decl);
outer_decl = create_tmp_var_raw (type, NULL);
if (TREE_CODE (decl) == PARM_DECL
&& TREE_CODE (type) == REFERENCE_TYPE
&& GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (type))
&& GFC_TYPE_ARRAY_AKIND (TREE_TYPE (type)) == GFC_ARRAY_ALLOCATABLE)
{
decl = build_fold_indirect_ref (decl);
type = TREE_TYPE (type);
}
/* Create a fake symbol for init value. */
memset (&init_val_sym, 0, sizeof (init_val_sym));
@ -507,7 +517,9 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where)
outer_sym.attr.dummy = 0;
outer_sym.attr.result = 0;
outer_sym.attr.flavor = FL_VARIABLE;
outer_sym.backend_decl = create_tmp_var_raw (TREE_TYPE (decl), NULL);
outer_sym.backend_decl = outer_decl;
if (decl != OMP_CLAUSE_DECL (c))
outer_sym.backend_decl = build_fold_indirect_ref (outer_decl);
/* Create fake symtrees for it. */
symtree1 = gfc_new_symtree (&root1, sym->name);
@ -624,12 +636,12 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where)
/* Create the init statement list. */
pushlevel (0);
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))
&& GFC_TYPE_ARRAY_AKIND (TREE_TYPE (decl)) == GFC_ARRAY_ALLOCATABLE)
if (GFC_DESCRIPTOR_TYPE_P (type)
&& GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE)
{
/* If decl is an allocatable array, it needs to be allocated
with the same bounds as the outer var. */
tree type = TREE_TYPE (decl), rank, size, esize, ptr;
tree rank, size, esize, ptr;
stmtblock_t block;
gfc_start_block (&block);
@ -669,8 +681,8 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where)
/* Create the merge statement list. */
pushlevel (0);
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))
&& GFC_TYPE_ARRAY_AKIND (TREE_TYPE (decl)) == GFC_ARRAY_ALLOCATABLE)
if (GFC_DESCRIPTOR_TYPE_P (type)
&& GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE)
{
/* If decl is an allocatable array, it needs to be deallocated
afterwards. */
@ -691,7 +703,7 @@ gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where)
OMP_CLAUSE_REDUCTION_MERGE (c) = stmt;
/* And stick the placeholder VAR_DECL into the clause as well. */
OMP_CLAUSE_REDUCTION_PLACEHOLDER (c) = outer_sym.backend_decl;
OMP_CLAUSE_REDUCTION_PLACEHOLDER (c) = outer_decl;
gfc_current_locus = old_loc;

View File

@ -1,3 +1,8 @@
2010-12-14 Jakub Jelinek <jakub@redhat.com>
PR fortran/46874
* libgomp.fortran/allocatable6.f90: New test.
2010-12-14 Alexander Monakov <amonakov@ispras.ru>
PR rtl-optimization/46875

View File

@ -0,0 +1,45 @@
! PR fortran/46874
! { dg-do run }
interface
subroutine sub (a, b, c, d, n)
integer :: n
integer, allocatable :: a(:), b(:), c(:), d(:)
end subroutine
end interface
integer, allocatable :: a(:), b(:), c(:), d(:)
integer :: i, j
allocate (a(50), b(50), c(50), d(50))
do i = 1, 50
a(i) = 2 + modulo (i, 7)
b(i) = 179 - modulo (i, 11)
end do
c = 0
d = 2147483647
call sub (a, b, c, d, 50)
do i = 1, 50
j = 0
if (i .eq. 3) then
j = 8
else if (i .gt. 1 .and. i .lt. 9) then
j = 7
end if
if (c(i) .ne. j) call abort
j = 179 - modulo (i, 11)
if (i .gt. 1 .and. i .lt. 9) j = i
if (d(i) .ne. j) call abort
end do
deallocate (a, b, c, d)
end
subroutine sub (a, b, c, d, n)
integer :: n
integer, allocatable :: a(:), b(:), c(:), d(:)
!$omp parallel do shared(a, b) reduction(+:c) reduction(min:d)
do i = 1, n
c(a(i)) = c(a(i)) + 1
d(i) = min(d(i), b(i))
d(a(i)) = min(d(a(i)), a(i))
end do
end