public inbox for fortran@gcc.gnu.org
 help / color / mirror / Atom feed
From: Bernhard Reutner-Fischer <rep.dot.nop@gmail.com>
To: fortran@gcc.gnu.org
Cc: Bernhard Reutner-Fischer <aldot@gcc.gnu.org>,	gcc-patches@gcc.gnu.org
Subject: [PATCH,FORTRAN 02/29] Use stringpool for gfc_match_defined_op_name()
Date: Wed, 05 Sep 2018 14:57:00 -0000	[thread overview]
Message-ID: <20180905145732.404-3-rep.dot.nop@gmail.com> (raw)
In-Reply-To: <CAC1BbcSJmqmQW7Zuv+6UQu0znbsVm85i3gP_y4Dny3czMCANgA@mail.gmail.com>

From: Bernhard Reutner-Fischer <aldot@gcc.gnu.org>

The openmp part will be cleaned up later in this series.

gcc/fortran/ChangeLog:

2017-10-22  Bernhard Reutner-Fischer  <aldot@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

  parent reply	other threads:[~2018-09-05 14:57 UTC|newest]

Thread overview: 94+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2015-12-01 12:55 [PATCH] Use gfc_add_*_component defines where appropriate Bernhard Reutner-Fischer
2015-12-01 12:55 ` [PATCH] Derive interface buffers from max name length Bernhard Reutner-Fischer
2015-12-01 14:52   ` Janne Blomqvist
2015-12-01 16:51     ` Bernhard Reutner-Fischer
2015-12-03  9:46       ` Janne Blomqvist
2016-06-18 19:46         ` Bernhard Reutner-Fischer
2017-10-19  8:03           ` Bernhard Reutner-Fischer
2017-10-20 22:46             ` Bernhard Reutner-Fischer
2017-10-21 15:18               ` Thomas Koenig
2017-10-21 18:11                 ` Bernhard Reutner-Fischer
2017-10-31 20:35                   ` Bernhard Reutner-Fischer
2018-09-03 16:05                     ` Bernhard Reutner-Fischer
2018-09-05 14:57                       ` [PATCH,FORTRAN 04/29] Use stringpool for gfc_match_generic_spec Bernhard Reutner-Fischer
2018-09-05 14:57                       ` Bernhard Reutner-Fischer [this message]
2018-09-05 14:57                       ` [PATCH,FORTRAN 01/29] gdbinit: break on gfc_internal_error Bernhard Reutner-Fischer
2021-10-29 18:58                         ` Bernhard Reutner-Fischer
2021-10-29 22:13                           ` Jerry D
2021-10-30 18:25                             ` Bernhard Reutner-Fischer
2018-09-05 14:57                       ` [PATCH,FORTRAN 06/29] Use stringpool for association_list Bernhard Reutner-Fischer
2018-09-05 14:57                       ` [PATCH,FORTRAN 09/29] Use stringpool for modules Bernhard Reutner-Fischer
2018-09-05 18:44                         ` Janne Blomqvist
2018-09-05 20:59                           ` Bernhard Reutner-Fischer
2018-09-05 14:57                       ` [PATCH,FORTRAN 00/29] Move towards stringpool, part 1 Bernhard Reutner-Fischer
2018-09-05 18:57                         ` Janne Blomqvist
2018-09-07  8:09                           ` Bernhard Reutner-Fischer
2018-09-19 14:40                             ` Bernhard Reutner-Fischer
2023-04-13 21:04                               ` Bernhard Reutner-Fischer
     [not found]                         ` <cba81495-832c-2b95-3c30-d2ef819ea9fb@charter.net>
     [not found]                           ` <CAC1BbcThL4Cj=mVRuGg2p8jUipwLOeosB7kwoVD27myRnKcgZA@mail.gmail.com>
2021-04-18 21:30                             ` Bernhard Reutner-Fischer
2018-09-05 14:57                       ` [PATCH,FORTRAN 07/29] Use stringpool for some gfc_code2string return values Bernhard Reutner-Fischer
2018-09-05 14:57                       ` [PATCH,FORTRAN 13/29] Use stringpool for intrinsics and common Bernhard Reutner-Fischer
2018-09-05 14:57                       ` [PATCH,FORTRAN 08/29] Add uop/name helpers Bernhard Reutner-Fischer
2018-09-05 14:57                       ` [PATCH,FORTRAN 03/29] Use stringpool for gfc_get_name Bernhard Reutner-Fischer
2018-09-05 14:58                       ` [PATCH,FORTRAN 23/29] Use stringpool for module binding_label Bernhard Reutner-Fischer
2018-09-05 14:58                       ` [PATCH,FORTRAN 29/29] PR87103: Remove max symbol length check from gfc_new_symbol Bernhard Reutner-Fischer
2018-09-05 14:58                       ` [PATCH,FORTRAN 27/29] Use stringpool for OMP clause reduction code Bernhard Reutner-Fischer
2018-09-05 14:58                       ` [PATCH,FORTRAN 10/29] Do not copy name for check_function_name Bernhard Reutner-Fischer
2018-09-05 14:58                       ` [PATCH,FORTRAN 21/29] Use stringpool for module tbp Bernhard Reutner-Fischer
2018-09-05 14:58                       ` [PATCH,FORTRAN 25/29] Use stringpool on loading module symbols Bernhard Reutner-Fischer
2018-09-19 22:55                         ` [PATCH,FORTRAN v2] " Bernhard Reutner-Fischer
2018-09-05 14:58                       ` [PATCH,FORTRAN 05/29] Use stringpool for gfc_match("%n") Bernhard Reutner-Fischer
2018-09-05 14:58                       ` [PATCH,FORTRAN 14/29] Fix write_omp_udr for user-operator REDUCTIONs Bernhard Reutner-Fischer
2018-09-05 14:58                       ` [PATCH,FORTRAN 22/29] Use stringpool in class and procedure-pointer result Bernhard Reutner-Fischer
2018-09-05 14:58                       ` [PATCH,FORTRAN 24/29] Use stringpool for intrinsic functions Bernhard Reutner-Fischer
2018-09-05 14:58                       ` [PATCH,FORTRAN 11/29] Do pointer comparison instead of strcmp Bernhard Reutner-Fischer
2018-09-05 14:58                       ` [PATCH,FORTRAN 26/29] Use stringpool for mangled common names Bernhard Reutner-Fischer
2018-09-05 14:58                       ` [PATCH,FORTRAN 12/29] Use stringpool for remaining names Bernhard Reutner-Fischer
2018-09-05 15:02                       ` [PATCH,FORTRAN 28/29] Free type-bound procedure structs Bernhard Reutner-Fischer
2021-10-29  0:05                         ` Bernhard Reutner-Fischer
2021-10-29 14:54                           ` Jerry D
2021-10-29 16:42                             ` Bernhard Reutner-Fischer
     [not found]                           ` <slhifq$rlb$1@ciao.gmane.io>
