]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
re PR fortran/91077 (Wrong indexing when using a pointer)
authorPaul Thomas <pault@gcc.gnu.org>
Sun, 7 Jul 2019 14:32:53 +0000 (14:32 +0000)
committerPaul Thomas <pault@gcc.gnu.org>
Sun, 7 Jul 2019 14:32:53 +0000 (14:32 +0000)
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: r273177

gcc/fortran/ChangeLog
gcc/fortran/trans-array.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/pointer_array_11.f90 [new file with mode: 0644]

index 4e5e263bda5a974f1f4f31a809a57f6820486cfb..13dccac7ac2002a9e67b74508c7005cfe475b680 100644 (file)
@@ -1,3 +1,11 @@
+2019-07-07  Paul Thomas  <pault@gcc.gnu.org>
+
+       Backport from mainline
+       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-06-21  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
        Backport from trunk
@@ -52,7 +60,7 @@
 
        Backport from mainline
        PR fortran/69499
-       * match.c (gfc_match_select_type):  SELECT TYPE is an executable 
+       * match.c (gfc_match_select_type):  SELECT TYPE is an executable
        statement, and cannot appear in MODULE or SUBMODULE scope.
 
 2019-06-20  Steven G. Kargl  <kargl@gcc.gnu.org>
index 8a0de6140edab818cadef41d196d87816752ccda..583425c516daf68dc49e37525d0186972242896a 100644 (file)
@@ -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;
 
   /* 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);
 }
 
index c128e1c7072760b85509c02a588c69fa8ad53518..f6c33e929e86569125c77b1066ebb12595e02bf2 100644 (file)
@@ -1,3 +1,9 @@
+2019-07-07  Paul Thomas  <pault@gcc.gnu.org>
+
+       Backport from mainline
+       PR fortran/91077
+       * gfortran.dg/pointer_array_11.f90 : New test.
+
 2019-07-05  Szabolcs Nagy  <szabolcs.nagy@arm.com>
 
        Backport from mainline
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
@@ -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