Fortran: contiguous pointer assignment to select type target [PR122709]

	PR fortran/122709

gcc/fortran/ChangeLog:

	* resolve.cc (resolve_assoc_var): If the associate target is a
	contiguous pointer, so is the associate variable.

gcc/testsuite/ChangeLog:

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

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index b1d2ff220bf039c12aa43ede07682172c4288449..2390858424e268a8b623435e857b2db419c941d0 100644 (file)
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -10790,6 +10790,10 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
   /* If the target is a good class object, so is the associate variable.  */
   if (sym->ts.type == BT_CLASS && gfc_expr_attr (target).class_ok)
     sym->attr.class_ok = 1;
+
+  /* If the target is a contiguous pointer, so is the associate variable.  */
+  if (gfc_expr_attr (target).pointer && gfc_expr_attr (target).contiguous)
+    sym->attr.contiguous = 1;
 }
 
 

diff --git a/gcc/testsuite/gfortran.dg/select_contiguous.f90 b/gcc/testsuite/gfortran.dg/select_contiguous.f90
new file mode 100644 (file)
index 0000000..b947006
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_contiguous.f90
@@ -0,0 +1,51 @@
+! { dg-do compile }
+! { dg-options "-O2 -Wextra -fdump-tree-optimized" }
+!
+! PR fortran/122709 - bogus warning for contiguous pointer assignment
+!                     to select type target
+!
+! Contributed by <mscfd at gmx dot net>
+
+module sc_mod
+  implicit none
+  public
+
+  type :: t
+     integer :: i = 0
+  end type t
+
+  type :: s
+     class(t), dimension(:), contiguous, pointer :: p => null()
+  end type s
+
+contains
+
+  subroutine foo(x)
+    class(s), intent(in) :: x
+    type(t), dimension(:), contiguous, pointer :: q
+    select type (p_ => x%p)
+    type is (t)
+       q => p_
+       if (.not. is_contiguous(x%p)) stop 1
+       if (.not. is_contiguous(p_))  stop 2     ! Should get optimized out
+       if (.not. is_contiguous(q))   stop 3
+       write(*,*) 'is contiguous: ', is_contiguous(x%p), &
+            is_contiguous(p_), is_contiguous(q)
+    end select
+  end subroutine foo
+
+end module sc_mod
+
+program select_contiguous
+  use sc_mod
+  implicit none
+
+  type(s) :: x
+
+  allocate(t :: x%p(1:10))
+  call foo(x)
+  deallocate(x%p)
+
+end program select_contiguous
+
+! { dg-final { scan-tree-dump-not "_gfortran_stop_numeric" "optimized" } }