Message ID | CAGkQGiKLrys-Qj=f_Qq-+JaKymGO_DRceZqkpFfXMTcaePnhpw@mail.gmail.com |
---|---|
State | New |
Headers | show |
Series | [fortran] PR113363 - ICE on ASSOCIATE and unlimited polymorphic function | expand |
Hi Paul! On 4/10/24 10:25, Paul Richard Thomas wrote: > Hi All, > > This patch corrects incorrect results from assignment of unlimited > polymorphic function results both in assignment statements and allocation > with source. > > The first chunk in trans-array.cc ensures that the array dtype is set to > the source dtype. The second chunk ensures that the lhs _len field does not > default to zero and so is specific to dynamic types of character. > > The addition to trans-stmt.cc transforms the source expression, aka expr3, > from a derived type of type "STAR" into a proper unlimited polymorphic > expression ready for assignment to the newly allocated entity. I am wondering about the following snippet in trans-stmt.cc: + /* Copy over the lhs _data component ref followed by the + full array reference for source expressions with rank. + Otherwise, just copy the _data component ref. */ + if (code->expr3->rank + && ref && ref->next && !ref->next->next) + { + rhs->ref = gfc_copy_ref (ref); + rhs->ref->next = gfc_copy_ref (ref->next); + break; + } Why the two gfc_copy_ref? valgrind pointed my to the tail of gfc_copy_ref which already has: dest->next = gfc_copy_ref (src->next); so this looks redundant and leaks frontend memory? *** Playing with the testcase, I find several invalid writes with valgrind, or a heap buffer overflow with -fsanitize=address . It is sufficient to look at a mini-test where the class(*) function result is assigned to the class(*), allocatable in the main: x = foo () deallocate (x) The dump tree suggests that array bounds in foo() are read before they are properly set. These invalid writes do not occur with 13-branch, so this might be a regression. Can you have a look yourself? Thanks, Harald > OK for mainline? > > Paul > > Fortran: Fix wrong code in unlimited polymorphic assignment [PR113363] > > 2024-04-10 Paul Thomas <pault@gcc.gnu.org> > > gcc/fortran > PR fortran/113363 > * trans-array.cc (gfc_array_init_size): Use the expr3 dtype so > that the correct element size is used. > (gfc_alloc_allocatable_for_assignment): Set the _len field for > unlimited polymorphic assignments. > * trans-stmt.cc (gfc_trans_allocate): Build a correct rhs for > the assignment of an unlimited polymorphic 'source'. > > gcc/testsuite/ > PR fortran/113363 > * gfortran.dg/pr113363.f90: New test. >
Hi Harald, Please find attached my resubmission for pr113363. The changes are as follows: (i) The chunk in gfc_conv_procedure_call is new. This was the source of one of the memory leaks; (ii) The incorporation of the _len field in trans_class_assignment was done for the pr84006 patch; (iii) The source of all the invalid memory accesses and so on was down to the use of realloc. I tried all sorts of workarounds such as testing the vptrs and the sizes but only free followed by malloc worked. I have no idea at all why this is the case; and (iv) I took account of your remarks about the chunk in trans-array.cc by removing it and that the chunk in trans-stmt.cc would leak frontend memory. OK for mainline (and -14 branch after a few-weeks)? Regards Paul Fortran: Fix wrong code in unlimited polymorphic assignment [PR113363] 2024-05-12 Paul Thomas <pault@gcc.gnu.org> gcc/fortran PR fortran/113363 * trans-array.cc (gfc_array_init_size): Use the expr3 dtype so that the correct element size is used. * trans-expr.cc (gfc_conv_procedure_call): Remove restriction that ss and ss->loop be present for the finalization of class array function results. (trans_class_assignment): Use free and malloc, rather than realloc, for character expressions assigned to unlimited poly entities. * trans-stmt.cc (gfc_trans_allocate): Build a correct rhs for the assignment of an unlimited polymorphic 'source'. gcc/testsuite/ PR fortran/113363 * gfortran.dg/pr113363.f90: New test. > > The first chunk in trans-array.cc ensures that the array dtype is set to > > the source dtype. The second chunk ensures that the lhs _len field does > not > > default to zero and so is specific to dynamic types of character. > > > > Why the two gfc_copy_ref? valgrind pointed my to the tail > of gfc_copy_ref which already has: > > dest->next = gfc_copy_ref (src->next); > > so this looks redundant and leaks frontend memory? > > *** > > Playing with the testcase, I find several invalid writes with > valgrind, or a heap buffer overflow with -fsanitize=address . > > >
Hi Paul, this looks all good now, and is OK for mainline as well as backporting! *** While playing with the testcase, I found 3 remaining smaller issues that are pre-existing, so they should not delay your present work. To make it clear: these are not regressions. When "maliciously" perturbing the testcase by adding parentheses in the right places, I see the following: Replacing associate (var => foo ()) ! OK after r14-9489-g3fd46d859cda10 by associate (var => (foo ())) gives an ICE here with 14-branch and 15-mainline. Similarly replacing allocate (y, source = x(1)) ! Gave zero length here by allocate (y, source = (x(1))) Furthermore, replacing allocate(x, source = foo ()) by allocate(x, source = (foo ())) gives a runtime segfault with both 14-branch and 15-mainline. So this is something for another day... Thanks for the patch! Harald Am 12.05.24 um 13:27 schrieb Paul Richard Thomas: > Hi Harald, > > Please find attached my resubmission for pr113363. The changes are as > follows: > (i) The chunk in gfc_conv_procedure_call is new. This was the source of one > of the memory leaks; > (ii) The incorporation of the _len field in trans_class_assignment was done > for the pr84006 patch; > (iii) The source of all the invalid memory accesses and so on was down to > the use of realloc. I tried all sorts of workarounds such as testing the > vptrs and the sizes but only free followed by malloc worked. I have no idea > at all why this is the case; and > (iv) I took account of your remarks about the chunk in trans-array.cc by > removing it and that the chunk in trans-stmt.cc would leak frontend memory. > > OK for mainline (and -14 branch after a few-weeks)? > > Regards > > Paul > > Fortran: Fix wrong code in unlimited polymorphic assignment [PR113363] > > 2024-05-12 Paul Thomas <pault@gcc.gnu.org> > > gcc/fortran > PR fortran/113363 > * trans-array.cc (gfc_array_init_size): Use the expr3 dtype so > that the correct element size is used. > * trans-expr.cc (gfc_conv_procedure_call): Remove restriction > that ss and ss->loop be present for the finalization of class > array function results. > (trans_class_assignment): Use free and malloc, rather than > realloc, for character expressions assigned to unlimited poly > entities. > * trans-stmt.cc (gfc_trans_allocate): Build a correct rhs for > the assignment of an unlimited polymorphic 'source'. > > gcc/testsuite/ > PR fortran/113363 > * gfortran.dg/pr113363.f90: New test. > > >>> The first chunk in trans-array.cc ensures that the array dtype is set to >>> the source dtype. The second chunk ensures that the lhs _len field does >> not >>> default to zero and so is specific to dynamic types of character. >>> >> >> Why the two gfc_copy_ref? valgrind pointed my to the tail >> of gfc_copy_ref which already has: >> >> dest->next = gfc_copy_ref (src->next); >> >> so this looks redundant and leaks frontend memory? >> >> *** >> >> Playing with the testcase, I find several invalid writes with >> valgrind, or a heap buffer overflow with -fsanitize=address . >> >> >> >
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 30b84762346..2f9a32dda15 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -5957,6 +5957,11 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset, tmp = gfc_conv_descriptor_dtype (descriptor); gfc_add_modify (pblock, tmp, gfc_get_dtype_rank_type (rank, type)); } + else if (expr3_desc && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (expr3_desc))) + { + tmp = gfc_conv_descriptor_dtype (descriptor); + gfc_add_modify (pblock, tmp, gfc_conv_descriptor_dtype (expr3_desc)); + } else { tmp = gfc_conv_descriptor_dtype (descriptor); @@ -11324,6 +11329,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 (desc, 0))); else gfc_add_modify (&fblock, tmp, build_int_cst (TREE_TYPE (tmp), 0)); diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc index 7997c167bae..c6953033cf4 100644 --- a/gcc/fortran/trans-stmt.cc +++ b/gcc/fortran/trans-stmt.cc @@ -7187,6 +7187,45 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist *omp_allocate) gfc_expr *rhs = e3rhs ? e3rhs : gfc_copy_expr (code->expr3); flag_realloc_lhs = 0; + /* The handling of code->expr3 above produces a derived type of + type "STAR", whose size defaults to size(void*). In order to + have the right type information for the assignment, we must + reconstruct an unlimited polymorphic rhs. */ + if (UNLIMITED_POLY (code->expr3) + && e3rhs && e3rhs->ts.type == BT_DERIVED + && !strcmp (e3rhs->ts.u.derived->name, "STAR")) + { + gfc_ref *ref; + gcc_assert (TREE_CODE (expr3_vptr) == COMPONENT_REF); + tmp = gfc_create_var (gfc_typenode_for_spec (&code->expr3->ts), + "e3"); + gfc_add_modify (&block, tmp, + gfc_get_class_from_expr (expr3_vptr)); + rhs->symtree->n.sym->backend_decl = tmp; + rhs->ts = code->expr3->ts; + rhs->symtree->n.sym->ts = rhs->ts; + for (ref = init_expr->ref; ref; ref = ref->next) + { + /* Copy over the lhs _data component ref followed by the + full array reference for source expressions with rank. + Otherwise, just copy the _data component ref. */ + if (code->expr3->rank + && ref && ref->next && !ref->next->next) + { + rhs->ref = gfc_copy_ref (ref); + rhs->ref->next = gfc_copy_ref (ref->next); + break; + } + else if ((init_expr->rank && !code->expr3->rank + && ref && ref->next && !ref->next->next) + || (ref && !ref->next)) + { + rhs->ref = gfc_copy_ref (ref); + break; + } + } + } + /* Set the symbol to be artificial so that the result is not finalized. */ init_expr->symtree->n.sym->attr.artificial = 1; tmp = gfc_trans_assignment (init_expr, rhs, true, false, true, diff --git a/gcc/testsuite/gfortran.dg/pr113363.f90 b/gcc/testsuite/gfortran.dg/pr113363.f90 new file mode 100644 index 00000000000..7701539fdff --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr113363.f90 @@ -0,0 +1,86 @@ +! { dg-do run } +! Test the fix for comment 1 in PR113363, which failed as in comments below. +! Contributed by Harald Anlauf <anlauf@gcc.gnu.org> +program p + implicit none + class(*), allocatable :: x(:), y + character(*), parameter :: arr(2) = ["hello ","bye "], & + sca = "Have a nice day" + +! Bug was detected in polymorphic array function results + allocate(x, source = foo ()) + call check1 (x, arr) ! Wrong output "6 hello e" + deallocate (x) + x = foo () + call check1 (x, arr) ! Wrong output "0 " + associate (var => foo ()) ! OK after r14-9489-g3fd46d859cda10 + call check1 (var, arr) ! Now OK - outputs: "6 hello bye " + end associate + +! Check scalar function results ! All OK + allocate (y, source = bar()) + call check2 (y, sca) + deallocate (y) + y = bar () + call check2 (y, sca) + deallocate (y) + associate (var => bar ()) + call check2 (var, sca) + end associate + +! Finally variable expressions... + allocate (y, source = x(1)) ! Gave zero length here + call check2 (y, "hello") + y = x(2) ! Segfaulted here + call check2 (y, "bye ") + associate (var => x(2)) ! Gave zero length here + call check2 (var, "bye ") + end associate + +! ...and constant expressions ! All OK + deallocate(y) + allocate (y, source = "abcde") + call check2 (y, "abcde") + y = "hijklmnopq" + call check2 (y, "hijklmnopq") + associate (var => "mnopq") + call check2 (var, "mnopq") + end associate + deallocate (x, y) + +contains + + function foo() result(res) + class(*), allocatable :: res(:) + res = arr + end function foo + + function bar() result(res) + class(*), allocatable :: res + res = sca + end function bar + + subroutine check1 (x, carg) + class(*), intent(in) :: x(:) + character(*) :: carg(:) + select type (x) + type is (character(*)) +! print *, len(x), x + if (any (x .ne. carg)) stop 1 + class default + stop 2 + end select + end subroutine check1 + + subroutine check2 (x, carg) + class(*), intent(in) :: x + character(*) :: carg + select type (x) + type is (character(*)) +! print *, len(x), x + if (x .ne. carg) stop 3 + class default + stop 4 + end select + end subroutine check2 +end