From ee65440cbd8042a5e5885e18bde70f8d530e4404 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Wed, 9 Apr 2025 09:50:04 +0100 Subject: Fortran: Fix some problems with the reduce intrinsic [PR119460] 2025-04-09 Paul Thomas and Harald Anlauf gcc/fortran PR fortran/119460 * iresolve.cc (generate_reduce_op_wrapper): Increase the size of 'tname'. Change intent of 'a' and 'b' to intent_in. * trans-decl.cc (add_argument_checking): Do not test artificial formal symbols. * trans-expr.cc (gfc_conv_procedure_call): Remove reduce_scalar and the blocks triggered by it. * trans-intrinsic.cc (gfc_conv_intrinsic_function): Set the result of non-character, scalar reduce to be allocatable. gcc/testsuite/ PR fortran/119460 * gfortran.dg/reduce_2.f90: Add test to check that deferred len characters cannot slip through. * gfortran.dg/reduce_3.f90: New test * gfortran.dg/reduce_4.f90: New test libgfortran/ PR libfortran/119460 * intrinsics/reduce.c (reduce): Correct error message about mismatch between dim and the rank of array. Output the values of both. Correct the evaluation of the result stride and extent. (reduce_scalar): The front end treats the result as an allocatable so eliminate memcpy and free. Return the base-addr of the local descriptor. (reduce_c): Correct the type of the string lengths. (reduce_scalar_c): Correct the type of the string lengths.Test to see if 'res' is allocated. If not then return the base_addr of the local descriptor. --- gcc/fortran/trans-expr.cc | 24 ------------------------ 1 file changed, 24 deletions(-) (limited to 'gcc/fortran/trans-expr.cc') diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 4b90b06..6ece39b 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -6753,12 +6753,6 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, gfc_intrinsic_sym *isym = expr && expr->rank ? expr->value.function.isym : NULL; - /* In order that the library function for intrinsic REDUCE be type and kind - agnostic, the result is passed by reference. Allocatable components are - handled within the OPERATION wrapper. */ - bool reduce_scalar = expr && !expr->rank && expr->value.function.isym - && expr->value.function.isym->id == GFC_ISYM_REDUCE; - comp = gfc_get_proc_ptr_comp (expr); bool elemental_proc = (comp @@ -8596,16 +8590,6 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, else if (ts.type == BT_CHARACTER) vec_safe_push (retargs, len); } - else if (reduce_scalar) - { - /* In order that the library function for intrinsic REDUCE be type and - kind agnostic, the result is passed by reference. Allocatable - components are handled within the OPERATION wrapper. */ - type = gfc_typenode_for_spec (&expr->ts); - result = gfc_create_var (type, "sr"); - tmp = gfc_build_addr_expr (pvoid_type_node, result); - vec_safe_push (retargs, tmp); - } gfc_free_interface_mapping (&mapping); @@ -8821,14 +8805,6 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, gfc_add_expr_to_block (&se->pre, tmp); } } - else if (reduce_scalar) - { - /* Even though the REDUCE intrinsic library function returns the result - by reference, the scalar call passes the result as se->expr. */ - gfc_add_expr_to_block (&se->pre, se->expr); - se->expr = result; - gfc_add_block_to_block (&se->post, &post); - } else { /* For a function with a class array result, save the result as -- cgit v1.1