From ee65440cbd8042a5e5885e18bde70f8d530e4404 Mon Sep 17 00:00:00 2001
From: Paul Thomas <pault@gcc.gnu.org>
Date: Wed, 9 Apr 2025 09:50:04 +0100
Subject: 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.
---
 gcc/fortran/iresolve.cc | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

(limited to 'gcc/fortran/iresolve.cc')

diff --git a/gcc/fortran/iresolve.cc b/gcc/fortran/iresolve.cc
index 8189d7a..858ffb1 100644
--- a/gcc/fortran/iresolve.cc
+++ b/gcc/fortran/iresolve.cc
@@ -2417,7 +2417,7 @@ generate_reduce_op_wrapper (gfc_expr *op)
   gfc_symbol *operation = op->symtree->n.sym;
   gfc_symbol *wrapper, *a, *b, *c;
   gfc_symtree *st;
-  char tname[GFC_MAX_SYMBOL_LEN+1];
+  char tname[2 * GFC_MAX_SYMBOL_LEN + 2];
   char *name;
   gfc_namespace *ns;
   gfc_expr *e;
@@ -2462,7 +2462,7 @@ generate_reduce_op_wrapper (gfc_expr *op)
   a->attr.flavor = FL_VARIABLE;
   a->attr.dummy = 1;
   a->attr.artificial = 1;
-  a->attr.intent = INTENT_INOUT;
+  a->attr.intent = INTENT_IN;
   wrapper->formal = gfc_get_formal_arglist ();
   wrapper->formal->sym = a;
   gfc_set_sym_referenced (a);
@@ -2476,7 +2476,7 @@ generate_reduce_op_wrapper (gfc_expr *op)
   b->attr.dummy = 1;
   b->attr.optional= 1;
   b->attr.artificial = 1;
-  b->attr.intent = INTENT_INOUT;
+  b->attr.intent = INTENT_IN;
   wrapper->formal->next = gfc_get_formal_arglist ();
   wrapper->formal->next->sym = b;
   gfc_set_sym_referenced (b);
-- 
cgit v1.1