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 <jakub@redhat.com> PR fortran/46874 * trans-openmp.c (gfc_trans_omp_array_reduction): Handle allocatable dummy variables. * libgomp.fortran/allocatable6.f90: New test. From-SVN: r168878
This commit is contained in:
Jakub Jelinek
Jakub Jelinek
parent
ad461982d7
commit
dedf9c9915
|
|
@ -1,3 +1,12 @@
|
|||
2011-01-16 Jakub Jelinek <jakub@redhat.com>
|
||||
|
||||
Backport from mainline
|
||||
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-09 Daniel Kraft <d@domob.eu>
|
||||
|
||||
PR fortran/46794
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,3 +1,11 @@
|
|||
2011-01-16 Jakub Jelinek <jakub@redhat.com>
|
||||
|
||||
Backport from mainline
|
||||
2010-12-14 Jakub Jelinek <jakub@redhat.com>
|
||||
|
||||
PR fortran/46874
|
||||
* libgomp.fortran/allocatable6.f90: New test.
|
||||
|
||||
2010-12-10 Rainer Orth <ro@CeBiTec.Uni-Bielefeld.DE>
|
||||
|
||||
Backport from mainline:
|
||||
|
|
|
|||
|
|
@ -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
|
||||
Loading…
Reference in New Issue