This problem was caused by the code for scalarized array references to
subref arrays and deferred length variables not obtaining the correct
array descriptor and so getting the array span wrong. As it happens,
the lines, following the deleted part, correctly identify when the
info descriptor is a pointer and provide the span as appropriate.
Bootstrapped and regtested on FC29/x86_64 - OK for trunk and 9-branch?
8-branch might be somewhat more difficult to fix but I will give it a
try. This will require a separate submission.
Paul
2019-07-06 Paul Thomas <pa...@gcc.gnu.org>
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-06 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/91077
* gfortran.dg/pointer_array_11.f90 : New test.
Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c (revision 272089)
--- gcc/fortran/trans-array.c (working copy)
*************** gfc_conv_scalarized_array_ref (gfc_se *
*** 3502,3520 ****
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
--- 3502,3508 ----
*************** gfc_conv_scalarized_array_ref (gfc_se *
*** 3532,3538 ****
decl = info->descriptor;
}
- done:
se->expr = gfc_build_array_ref (base, index, decl);
}
--- 3520,3525 ----
Index: gcc/testsuite/gfortran.dg/pointer_array_11.f90
===================================================================
*** gcc/testsuite/gfortran.dg/pointer_array_11.f90 (nonexistent)
--- gcc/testsuite/gfortran.dg/pointer_array_11.f90 (working copy)
***************
*** 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 <ygalkl...@gmail.com>
+ !
+ 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
