From: Paul Thomas Date: Sun, 7 Jul 2019 14:32:53 +0000 (+0000) Subject: re PR fortran/91077 (Wrong indexing when using a pointer) X-Git-Tag: releases/gcc-9.2.0~164 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=e3b4dd51006d2700aed0b91996f71e73df5fe621;p=thirdparty%2Fgcc.git re PR fortran/91077 (Wrong indexing when using a pointer) 2019-07-07 Paul Thomas PR fortran/91077 * trans-array.c (gfc_conv_scalarized_array_ref) Delete code that gave symbol backend decl for subref arrays and deferred length variables. 2019-07-07 Paul Thomas PR fortran/91077 * gfortran.dg/pointer_array_11.f90 : New test. From-SVN: r273177 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 4e5e263bda5a..13dccac7ac20 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2019-07-07 Paul Thomas + + Backport from mainline + PR fortran/91077 + * trans-array.c (gfc_conv_scalarized_array_ref) Delete code + that gave symbol backend decl for subref arrays and deferred + length variables. + 2019-06-21 Thomas Koenig Backport from trunk @@ -52,7 +60,7 @@ Backport from mainline PR fortran/69499 - * match.c (gfc_match_select_type): SELECT TYPE is an executable + * match.c (gfc_match_select_type): SELECT TYPE is an executable statement, and cannot appear in MODULE or SUBMODULE scope. 2019-06-20 Steven G. Kargl diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 8a0de6140eda..583425c516da 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -3502,19 +3502,7 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar) return; if (get_CFI_desc (NULL, expr, &decl, ar)) - { decl = build_fold_indirect_ref_loc (input_location, decl); - goto done; - } - - if (expr && ((is_subref_array (expr) - && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (info->descriptor))) - || (expr->ts.deferred && (expr->expr_type == EXPR_VARIABLE - || expr->expr_type == EXPR_FUNCTION)))) - decl = expr->symtree->n.sym->backend_decl; - - if (decl && GFC_DECL_PTR_ARRAY_P (decl)) - goto done; /* A pointer array component can be detected from its field decl. Fix the descriptor, mark the resulting variable decl and pass it to @@ -3532,7 +3520,6 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar) decl = info->descriptor; } -done: se->expr = gfc_build_array_ref (base, index, decl); } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index c128e1c70727..f6c33e929e86 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2019-07-07 Paul Thomas + + Backport from mainline + PR fortran/91077 + * gfortran.dg/pointer_array_11.f90 : New test. + 2019-07-05 Szabolcs Nagy Backport from mainline diff --git a/gcc/testsuite/gfortran.dg/pointer_array_11.f90 b/gcc/testsuite/gfortran.dg/pointer_array_11.f90 new file mode 100644 index 000000000000..11885ae4301c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pointer_array_11.f90 @@ -0,0 +1,90 @@ +! { dg-do run } +! +! Test the fix for PR91077 - both the original test and that in comment #4 of the PR. +! +! Contribute by Ygal Klein +! +program test + implicit none + call original + call comment_4 +contains + subroutine original + integer, parameter :: length = 9 + real(8), dimension(2) :: a, b + integer :: i + type point + real(8) :: x + end type point + + type stored + type(point), dimension(:), allocatable :: np + end type stored + type(stored), dimension(:), pointer :: std =>null() + allocate(std(1)) + allocate(std(1)%np(length)) + std(1)%np(1)%x = 0.3d0 + std(1)%np(2)%x = 0.3555d0 + std(1)%np(3)%x = 0.26782d0 + std(1)%np(4)%x = 0d0 + std(1)%np(5)%x = 1.555d0 + std(1)%np(6)%x = 7.3d0 + std(1)%np(7)%x = 7.8d0 + std(1)%np(8)%x = 6.3d0 + std(1)%np(9)%x = 5.5d0 +! do i = 1, 2 +! write(*, "('std(1)%np(',i1,')%x = ',1e22.14)") i, std(1)%np(i)%x +! end do +! do i = 1, 2 +! write(*, "('std(1)%np(1:',i1,') = ',9e22.14)") i, std(1)%np(1:i)%x +! end do + a = std(1)%np(1:2)%x + b = [std(1)%np(1)%x, std(1)%np(2)%x] +! print *,a +! print *,b + if (allocated (std(1)%np)) deallocate (std(1)%np) + if (associated (std)) deallocate (std) + if (norm2(a - b) .gt. 1d-3) stop 1 + end subroutine + + subroutine comment_4 + integer, parameter :: length = 2 + real(8), dimension(length) :: a, b + integer :: i + + type point + real(8) :: x + end type point + + type points + type(point), dimension(:), pointer :: np=>null() + end type points + + type stored + integer :: l + type(points), pointer :: nfpoint=>null() + end type stored + + type(stored), dimension(:), pointer :: std=>null() + + + allocate(std(1)) + allocate(std(1)%nfpoint) + allocate(std(1)%nfpoint%np(length)) + std(1)%nfpoint%np(1)%x = 0.3d0 + std(1)%nfpoint%np(2)%x = 0.3555d0 + +! do i = 1, length +! write(*, "('std(1)%nfpoint%np(',i1,')%x = ',1e22.14)") i, std(1)%nfpoint%np(i)%x +! end do +! do i = 1, length +! write(*, "('std(1)%nfpoint%np(1:',i1,')%x = ',2e22.14)") i, std(1)%nfpoint%np(1:i)%x +! end do + a = std(1)%nfpoint%np(1:2)%x + b = [std(1)%nfpoint%np(1)%x, std(1)%nfpoint%np(2)%x] + if (associated (std(1)%nfpoint%np)) deallocate (std(1)%nfpoint%np) + if (associated (std(1)%nfpoint)) deallocate (std(1)%nfpoint) + if (associated (std)) deallocate (std) + if (norm2(a - b) .gt. 1d-3) stop 2 + end subroutine +end program test