[fortran] PR91077 - [8/9/10 Regression] Wrong indexing when using a pointer

Message ID CAGkQGiJ7sPQN1SMfyQqKrE=+M7i=tcM-vk3VNsvMbopbA9Fmeg@mail.gmail.com
State New
Headers show
Series
  • [fortran] PR91077 - [8/9/10 Regression] Wrong indexing when using a pointer
Related show

Commit Message

Paul Richard Thomas July 6, 2019, 10:48 a.m.
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.

Comments

Paul Richard Thomas July 6, 2019, 1:29 p.m. | #1
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  <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.

2019-07-06  Paul Thomas  <pault@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.thomas@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  <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.




-- 
"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  <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
Steve Kargl July 6, 2019, 5:04 p.m. | #2
On Sat, Jul 06, 2019 at 02:29:06PM +0100, Paul Richard Thomas wrote:
> 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?

> 


OK for both patches.

-- 
Steve
Paul Richard Thomas July 7, 2019, 4:20 p.m. | #3
Thanks, Steve.

Fixed with revisions 273176, 7 & 8.

Paul

On Sat, 6 Jul 2019 at 18:05, Steve Kargl
<sgk@troutmask.apl.washington.edu> wrote:
>

> On Sat, Jul 06, 2019 at 02:29:06PM +0100, Paul Richard Thomas wrote:

> > 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?

> >

>

> OK for both patches.

>

> --

> Steve




-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein

Patch

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  <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