From 94f3d11cfaa27dbac96f5edd48839b884a5c1ef5 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sun, 7 Jul 2019 10:53:37 +0000 Subject: [PATCH] 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: r273176 --- gcc/fortran/ChangeLog | 11 ++- gcc/fortran/trans-array.c | 17 +--- gcc/testsuite/ChangeLog | 5 ++ .../gfortran.dg/pointer_array_11.f90 | 90 +++++++++++++++++++ 4 files changed, 106 insertions(+), 17 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/pointer_array_11.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 14ec8451c57..0376f00ed53 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +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-05 Andrew Stubbs * openmp.c (resolve_omp_clauses): Add custom error messages for @@ -33,9 +40,9 @@ ChangeLog forgotten with revision 272667 * decl.c (access_attr_decl): Use temporary variable to reduce unreadability of code. Normalize jumping to return. - (gfc_match_protected): Fix parsing error. Add comments to + (gfc_match_protected): Fix parsing error. Add comments to explain code. Remove dead code. - (gfc_match_private): Use temporary variable to reduce unreadability + (gfc_match_private): Use temporary variable to reduce unreadability of code. Fix parsing error. Move code to test for blank PRIVATE. Remove dead code. (gfc_match_public): Move code to test for blank PUBLIC. Fix diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 1ab03615fda..c8d74e588dd 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; + decl = build_fold_indirect_ref_loc (input_location, decl); /* 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); } @@ -7865,7 +7852,7 @@ array_parameter_size (tree desc, gfc_expr *expr, tree *size) } /* Helper function - return true if the argument is a pointer. */ - + static bool is_pointer (gfc_expr *e) { diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index cc0661a947e..12e5bc167e0 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2019-07-07 Paul Thomas + + PR fortran/91077 + * gfortran.dg/pointer_array_11.f90 : New test. + 2019-07-06 Jakub Jelinek * c-c++-common/gomp/scan-4.c: Don't expect sorry message. 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 00000000000..11885ae4301 --- /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 -- 2.30.2