As anticipated, 8-branch required a different patch but the difference
was much smaller than anticipated.

Bootstrapped and regetested on FC29/x86_64 - OK for 8-branch?

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.

2019-07-06  Paul Thomas  <pa...@gcc.gnu.org>

    PR fortran/91077
    * gfortran.dg/pointer_array_11.f90 : New test.

On Sat, 6 Jul 2019 at 11:48, Paul Richard Thomas
<paul.richard.tho...@gmail.com> wrote:
>
> 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.



-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein
Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c	(revision 272102)
--- gcc/fortran/trans-array.c	(working copy)
*************** gfc_conv_scalarized_array_ref (gfc_se *
*** 3422,3431 ****
    if (build_class_array_ref (se, base, index))
      return;
  
!   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;
  
    /* A pointer array component can be detected from its field decl. Fix
--- 3422,3429 ----
    if (build_class_array_ref (se, base, index))
      return;
  
!   if (expr && (expr->ts.deferred && (expr->expr_type == EXPR_VARIABLE
! 				     || expr->expr_type == EXPR_FUNCTION)))
      decl = expr->symtree->n.sym->backend_decl;
  
    /* A pointer array component can be detected from its field decl. Fix
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

Reply via email to