diff options
| author | Harald Anlauf <anlauf@gmx.de> | 2025-03-19 22:56:03 +0100 |
|---|---|---|
| committer | Harald Anlauf <anlauf@gmx.de> | 2025-03-19 23:36:33 +0100 |
| commit | 3292ca9b0818c3e55102413c2407711d0755d280 (patch) | |
| tree | a14f9159b9d65a17cd5a8b3189e7d41050cb5016 /gcc | |
| parent | 80e1dac3849b134ebd5e0151e9c9e4b8b091de72 (diff) | |
| download | gcc-3292ca9b0818c3e55102413c2407711d0755d280.zip gcc-3292ca9b0818c3e55102413c2407711d0755d280.tar.gz gcc-3292ca9b0818c3e55102413c2407711d0755d280.tar.bz2 | |
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.
Diffstat (limited to 'gcc')
| -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 |