From dedf9c9915e581316900f4cbfdf1eacf04125fc3 Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Sun, 16 Jan 2011 23:54:37 +0100 Subject: [PATCH] backport: re PR fortran/46874 ([OpenMP] ICE in gfc_conv_descriptor_data_get, at fortran/trans-array.c:147) Backport from mainline 2010-12-14 Jakub Jelinek PR fortran/46874 * trans-openmp.c (gfc_trans_omp_array_reduction): Handle allocatable dummy variables. * libgomp.fortran/allocatable6.f90: New test. From-SVN: r168878 --- gcc/fortran/ChangeLog | 9 ++++ gcc/fortran/trans-openmp.c | 28 ++++++++---- libgomp/ChangeLog | 8 ++++ .../libgomp.fortran/allocatable6.f90 | 45 +++++++++++++++++++ 4 files changed, 82 insertions(+), 8 deletions(-) create mode 100644 libgomp/testsuite/libgomp.fortran/allocatable6.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 29c71a3b2dbd..cfa2b947093c 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2011-01-16 Jakub Jelinek + + Backport from mainline + 2010-12-14 Jakub Jelinek + + PR fortran/46874 + * trans-openmp.c (gfc_trans_omp_array_reduction): Handle allocatable + dummy variables. + 2010-12-09 Daniel Kraft PR fortran/46794 diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 8248e45a0d2c..d09034db7895 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -477,13 +477,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)); @@ -502,7 +512,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); @@ -619,12 +631,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); @@ -660,8 +672,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. */ @@ -681,7 +693,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; diff --git a/libgomp/ChangeLog b/libgomp/ChangeLog index e72db4764f9f..d2fe407bbb10 100644 --- a/libgomp/ChangeLog +++ b/libgomp/ChangeLog @@ -1,3 +1,11 @@ +2011-01-16 Jakub Jelinek + + Backport from mainline + 2010-12-14 Jakub Jelinek + + PR fortran/46874 + * libgomp.fortran/allocatable6.f90: New test. + 2010-12-10 Rainer Orth Backport from mainline: diff --git a/libgomp/testsuite/libgomp.fortran/allocatable6.f90 b/libgomp/testsuite/libgomp.fortran/allocatable6.f90 new file mode 100644 index 000000000000..47b67aa56d05 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/allocatable6.f90 @@ -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 -- 2.47.2