===================================================================
*************** gfc_conv_scalarized_array_ref (gfc_se *
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
*************** gfc_conv_scalarized_array_ref (gfc_se *
decl = info->descriptor;
}
- done:
se->expr = gfc_build_array_ref (base, index, decl);
}
===================================================================
***************
+ ! { dg-do run }
+ !
+ ! Test the fix for PR91077 - both the original test and that in comment #4 of the PR.
+ !
+ ! Contribute by Ygal Klein <ygalklein@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
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 <pault@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 <pault@gcc.gnu.org> PR fortran/91077 * gfortran.dg/pointer_array_11.f90 : New test.