Message ID | trinity-cb7fa6a7-8060-4c27-bb11-749f030158c4-1714415944896@3c-app-gmx-bs06 |
---|---|
State | New |
Headers | show |
Series | Fortran: fix issues with class(*) assignment [PR114827] | expand |
Hi Harald, This patch is verging on 'obvious', ..... once one sees it :-) Yes, it's good for mainline and all active branches, when available. Thanks Paul PS The fall-out pr114874 is so peculiar that I am dropping everything to find the source. On Mon, 29 Apr 2024 at 19:39, Harald Anlauf <anlauf@gmx.de> wrote: > Dear all, > > the attached patch fixes issues with assignments of unlimited polymorphic > entities that were found with the help of valgrind or asan, see PR. > Looking > further into it, it turns out that allocation sizes as well as array spans > could be set incorrectly, leading to wrong results or heap corruption. > > The fix is rather straightforward: take into the _len of unlimited > polymorphic entities when it is non-zero to get the correct allocation > sizes and array spans. > > The patch has been tested by the reporter, see PR. > > Regtested on x86_64-pc-linux-gnu. OK for 15-mainline? > > I would like to backport this to active branches where appropriate, > starting with 14 after it reopens after release. Is this OK? > > Thanks, > Harald > >
Hi Paul, On 4/30/24 07:50, Paul Richard Thomas wrote: > Hi Harald, > > This patch is verging on 'obvious', ..... once one sees it :-) > > Yes, it's good for mainline and all active branches, when available. thanks for your quick review. I haven't committed it yet, because I forgot to check what happens with a class(*) allocatable function result on the r.h.s. of the assignment. One now gets an ICE with the testcase in your submission https://gcc.gnu.org/pipermail/fortran/2024-April/060426.html on the simple scalar assignment y = bar () instead of wrong code. Not very helpful. I tried the following change on top of the submitted patch: diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 4ba40bfdbd3..cacf3c0dda1 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -11995,7 +11996,11 @@ trans_class_assignment (stmtblock_t *block, gfc_expr *lhs, gfc_expr *rhs, /* Take into account _len of unlimited polymorphic entities. */ if (UNLIMITED_POLY (rhs)) { - tree len = trans_get_upoly_len (block, rhs); + tree len; + if (rhs->expr_type == EXPR_VARIABLE) + len = trans_get_upoly_len (block, rhs); + else + len = gfc_class_len_get (gfc_get_class_from_expr (tmp)); len = fold_build2_loc (input_location, MAX_EXPR, size_type_node, fold_convert (size_type_node, len), size_one_node); This avoids the ICE, but depending on details of bar() this leads to different wrong code from before, and function bar() result(res) class(*), allocatable :: res res = sca end function bar behaves differently from function bar() class(*), allocatable :: bar bar = sca end function bar The minimal and sort of "safe" fix to avoid a new ICE while keeping the fix for simple assignments is to replace in the above snippet if (UNLIMITED_POLY (rhs)) by if (UNLIMITED_POLY (rhs) && rhs->expr_type == EXPR_VARIABLE) omit the other changes above, and defer a fix for assignment of function results, as looking at the dump-tree suggests that this will be a bigger piece of work. (The .span looks suspicious all over the place...) The good thing is: a simple test with array-valued function results did not immediately break the submitted patch... ;-) What do you think? Thanks, Harald > Thanks > > Paul > > PS The fall-out pr114874 is so peculiar that I am dropping everything to > find the source. > > > On Mon, 29 Apr 2024 at 19:39, Harald Anlauf <anlauf@gmx.de> wrote: > >> Dear all, >> >> the attached patch fixes issues with assignments of unlimited polymorphic >> entities that were found with the help of valgrind or asan, see PR. >> Looking >> further into it, it turns out that allocation sizes as well as array spans >> could be set incorrectly, leading to wrong results or heap corruption. >> >> The fix is rather straightforward: take into the _len of unlimited >> polymorphic entities when it is non-zero to get the correct allocation >> sizes and array spans. >> >> The patch has been tested by the reporter, see PR. >> >> Regtested on x86_64-pc-linux-gnu. OK for 15-mainline? >> >> I would like to backport this to active branches where appropriate, >> starting with 14 after it reopens after release. Is this OK? >> >> Thanks, >> Harald >> >> >
Hi Harald, Please do commit, with or without the extra bit for the function result. As well as having to get back to pr113363, I have patches in a complete state for pr84006 and 98534. However they clash with yours. You arrived at the head of the queue first and so after you :-) Regards Paul
Hi Paul, Am 05.05.24 um 18:48 schrieb Paul Richard Thomas: > Hi Harald, > > Please do commit, with or without the extra bit for the function result. I've committed the attached variant that excludes the case of a scalar class(*) allocatable function result on the rhs, and added a TODO. > As well as having to get back to pr113363, I have patches in a complete > state for pr84006 and 98534. However they clash with yours. You arrived at > the head of the queue first and so after you :-) Well, thanks for volunteering to clean up after me... ;-) Cheers, Harald > Regards > > Paul >
From 3b73471b570898e5a5085422da48d5bf118edff1 Mon Sep 17 00:00:00 2001 From: Harald Anlauf <anlauf@gmx.de> Date: Mon, 29 Apr 2024 19:52:52 +0200 Subject: [PATCH] Fortran: fix issues with class(*) assignment [PR114827] gcc/fortran/ChangeLog: PR fortran/114827 * trans-array.cc (gfc_alloc_allocatable_for_assignment): Take into account _len of unlimited polymorphic entities when calculating the effective element size for allocation size and array span. Set _len of lhs to _len of rhs. * trans-expr.cc (trans_class_assignment): Take into account _len of unlimited polymorphic entities for allocation size. gcc/testsuite/ChangeLog: PR fortran/114827 * gfortran.dg/asan/unlimited_polymorphic_34.f90: New test. --- gcc/fortran/trans-array.cc | 16 +++ gcc/fortran/trans-expr.cc | 12 ++ .../asan/unlimited_polymorphic_34.f90 | 135 ++++++++++++++++++ 3 files changed, 163 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/asan/unlimited_polymorphic_34.f90 diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 30b84762346..7ec33fb1598 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -11278,6 +11278,19 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, gfc_add_modify (&fblock, linfo->delta[dim], tmp); } + /* Take into account _len of unlimited polymorphic entities, so that span + for array descriptors and allocation sizes are computed correctly. */ + if (UNLIMITED_POLY (expr2)) + { + tree len = gfc_class_len_get (TREE_OPERAND (desc2, 0)); + len = fold_build2_loc (input_location, MAX_EXPR, size_type_node, + fold_convert (size_type_node, len), + size_one_node); + elemsize2 = fold_build2_loc (input_location, MULT_EXPR, + gfc_array_index_type, elemsize2, + fold_convert (gfc_array_index_type, len)); + } + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc))) gfc_conv_descriptor_span_set (&fblock, desc, elemsize2); @@ -11324,6 +11337,9 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, gfc_add_modify (&fblock, tmp, fold_convert (TREE_TYPE (tmp), TYPE_SIZE_UNIT (type))); + else if (UNLIMITED_POLY (expr2)) + gfc_add_modify (&fblock, tmp, + gfc_class_len_get (TREE_OPERAND (desc2, 0))); else gfc_add_modify (&fblock, tmp, build_int_cst (TREE_TYPE (tmp), 0)); diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 0280c441ced..4ba40bfdbd3 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -11991,6 +11991,18 @@ trans_class_assignment (stmtblock_t *block, gfc_expr *lhs, gfc_expr *rhs, old_vptr = build_int_cst (TREE_TYPE (vptr), 0); size = gfc_vptr_size_get (rhs_vptr); + + /* Take into account _len of unlimited polymorphic entities. */ + if (UNLIMITED_POLY (rhs)) + { + tree len = trans_get_upoly_len (block, rhs); + len = fold_build2_loc (input_location, MAX_EXPR, size_type_node, + fold_convert (size_type_node, len), + size_one_node); + size = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (size), + size, fold_convert (TREE_TYPE (size), len)); + } + tmp = lse->expr; class_han = GFC_CLASS_TYPE_P (TREE_TYPE (tmp)) ? gfc_class_data_get (tmp) : tmp; diff --git a/gcc/testsuite/gfortran.dg/asan/unlimited_polymorphic_34.f90 b/gcc/testsuite/gfortran.dg/asan/unlimited_polymorphic_34.f90 new file mode 100644 index 00000000000..c69158a1b55 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/asan/unlimited_polymorphic_34.f90 @@ -0,0 +1,135 @@ +! { dg-do run } +! PR fortran/114827 - issues with class(*) assignment found by valgrind +! +! Contributed by Neil Carlson <neil.n.carlson@gmail.com> + +program main + implicit none + call run + call run1 + call run2 +contains + ! Scalar tests + subroutine run () + character(*), parameter :: c = 'fubarfubarfubarfubarfubarfu' + character(*,kind=4), parameter :: d = 4_"abcdef" + complex, parameter :: z = (1.,2.) + class(*), allocatable :: y + + call foo (c, y) + select type (y) + type is (character(*)) +! print *, y(5:6) ! ICE (-> pr114874) + if (y /= c) stop 1 + class default + stop 2 + end select + + call foo (z, y) + select type (y) + type is (complex) + if (y /= z) stop 3 + class default + stop 4 + end select + + call foo (d, y) + select type (y) + type is (character(*,kind=4)) +! print *, y ! NAG fails here + if (y /= d) stop 5 + class default + stop 6 + end select + end subroutine + ! + subroutine foo (a, b) + class(*), intent(in) :: a + class(*), allocatable :: b + b = a + end subroutine + + ! Rank-1 tests + subroutine run1 () + character(*), parameter :: c(*) = ['fubar','snafu'] + character(*,kind=4), parameter :: d(*) = [4_"abc",4_"def"] + real, parameter :: r(*) = [1.,2.,3.] + class(*), allocatable :: y(:) + + call foo1 (c, y) + select type (y) + type is (character(*)) +! print *, ">",y(2)(1:3),"< >", c(2)(1:3), "<" + if (any (y /= c)) stop 11 + if (y(2)(1:3) /= c(2)(1:3)) stop 12 + class default + stop 13 + end select + + call foo1 (r, y) + select type (y) + type is (real) + if (any (y /= r)) stop 14 + class default + stop 15 + end select + + call foo1 (d, y) + select type (y) + type is (character(*,kind=4)) +! print *, ">",y(2)(2:3),"< >", d(2)(2:3), "<" + if (any (y /= d)) stop 16 + class default + stop 17 + end select + end subroutine + ! + subroutine foo1 (a, b) + class(*), intent(in) :: a(:) + class(*), allocatable :: b(:) + b = a + end subroutine + + ! Rank-2 tests + subroutine run2 () + character(7) :: c(2,3) + complex :: z(3,3) + integer :: i, j + class(*), allocatable :: y(:,:) + + c = reshape (['fubar11','snafu21',& + 'fubar12','snafu22',& + 'fubar13','snafu23'],shape(c)) + call foo2 (c, y) + select type (y) + type is (character(*)) +! print *, y(2,1) + if (y(2,1) /= c(2,1)) stop 21 + if (any (y /= c)) stop 22 + class default + stop 23 + end select + + do j = 1, size (z,2) + do i = 1, size (z,1) + z(i,j) = cmplx (i,j) + end do + end do + call foo2 (z, y) + select type (y) + type is (complex) +! print *, y(2,1) + if (any (y%re /= z%re)) stop 24 + if (any (y%im /= z%im)) stop 25 + class default + stop 26 + end select + end subroutine + ! + subroutine foo2 (a, b) + class(*), intent(in) :: a(:,:) + class(*), allocatable :: b(:,:) + b = a + end subroutine + +end program -- 2.35.3