Fortran: fix issue with I/O of array pointer [PR107968]

	PR fortran/107968

gcc/fortran/ChangeLog:

	* trans-io.cc (gfc_trans_transfer): Also scalarize I/O of section
	of an array pointer.

gcc/testsuite/ChangeLog:

	* gfortran.dg/implied_do_io_9.f90: New test.

diff --git a/gcc/fortran/trans-io.cc b/gcc/fortran/trans-io.cc
index df2fef70172ac145b47744e94709733378ec72ca..9360bddb30a74d0ffed79a151c178a6f8ebad44a 100644 (file)
--- a/gcc/fortran/trans-io.cc
+++ b/gcc/fortran/trans-io.cc
@@ -2646,7 +2646,9 @@ gfc_trans_transfer (gfc_code * code)
         && ((expr->symtree->n.sym->ts.type == BT_DERIVED && expr->ts.deferred)
             || (expr->symtree->n.sym->assoc
                 && expr->symtree->n.sym->assoc->variable)
-            || gfc_expr_attr (expr).pointer))
+            || gfc_expr_attr (expr).pointer
+            || (expr->symtree->n.sym->attr.pointer
+                && gfc_expr_attr (expr).target)))
        goto scalarize;
 
       /* With array-bounds checking enabled, force scalarization in some

diff --git a/gcc/testsuite/gfortran.dg/implied_do_io_9.f90 b/gcc/testsuite/gfortran.dg/implied_do_io_9.f90
new file mode 100644 (file)
index 0000000..5180b8a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/implied_do_io_9.f90
@@ -0,0 +1,72 @@
+! { dg-do run }
+! { dg-additional-options "-O2" }
+!
+! PR fortran/107968
+!
+! Verify that array I/O optimization is not used for a section
+! of an array pointer as the pointee can be non-contiguous
+!
+! Contributed by Nils Dreier
+
+PROGRAM foo
+  implicit none
+
+  TYPE t_geographical_coordinates
+     REAL :: lon
+     REAL :: lat
+  END TYPE t_geographical_coordinates
+
+  TYPE t_vertices
+     REAL, POINTER          :: vlon(:) => null()
+     REAL, POINTER          :: vlat(:) => null()
+  END TYPE t_vertices
+
+  TYPE(t_geographical_coordinates), TARGET :: vertex(2)
+  TYPE(t_vertices), POINTER :: vertices_pointer
+  TYPE(t_vertices), TARGET  :: vertices_target
+
+  character(24)           :: s0, s1, s2
+  character(*), parameter :: fmt = '(2f8.3)'
+
+  ! initialization
+  vertex%lon = [1,3]
+  vertex%lat = [2,4]
+
+  ! obtain pointer to (non-contiguous) field
+  vertices_target%vlon => vertex%lon
+
+  ! reference output of write
+  write (s0,fmt) vertex%lon
+
+  ! set pointer vertices_pointer in a subroutine
+  CALL set_vertices_pointer(vertices_target)
+
+  write (s1,fmt) vertices_pointer%vlon
+  write (s2,fmt) vertices_pointer%vlon(1:)
+  if (s1 /= s0 .or. s2 /= s0) then
+     print *, s0, s1, s2
+     stop 3
+  end if
+
+CONTAINS
+
+  SUBROUTINE set_vertices_pointer(vertices)
+    TYPE(t_vertices), POINTER, INTENT(IN) :: vertices
+
+    vertices_pointer => vertices
+
+    write (s1,fmt) vertices        %vlon
+    write (s2,fmt) vertices        %vlon(1:)
+    if (s1 /= s0 .or. s2 /= s0) then
+       print *, s0, s1, s2
+       stop 1
+    end if
+
+    write (s1,fmt) vertices_pointer%vlon
+    write (s2,fmt) vertices_pointer%vlon(1:)
+    if (s1 /= s0 .or. s2 /= s0) then
+       print *, s0, s1, s2
+       stop 2
+    end if
+  END SUBROUTINE set_vertices_pointer
+END PROGRAM foo