2021-10-29 20:09                             ` Bernhard Reutner-Fischer
2021-10-31 22:35                               ` Bernhard Reutner-Fischer
2018-09-05 15:02                       ` [PATCH,FORTRAN 20/29] Use stringpool in class et al Bernhard Reutner-Fischer
2018-09-05 15:02                       ` [PATCH,FORTRAN 16/29] Do pointer comparison in iso_c_binding_module Bernhard Reutner-Fischer
2018-09-05 15:02                       ` [PATCH,FORTRAN 15/29] Use stringpool for iso_c_binding module names Bernhard Reutner-Fischer
2018-09-05 15:02                       ` [PATCH,FORTRAN 19/29] Use stringpool and unified uppercase handling for types Bernhard Reutner-Fischer
2018-09-05 15:02                       ` [PATCH,FORTRAN 18/29] Use stringpool for charkind Bernhard Reutner-Fischer
2018-09-05 15:02                       ` [PATCH,FORTRAN 17/29] Use stringpool for iso_fortran_env Bernhard Reutner-Fischer
2015-12-01 12:55 ` [PATCH] Commentary typo fix for gfc_typenode_for_spec() Bernhard Reutner-Fischer
2015-12-01 16:00   ` Steve Kargl
2016-06-18 20:07     ` Bernhard Reutner-Fischer
2015-12-01 12:56 ` [PATCH] RFC: Use Levenshtein spelling suggestions in Fortran FE Bernhard Reutner-Fischer
2015-12-01 15:02   ` Steve Kargl
2015-12-01 16:13     ` Bernhard Reutner-Fischer
2015-12-01 16:41       ` Steve Kargl
2015-12-01 17:35         ` Bernhard Reutner-Fischer
2015-12-01 19:49           ` Steve Kargl
2015-12-01 17:28   ` David Malcolm
2015-12-01 17:51     ` Bernhard Reutner-Fischer
2015-12-01 17:58       ` David Malcolm
2015-12-01 20:00         ` Steve Kargl
2015-12-03  9:29       ` Janne Blomqvist
2015-12-03 13:53         ` Mikael Morin
2015-12-04  0:08           ` Steve Kargl
2015-12-05 19:53   ` Mikael Morin
2015-12-09  1:07     ` [PATCH] v2 " David Malcolm
2015-12-10 16:15       ` Tobias Burnus
2015-12-22 13:57         ` Fortran release notes (was: [PATCH] v2 ...) Gerald Pfeifer
2015-12-12 17:02       ` [PATCH] v2 Re: [PATCH] RFC: Use Levenshtein spelling suggestions in Fortran FE Bernhard Reutner-Fischer
2015-12-27 21:43   ` [PATCH, RFC, v2] " Bernhard Reutner-Fischer
2016-03-05 22:46     ` [PATCH, fortran, v3] " Bernhard Reutner-Fischer
2016-03-07 14:57       ` David Malcolm
2016-04-23 18:22         ` Bernhard Reutner-Fischer
2016-04-25 17:07           ` David Malcolm
2016-06-18 19:59             ` [PATCH, fortran, v4] " Bernhard Reutner-Fischer
2016-06-20 10:26               ` VandeVondele  Joost
2016-07-03 22:46               ` Ping: [Re: [PATCH, fortran, v4] Use Levenshtein spelling suggestions in Fortran FE] Bernhard Reutner-Fischer
2016-07-04  3:31                 ` Jerry DeLisle
2016-07-04  5:03                   ` Janne Blomqvist
2017-10-19  7:26                     ` Bernhard Reutner-Fischer
2017-10-19  7:51               ` [PATCH, fortran, v4] Use Levenshtein spelling suggestions in Fortran FE Bernhard Reutner-Fischer
2016-06-18 19:47 ` [PATCH] Use gfc_add_*_component defines where appropriate Bernhard Reutner-Fischer
2016-06-19  9:18   ` Paul Richard Thomas
2016-06-19 10:39     ` Bernhard Reutner-Fischer

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20180905145732.404-3-rep.dot.nop@gmail.com \
    --to=rep.dot.nop@gmail.com \
    --cc=aldot@gcc.gnu.org \
    --cc=fortran@gcc.gnu.org \
    --cc=gcc-patches@gcc.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).