diff options
| -rw-r--r-- | gcc/fortran/trans-array.cc | 4 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/bounds_check_27.f90 | 45 |
2 files changed, 46 insertions, 3 deletions
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 8ab290b..e9eacf2 100644 --- 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 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 |