re PR fortran/91077 (Wrong indexing when using a pointer)

2019-07-07  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-07  Paul Thomas  <pault@gcc.gnu.org>

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

From-SVN: r273176

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 14ec8451c57773552e6ee4e4bd07cd12a8869966..0376f00ed53ae6f9b4f0f262be5edaf51365df1f 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2019-07-07  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-05  Andrew Stubbs  <ams@codesourcery.com>
 
        * 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 1ab03615fda0a6a9e93d3ffe029a2a8eddb14767..c8d74e588ddc8a94838c43df82cf3e40263c471a 100644 (file)
--- 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 cc0661a947ee87dbd50af7afc3151e404cf5ef91..12e5bc167e06e0b1e7f6994eacbb43405a5cc2bb 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2019-07-07  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/91077
+       * gfortran.dg/pointer_array_11.f90 : New test.
+
 2019-07-06  Jakub Jelinek  <jakub@redhat.com>
 
        * 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 (file)
index 0000000..11885ae
--- /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  <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