Fortran: Fix some problems with the reduce intrinsic [PR119460]

2025-04-09  Paul Thomas  <pault@gcc.gnu.org>
	    and Harald Anlauf  <anlauf@gcc.gnu.org>

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.

1 files changed, 0 insertions, 24 deletions

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