Fortran: fix bogus bounds check for reallocation on assignment [PR116706]

	PR fortran/116706

gcc/fortran/ChangeLog:

	* trans-array.cc (gfc_is_reallocatable_lhs): Fix check on
	allocatable components of derived type or class objects.

gcc/testsuite/ChangeLog:

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

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 8ab290bbe610b29043f22904244ccecdc8e91cc6..e9eacf2012836f5eb6b30fc8e0065203bab05c7d 100644 (file)
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -11236,9 +11236,7 @@ gfc_is_reallocatable_lhs (gfc_expr *expr)
     return true;
 
   /* All that can be left are allocatable components.  */
-  if ((sym->ts.type != BT_DERIVED
-       && sym->ts.type != BT_CLASS)
-       || !sym->ts.u.derived->attr.alloc_comp)
+  if (sym->ts.type != BT_DERIVED && sym->ts.type != BT_CLASS)
     return false;
 
   /* Find a component ref followed by an array reference.  */

diff --git a/gcc/testsuite/gfortran.dg/bounds_check_27.f90 b/gcc/testsuite/gfortran.dg/bounds_check_27.f90
new file mode 100644 (file)
index 0000000..678aef6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_27.f90
@@ -0,0 +1,45 @@
+! { dg-do run }
+! { dg-additional-options "-fcheck=bounds" }
+!
+! PR fortran/116706 - bogus bounds check for reallocation on assignment
+! Contributed by Balint Aradi  <baradi09 at gmail.com>
+
+program testprog
+  implicit none
+
+  type :: data_node
+     integer, allocatable :: data(:)
+  end type data_node
+
+  type :: data_list
+     type(data_node), pointer :: nodes(:) => null()
+  end type data_list
+
+  type :: upoly_node
+     class(*), allocatable :: data(:)
+  end type upoly_node
+
+  type :: star_list
+     type(upoly_node), pointer :: nodes(:) => null()
+  end type star_list
+
+  type(data_list) :: datalist
+  type(star_list) :: starlist
+  class(star_list), allocatable :: astarlist
+  class(star_list), pointer     :: pstarlist
+
+  allocate (datalist%nodes(2))
+  datalist%nodes(1)%data = [1, 2, 3]
+
+  allocate (starlist%nodes(2))
+  starlist%nodes(1)%data = [1., 2., 3.]
+
+  allocate (astarlist)
+  allocate (astarlist%nodes(2))
+  astarlist%nodes(1)%data = [1, 2, 3]
+
+  allocate (pstarlist)
+  allocate (pstarlist%nodes(2))
+  pstarlist%nodes(1)%data = [1., 2., 3.]
+
+end program testprog