From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 68240 invoked by alias); 5 Sep 2018 14:57:52 -0000 Mailing-List: contact fortran-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Subscribe: List-Post: List-Help: , Sender: fortran-owner@gcc.gnu.org Received: (qmail 68045 invoked by uid 89); 5 Sep 2018 14:57:50 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-25.9 required=5.0 tests=AWL,BAYES_00,FREEMAIL_FROM,GIT_PATCH_0,GIT_PATCH_1,GIT_PATCH_2,GIT_PATCH_3,RCVD_IN_DNSWL_NONE,SPF_PASS autolearn=ham version=3.3.2 spammy=H*Ad:U*aldot, controls, snprintf, HContent-Transfer-Encoding:8bit X-HELO: mail-wr1-f53.google.com Received: from mail-wr1-f53.google.com (HELO mail-wr1-f53.google.com) (209.85.221.53) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 05 Sep 2018 14:57:49 +0000 Received: by mail-wr1-f53.google.com with SMTP id a108-v6so7956230wrc.13; Wed, 05 Sep 2018 07:57:48 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; bh=b43019+o4AyHiKWxxvwpqi1qjWkBPZ+58CVcWb9ArC4=; b=U7LzijwOHuhKa0yiwYUcfd0EfVXS1tB9HX8WnzlhPNxgDgqbFIF5AqSucwOdsNBhUt +qsHOus+vThJ5B1SbRNY/e5fQm4MlVNwNhZUSy+9fSBB1gOQs5yUTyJLJ11dpUxRPeTC 32FYZMzXWcQ9r7H0JyIB3E9FUNzefbzYQw3GcfcBA5n6ZEIMTi9u/OXvcIql4sFozhSP 5ULvSLonkm9xvPAMuip1ESZjPDQSmCBN3r1OONK2GM/1IobgHof1MLT/1IHWLzG6Bssv yIfrjF58/KBhCldZj2ljmWBhe/iLS4RmDxFqiMuTLbg60UC+BsT6Jd+xYeNag0yxLUTq OuTw== Return-Path: Received: from s46.loc (91-119-125-11.dsl.dynamic.surfer.at. [91.119.125.11]) by smtp.gmail.com with ESMTPSA id e133-v6sm4265684wma.33.2018.09.05.07.57.45 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 05 Sep 2018 07:57:45 -0700 (PDT) Received: from cow by s46.loc with local (Exim 4.91) (envelope-from ) id 1fxZFX-00007J-H2; Wed, 05 Sep 2018 14:57:43 +0000 From: Bernhard Reutner-Fischer To: fortran@gcc.gnu.org Cc: Bernhard Reutner-Fischer , 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 Message-Id: <20180905145732.404-3-rep.dot.nop@gmail.com> In-Reply-To: References: MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-IsSubscribed: yes X-SW-Source: 2018-09/txt/msg00024.txt.bz2 From: Bernhard Reutner-Fischer The openmp part will be cleaned up later in this series. gcc/fortran/ChangeLog: 2017-10-22 Bernhard Reutner-Fischer * 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 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