Hi Paul,
what do want us to do with it?
Let me give an early review:
In gfc_resolve_reduce, I think you duplicate the test for the function having
optional formal arguments. Ones in this block:
+ if (formal->sym->attr.allocatable || formal->sym->attr.allocatable
+ || formal->sym->attr.pointer || formal->sym->attr.pointer
+ || formal->sym->attr.optional || formal->sym->attr.optional
+ || formal->sym->ts.type == BT_CLASS || formal->sym->ts.type == BT_CLASS)
+ {
+ gfc_error ("Each argument of OPERATION at %L shall be a scalar, "
+ "non-allocatable, non-pointer, non-polymorphic and "
+ "nonoptional", &operation->where);
+ return false;
+ }
and then again (in the third next if) in:
+ if (formal->sym->attr.optional || formal->next->sym->attr.optional)
+ {
+ gfc_error ("The function passed as OPERATION at %L shall not have the "
+ "OPTIONAL attribute for either of the arguments",
+ &operation->where);
+ return false;
+ }
Testing ones should be enough, right?
I don't like the code repetition in
+ if (array->ts.type == BT_CHARACTER)
+ {
+ gfc_charlen *cl;
+ unsigned long actual_size, formal_size1, formal_size2, result_size;
+
+ cl = array->ts.u.cl;
+ actual_size = cl && cl->length && cl->length->expr_type == EXPR_CONSTANT
+ ? mpz_get_ui (cl->length->value.integer) : 0;
+
+ cl = formal->sym->ts.u.cl;
+ formal_size1 = cl && cl->length && cl->length->expr_type == EXPR_CONSTANT
+ ? mpz_get_ui (cl->length->value.integer) : 0;
+
+ cl = formal->next->sym->ts.u.cl;
+ formal_size2 = cl && cl->length && cl->length->expr_type == EXPR_CONSTANT
+ ? mpz_get_ui (cl->length->value.integer) : 0;
+
+ cl = sym->ts.u.cl;
+ result_size = cl && cl->length && cl->length->expr_type == EXPR_CONSTANT
+ ? mpz_get_ui (cl->length->value.integer) : 0;
+
either use function for evaluating the constant cl or how about this modern C++:
+ if (array->ts.type == BT_CHARACTER)
+ {
+ unsigned long actual_size, formal_size1, formal_size2, result_size;
+ auto get_cst_cl = [](const gfc_charlen *cl) -> unsigned log {
+ return cl && cl->length && cl->length->expr_type == EXPR_CONSTANT
+ ? mpz_get_ui (cl->length->value.integer) : 0;
+ };
+
+ actual_size = get_cst_cl (array->ts.u.cl);
+
+ formal_size1 = get_cst_cl (formal->sym->ts.u.cl);
+
+ formal_size2 = get_cst_cl (formal->next->sym->ts.u.cl);
+
+ result_size = get_cst_cl (sym->ts.u.cl);
I think the above is easier to maintain and read. Whether you use the lambda or
a dedicated function I leave to your liking.
In
+static gfc_symtree *
+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 *name;
+ gfc_namespace *ns;
+// gfc_gsymbol *gsym = NULL;
^^^ Is this needed?
@@ -8785,6 +8801,12 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
gfc_add_expr_to_block (&se->pre, tmp);
}
}
+ else if (scalar_reduce)
+ {
+ gfc_add_expr_to_block (&se->pre, se->expr);
+ se->expr = result;
+// gfc_add_block_to_block (&se->post, &post);
^^^ I'd rather uncomment it to be safe in the future, if something is in post.
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -4250,6 +4250,20 @@ gfc_get_symbol_for_expr (gfc_expr * expr, bool
ignore_optional) sym->attr.proc = PROC_INTRINSIC;
sym->attr.flavor = FL_PROCEDURE;
sym->result = sym;
+#if 0
+ if (expr->value.function.isym
+ && expr->value.function.isym->id == GFC_ISYM_REDUCE)
+ {
+ if (expr->value.function.actual
+ && expr->value.function.actual->next
+ && expr->value.function.actual->next->next
+ && expr->value.function.actual->next->next->expr == NULL)
+ expr->rank = 0;
+ else if (expr->value.function.actual
+ && expr->value.function.actual->expr)
+ expr->rank = expr->value.function.actual->expr->rank - 1;
+ }
+#endif
Er?
Typo in Change.Logs
s/discription/description/
That Changelog looks non-standard.
Ok, I hope this first feedback is valuable to you.
One other question: How does REDUCE() relate to CO_REDUCE()?
Regards,
Andre
On Sun, 2 Mar 2025 20:41:55 +0000
Paul Richard Thomas <paul.richard.tho...@gmail.com> wrote:
> Hi All,
>
> This is very much an early version of the F2018 REDUCE intrinsic. I am
> posting it now because I have totally forgotten how to include new
> functions in libgfortran.so. -static-libfortran works fine and the results
> are the same as the other brands.
>
> At present, it produces several of link warnings.
> test_reduce.f90:23:2: warning: type of ‘_gfortran_reduce_scalar’ does not
> match original declaration [-Wlto-type-mismatch]
> 23 | pure function add(i,j) result(sum_ij)
> | ^
> test_reduce.f90:23:2: note: return value type mismatch
> test_reduce.f90:23:2: note: type ‘struct s’ should match type ‘int’
> test_reduce.f90:23:2: note: ‘_gfortran_reduce_scalar’ was previously
> declared here
> test_reduce.f90:23:2: note: code may be misoptimized unless
> ‘-fno-strict-aliasing’ is used
> /usr/bin/ld: warning: /tmp/ccfEUYXA.ltrans0.ltrans.o: requires executable
> stack (because the .note.GNU-stack section is executable)
>
> The last one is unavoidable because of the use of the wrapper for
> 'operation' that allows type agnostic use of pointer arithmetic in the
> library functions. I am working on the type mismatch, which occurs when
> different wrapper types appear in the same namespace.
>
> Clearly there is a fair amount to do: clear the commented out
> sections/lines, testcases and documentation.
>
> Paul
--
Andre Vehreschild * Email: vehre ad gmx dot de
