Hello world,
the attached patches fix the name of the function argument to CO_REDUCE
to conform to Fortran 2018 instead of the TR.
This is a user-visible change, so I have put this both into changes.html
and porting_to.html.
Regression-tested. OK for trunk?
Best regards
Thomas
Author: Thomas Koenig
Date: 2021-11-07 15:38:35 +0100
Fix keyword name for co_reduce.
gcc/fortran/ChangeLog:
* intrinsic.c (add_subroutines): Change keyword "operator"
to the correct one, "operation".
* check.c (gfc_check_co_reduce): Change OPERATOR to
OPERATION in error messages.
gcc/testsuite/ChangeLog:
* gfortran.dg/co_reduce_2.f90: New test.
* gfortran.dg/coarray_collective_16.f90: Change OPERATOR
to OPERATION.
* gfortran.dg/coarray_collective_9.f90: Likewise.
Co-authored by: Steve Kargl
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 6ea6e136d4f..15772009af4 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -2265,7 +2265,7 @@ gfc_check_co_reduce (gfc_expr *a, gfc_expr *op, gfc_expr *result_image,
attr = gfc_expr_attr (op);
if (!attr.pure || !attr.function)
{
- gfc_error ("OPERATOR argument at %L must be a PURE function",
+ gfc_error ("OPERATION argument at %L must be a PURE function",
>where);
return false;
}
@@ -2292,7 +2292,7 @@ gfc_check_co_reduce (gfc_expr *a, gfc_expr *op, gfc_expr *result_image,
if (!formal || !formal->next || formal->next->next)
{
- gfc_error ("The function passed as OPERATOR at %L shall have two "
+ gfc_error ("The function passed as OPERATION at %L shall have two "
"arguments", >where);
return false;
}
@@ -2303,7 +2303,7 @@ gfc_check_co_reduce (gfc_expr *a, gfc_expr *op, gfc_expr *result_image,
if (!gfc_compare_types (>ts, >result->ts))
{
gfc_error ("The A argument at %L has type %s but the function passed as "
- "OPERATOR at %L returns %s",
+ "OPERATION at %L returns %s",
>where, gfc_typename (a), >where,
gfc_typename (>result->ts));
return false;
@@ -2311,7 +2311,7 @@ gfc_check_co_reduce (gfc_expr *a, gfc_expr *op, gfc_expr *result_image,
if (!gfc_compare_types (>ts, >sym->ts)
|| !gfc_compare_types (>ts, >next->sym->ts))
{
- gfc_error ("The function passed as OPERATOR at %L has arguments of type "
+ gfc_error ("The function passed as OPERATION at %L has arguments of type "
"%s and %s but shall have type %s", >where,
gfc_typename (>sym->ts),
gfc_typename (>next->sym->ts), gfc_typename (a));
@@ -2322,7 +2322,7 @@ gfc_check_co_reduce (gfc_expr *a, gfc_expr *op, gfc_expr *result_image,
|| formal->next->sym->attr.allocatable || formal->sym->attr.pointer
|| formal->next->sym->attr.pointer)
{
- gfc_error ("The function passed as OPERATOR at %L shall have scalar "
+ gfc_error ("The function passed as OPERATION at %L shall have scalar "
"nonallocatable nonpointer arguments and return a "
"nonallocatable nonpointer scalar", >where);
return false;
@@ -2330,21 +2330,21 @@ gfc_check_co_reduce (gfc_expr *a, gfc_expr *op, gfc_expr *result_image,
if (formal->sym->attr.value != formal->next->sym->attr.value)
{
- gfc_error ("The function passed as OPERATOR at %L shall have the VALUE "
+ gfc_error ("The function passed as OPERATION at %L shall have the VALUE "
"attribute either for none or both arguments", >where);
return false;
}
if (formal->sym->attr.target != formal->next->sym->attr.target)
{
- gfc_error ("The function passed as OPERATOR at %L shall have the TARGET "
+ gfc_error ("The function passed as OPERATION at %L shall have the TARGET "
"attribute either for none or both arguments", >where);
return false;
}
if (formal->sym->attr.asynchronous != formal->next->sym->attr.asynchronous)
{
- gfc_error ("The function passed as OPERATOR at %L shall have the "
+ gfc_error ("The function passed as OPERATION at %L shall have the "
"ASYNCHRONOUS attribute either for none or both arguments",
>where);
return false;
@@ -2352,7 +2352,7 @@ gfc_check_co_reduce (gfc_expr *a, gfc_expr *op, gfc_expr *result_image,
if (formal->sym->attr.optional || formal->next->sym->attr.optional)
{
- gfc_error ("The function passed as OPERATOR at %L shall not have the "
+ gfc_error ("The function passed as OPERATION at %L shall not have the "
"OPTIONAL attribute for either of the arguments", >where);
return false;
}
@@ -2383,14 +2383,14 @@ gfc_check_co_reduce (gfc_expr *a, gfc_expr *op, gfc_expr *result_image,
|| (formal_size2 && actual_size != formal_size2)))
{
gfc_error ("The character length of the A argument at %L and of the "
- "arguments of the OPERATOR at %L shall be the same",
+ "arguments of the OPERATION at %L shall be the