Dear all, this follow-up patch reduces the number of front-end memleaks that pop up during simplification of TRANSFER(), and adds the original testcase from the PR. The fix consists mainly of a reordering of the code in gfc_simplify_transfer, taking into account the knowledge of the rank of the result.
The changes to target-memory.cc could have been done differently, but these are also sensitive to the BOZ handling. The current solution was the simplest one I found that does not regress. Regression tested on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald
From a3a72f5b4872b870a1ec12a9f4792a3b3c769953 Mon Sep 17 00:00:00 2001 From: Harald Anlauf <[email protected]> Date: Sat, 24 Oct 2026 15:46:33 +0200 Subject: [PATCH] fortran: Fix front-end memleaks while simplifying TRANSFER [PR127892] The rank of the result of TRANSFER can be 0 or 1. Create the appropriate expression for array results directly, instead of a scalar constant expression and changing its type later, losing track of allocations of the value component. Do not double-mpfr-initialize scalar integer, real, or complex value components. PR fortran/127892 gcc/fortran/ChangeLog: * simplify.cc (gfc_simplify_transfer): Fix a GMP memleak. Reorganize the generation of the result expression so that its known rank is directly used. * target-memory.cc (gfc_target_interpret_expr): Use mpfr_clear / mpz_clear before reinitializing scalar numerical value components. gcc/testsuite/ChangeLog: * gfortran.dg/transfer_simplify_16.f90: New test. --- gcc/fortran/simplify.cc | 44 +++++---- gcc/fortran/target-memory.cc | 7 ++ .../gfortran.dg/transfer_simplify_16.f90 | 89 +++++++++++++++++++ 3 files changed, 122 insertions(+), 18 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/transfer_simplify_16.f90 diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc index 2a0bef67217..67a826a2301 100644 --- a/gcc/fortran/simplify.cc +++ b/gcc/fortran/simplify.cc @@ -9098,7 +9098,6 @@ gfc_simplify_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size) size_t source_size; size_t result_size; size_t buffer_size; - mpz_t tmp; unsigned char *buffer; size_t result_length; @@ -9115,12 +9114,33 @@ gfc_simplify_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size) return NULL; /* Calculate the size of the source. */ - if (source->expr_type == EXPR_ARRAY && !gfc_array_size (source, &tmp)) - gfc_internal_error ("Failure getting length of a constant array."); + if (source->expr_type == EXPR_ARRAY) + { + mpz_t tmp; + + if (!gfc_array_size (source, &tmp)) + gfc_internal_error ("Failure getting length of a constant array."); + mpz_clear (tmp); + } + + /* Set the number of elements in the result, and determine its size. */ + + if (mold->expr_type == EXPR_ARRAY || mold->rank || size) + { + result = gfc_get_array_expr (mold->ts.type, mold->ts.kind, + &source->where); + result->rank = 1; + result->shape = gfc_get_shape (1); + mpz_init_set_ui (result->shape[0], result_length); + } + else + { + /* Create an empty expression with the appropriate characteristics. */ + result = gfc_get_constant_expr (mold->ts.type, mold->ts.kind, + &source->where); + result->rank = 0; + } - /* Create an empty new expression with the appropriate characteristics. */ - result = gfc_get_constant_expr (mold->ts.type, mold->ts.kind, - &source->where); result->ts = mold->ts; mold_element = (mold->expr_type == EXPR_ARRAY && mold->value.constructor) @@ -9144,18 +9164,6 @@ gfc_simplify_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size) mold_element->value.character.length); } - /* Set the number of elements in the result, and determine its size. */ - - if (mold->expr_type == EXPR_ARRAY || mold->rank || size) - { - result->expr_type = EXPR_ARRAY; - result->rank = 1; - result->shape = gfc_get_shape (1); - mpz_init_set_ui (result->shape[0], result_length); - } - else - result->rank = 0; - /* Allocate the buffer to store the binary version of the source. */ buffer_size = MAX (source_size, result_size); buffer = (unsigned char*)alloca (buffer_size); diff --git a/gcc/fortran/target-memory.cc b/gcc/fortran/target-memory.cc index cf1bfa87950..cacb0591036 100644 --- a/gcc/fortran/target-memory.cc +++ b/gcc/fortran/target-memory.cc @@ -599,18 +599,25 @@ gfc_target_interpret_expr (unsigned char *buffer, size_t buffer_size, switch (result->ts.type) { case BT_INTEGER: + /* 'result->integer' is already mpz_initialized by the caller. */ + mpz_clear (result->value.integer); result->representation.length = gfc_interpret_integer (result->ts.kind, buffer, buffer_size, result->value.integer); break; case BT_REAL: + /* 'result->value.real' is already mpfr_initialized by the caller. */ + mpfr_clear (result->value.real); result->representation.length = gfc_interpret_float (result->ts.kind, buffer, buffer_size, result->value.real); break; case BT_COMPLEX: + /* 'result->value.complex' is already initialized by the caller. */ + mpfr_clear (mpc_realref (result->value.complex)); + mpfr_clear (mpc_imagref (result->value.complex)); result->representation.length = gfc_interpret_complex (result->ts.kind, buffer, buffer_size, result->value.complex); diff --git a/gcc/testsuite/gfortran.dg/transfer_simplify_16.f90 b/gcc/testsuite/gfortran.dg/transfer_simplify_16.f90 new file mode 100644 index 00000000000..5a582003737 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/transfer_simplify_16.f90 @@ -0,0 +1,89 @@ +! { dg-do compile } +! PR fortran/127892 +! +! The following code is taken from the LLVM testsuite on github. +! It used to trigger valgrind invalid reads, and exhibited several +! front-end memory leaks in gfortran while simplifying TRANSFER(). +! +! Tests folding of TRANSFER(...) when the physical representation of the +! result is longer than that of SOURCE. F2023 16.9.212 p.5 requires the +! leading part of the result's physical representation to be that of +! SOURCE, and requires TRANSFER(TRANSFER(E, D), E) to have the value of E +! for scalar D and E (and likewise TRANSFER(TRANSFER(E, D), E, SIZE(E)) +! when D is an array and E has rank one); the Examples paragraph's +! Case (ii) shows a trailing array element only partially covered by +! SOURCE. The remainder of the result beyond SOURCE's representation is +! processor dependent; flang zero-fills it (as already pinned for +! CHARACTER by fold-transfer.f90's test_i2c_s). +! Same-size and mold-shorter values are covered by fold-transfer.f90; +! this file pins the mold-longer cases. All checks are byte-order +! independent: the round trips prove the leading-part byte placement, +! and the two-endian .or. checks (idiom precedent: fold-transfer.f90's +! test_c2i_s) are portable value/zero-fill pins, not placement proofs. + +module m + ! Scalar MOLD longer than SOURCE: round trips (16.9.212 p.5), ... + logical, parameter :: test_rt_scalar = transfer(transfer(1_4, 0_8), 0_4) == 1_4 + logical, parameter :: test_rt_neg = transfer(transfer(-1_4, 0_8), 0_4) == -1_4 + logical, parameter :: test_rt_real = transfer(transfer(1.5, 0._8), 0.0) == 1.5 + ! ... and a portable leading-part + zero-fill value pin (either + ! byte order's correct value; placement is proven by the round trips) + integer(8), parameter :: w1 = transfer(1_4, 0_8) + logical, parameter :: test_lead_zfill = w1 == 1_8 .or. w1 == 4294967296_8 + + ! Rank-one results whose trailing element is only partially covered + ! by SOURCE, with and without SIZE= + integer(8), parameter :: via8(2) = transfer([1_4, 2_4, 3_4], 0_8, 2) + logical, parameter :: test_rt_array = all(transfer(via8, 0_4, 3) == [1_4, 2_4, 3_4]) + logical, parameter :: test_elem2_zfill = via8(2) == 3_8 .or. via8(2) == 12884901888_8 + integer(8), parameter :: via8b(*) = transfer([1_4, 2_4, 3_4], [0_8]) + logical, parameter :: test_rt_array2 = all(transfer(via8b, 0_4, 3) == [1_4, 2_4, 3_4]) + real(8), parameter :: rvia8(2) = transfer([1.5, 2.5, 3.5], 0._8, 2) + logical, parameter :: test_rt_real_arr = all(transfer(rvia8, 0.0, 3) == [1.5, 2.5, 3.5]) + + ! Rank-2 SOURCE: flattened, then the same trailing partial coverage + ! and zero fill as the rank-one cases + integer(8), parameter :: via8c(*) = transfer(reshape([1_4, 2_4, 3_4], [3, 1]), [0_8]) + logical, parameter :: test_rt_rank2 = all(transfer(via8c, 0_4, 3) == [1_4, 2_4, 3_4]) + logical, parameter :: test_rank2_zfill = via8c(2) == 3_8 .or. via8c(2) == 12884901888_8 + ! ... and with ORDER= so that array element order (1,4,2,5,3,6 here) + ! differs from the constructor's sequence, proving the flattening + ! order, plus a trailing element wholly beyond SOURCE + integer(4), parameter :: r2(2, 3) = reshape([1_4, 2_4, 3_4, 4_4, 5_4, 6_4], [2, 3], order=[2, 1]) + integer(8), parameter :: via8d(4) = transfer(r2, 0_8, 4) + logical, parameter :: test_rt_rank2b = all(transfer(via8d, 0_4, 8) == [1_4, 4_4, 2_4, 5_4, 3_4, 6_4, 0_4, 0_4]) + + ! The standard's own Case (ii) example (16.9.212 p.6): the second + ! element's real part has the value 3.3; its imaginary part is + ! processor dependent + complex, parameter :: cx(2) = transfer([1.1, 2.2, 3.3], [(0.0, 0.0)]) + logical, parameter :: test_case_ii = cx(1) == (1.1, 2.2) .and. real(cx(2)) == 3.3 + + ! Derived-type MOLD longer than SOURCE: the leading part is preserved + ! (observed portably via round trips); components at or beyond the end + ! of SOURCE's representation are zero-filled + type t1 + integer(8) :: a, b + end type + type(t1), parameter :: x1 = transfer([1_4, 2_4, 3_4], t1(0, 0)) ! b partially covered + logical, parameter :: test_derived_rt = all(transfer(x1, 0_4, 3) == [1_4, 2_4, 3_4]) + type(t1), parameter :: x2 = transfer(7_4, t1(-1, -1)) ! a partial, b wholly beyond + logical, parameter :: test_derived_lead = transfer(x2, 0_4) == 7_4 + logical, parameter :: test_derived_zero = x2%b == 0_8 + type(t1), parameter :: x4 = transfer(1_8, t1(-1, -1)) ! b exactly at the end + logical, parameter :: test_at_end = x4%a == 1_8 .and. x4%b == 0_8 + type t2 + integer(4) :: x + integer(4) :: y ! keeps c beyond a 4-byte SOURCE even where integer(8) has 4-byte alignment + integer(8) :: c(4) ! wholly beyond SOURCE's representation + end type + type(t2), parameter :: x3 = transfer(9_4, t2(0, 0, [0_8, 0_8, 0_8, 0_8])) + logical, parameter :: test_beyond = x3%x == 9_4 .and. x3%y == 0_4 .and. all(x3%c == 0_8) + + ! CHARACTER MOLD with elements beyond SOURCE: NUL fill + character(1), parameter :: ch(50) = transfer(1_8, 'x', 50) + character(8), parameter :: c8 = transfer('AB', 'xxxxxxxx') + logical, parameter :: test_char_rt = transfer(ch(1:8), 0_8) == 1_8 + logical, parameter :: test_char_zero = ichar(ch(9)) == 0 .and. ichar(ch(50)) == 0 + logical, parameter :: test_char_scalar = c8(1:2) == 'AB' .and. ichar(c8(3:3)) == 0 .and. ichar(c8(8:8)) == 0 +end -- 2.51.0
