From: Bernhard Reutner-Fischer <al...@gcc.gnu.org>
The openmp part will be cleaned up later in this series.
gcc/fortran/ChangeLog:
2017-10-22 Bernhard Reutner-Fischer <al...@gcc.gnu.org>
* match.h (gfc_match_defined_op_name): Adjust prototype and add
a parameter USER_OPERATOR.
* matchexp.c (gfc_match_defined_op_name): Use gfc_get_string and
return a user operator if USER_OPERATOR is true.
(match_defined_operator): Update calls to gfc_match_defined_op_name.
* interface.c (gfc_match_generic_spec): Likewise.
* openmp.c (gfc_match_omp_clauses): Likewise. Use gfc_get_string
where appropriate.
(gfc_match_omp_declare_reduction): Likewise.
---
gcc/fortran/interface.c | 5 +++--
gcc/fortran/match.h | 2 +-
gcc/fortran/matchexp.c | 18 ++++++++++++------
gcc/fortran/openmp.c | 31 +++++++++++++++++--------------
4 files changed, 33 insertions(+), 23 deletions(-)
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index f85c76bad0f..14137cebd6c 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -160,7 +160,8 @@ gfc_match_generic_spec (interface_type *type,
*op = INTRINSIC_NONE;
if (gfc_match (" operator ( ") == MATCH_YES)
{
- m = gfc_match_defined_op_name (buffer, 1);
+ const char *oper = NULL;
+ m = gfc_match_defined_op_name (oper, 1, 0);
if (m == MATCH_NO)
goto syntax;
if (m != MATCH_YES)
@@ -172,7 +173,7 @@ gfc_match_generic_spec (interface_type *type,
if (m != MATCH_YES)
return MATCH_ERROR;
- strcpy (name, buffer);
+ strcpy (name, oper);
*type = INTERFACE_USER_OP;
return MATCH_YES;
}
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 418542bd5a6..b3ced3f8454 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -315,7 +315,7 @@ match gfc_match_write (void);
match gfc_match_print (void);
/* matchexp.c. */
-match gfc_match_defined_op_name (char *, int);
+match gfc_match_defined_op_name (const char *&, int, bool);
match gfc_match_expr (gfc_expr **);
/* module.c. */
diff --git a/gcc/fortran/matchexp.c b/gcc/fortran/matchexp.c
index fb81e10a6c2..bb01af9f636 100644
--- a/gcc/fortran/matchexp.c
+++ b/gcc/fortran/matchexp.c
@@ -30,10 +30,14 @@ static const char expression_syntax[] = N_("Syntax error in
expression at %C");
/* Match a user-defined operator name. This is a normal name with a
few restrictions. The error_flag controls whether an error is
- raised if 'true' or 'false' are used or not. */
+ raised if 'true' or 'false' are used or not.
+ If USER_OPERATOR is true, a user operator is returned in RESULT
+ upon success.
+ */
match
-gfc_match_defined_op_name (char *result, int error_flag)
+gfc_match_defined_op_name (const char *&result, int error_flag,
+ bool user_operator)
{
static const char * const badops[] = {
"and", "or", "not", "eqv", "neqv", "eq", "ne", "ge", "le", "lt", "gt",
@@ -72,8 +76,10 @@ gfc_match_defined_op_name (char *result, int error_flag)
gfc_error ("Bad character %qc in OPERATOR name at %C", name[i]);
return MATCH_ERROR;
}
-
- strcpy (result, name);
+ if (user_operator)
+ result = gfc_get_string (".%s.", name);
+ else
+ result = gfc_get_string ("%s", name);
return MATCH_YES;
error:
@@ -91,10 +97,10 @@ error:
static match
match_defined_operator (gfc_user_op **result)
{
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ const char *name = NULL;
match m;
- m = gfc_match_defined_op_name (name, 0);
+ m = gfc_match_defined_op_name (name, 0, 0);
if (m != MATCH_YES)
return m;
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 94a7f7eaa50..a852fc490db 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -1581,6 +1581,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const
omp_mask mask,
{
gfc_omp_reduction_op rop = OMP_REDUCTION_NONE;
char buffer[GFC_MAX_SYMBOL_LEN + 3];
+ const char *op = NULL;
if (gfc_match_char ('+') == MATCH_YES)
rop = OMP_REDUCTION_PLUS;
else if (gfc_match_char ('*') == MATCH_YES)
@@ -1596,13 +1597,10 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const
omp_mask mask,
else if (gfc_match (".neqv.") == MATCH_YES)
rop = OMP_REDUCTION_NEQV;
if (rop != OMP_REDUCTION_NONE)
- snprintf (buffer, sizeof buffer, "operator %s",
+ op = gfc_get_string ("operator %s",
gfc_op2string ((gfc_intrinsic_op) rop));
- else if (gfc_match_defined_op_name (buffer + 1, 1) == MATCH_YES)
- {
- buffer[0] = '.';
- strcat (buffer, ".");
- }
+ else if (gfc_match_defined_op_name (op, 1, 1) == MATCH_YES)
+ ;
else if (gfc_match_name (buffer) == MATCH_YES)
{
gfc_symbol *sym;
@@ -1660,9 +1658,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const
omp_mask mask,
}
else
buffer[0] = '\0';
- gfc_omp_udr *udr
- = (buffer[0]
- ? gfc_find_omp_udr (gfc_current_ns, buffer, NULL) : NULL);
+ gfc_omp_udr *udr;
+ if (op != NULL)
+ udr = gfc_find_omp_udr (gfc_current_ns, op, NULL);
+ else if (buffer[0])
+ udr = gfc_find_omp_udr (gfc_current_ns, buffer, NULL);
+ else
+ udr = NULL;
gfc_omp_namelist **head = NULL;
if (rop == OMP_REDUCTION_NONE && udr)
rop = OMP_REDUCTION_USER;
@@ -1678,7 +1680,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const
omp_mask mask,
n = *head;
*head = NULL;
gfc_error_now ("!$OMP DECLARE REDUCTION %s not found "
- "at %L", buffer, &old_loc);
+ "at %L", op ? op : buffer, &old_loc);
gfc_free_omp_namelist (n);
}
else
@@ -2801,6 +2803,7 @@ gfc_match_omp_declare_reduction (void)
match m;
gfc_intrinsic_op op;
char name[GFC_MAX_SYMBOL_LEN + 3];
+ const char *oper = NULL;
auto_vec<gfc_typespec, 5> tss;
gfc_typespec ts;
unsigned int i;
@@ -2818,20 +2821,20 @@ gfc_match_omp_declare_reduction (void)
return MATCH_ERROR;
if (m == MATCH_YES)
{
- snprintf (name, sizeof name, "operator %s", gfc_op2string (op));
+ oper = gfc_get_string ("operator %s", gfc_op2string (op));
+ strcpy (name, oper);
rop = (gfc_omp_reduction_op) op;
}
else
{
- m = gfc_match_defined_op_name (name + 1, 1);
+ m = gfc_match_defined_op_name (oper, 1, 1);
if (m == MATCH_ERROR)
return MATCH_ERROR;
if (m == MATCH_YES)
{
- name[0] = '.';
- strcat (name, ".");
if (gfc_match (" : ") != MATCH_YES)
return MATCH_ERROR;
+ strcpy (name, oper);
}
else
{
--
2.19.0.rc1
