From patchwork Wed Sep 5 14:57:04 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Bernhard Reutner-Fischer X-Patchwork-Id: 966422 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-485219-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="TrKT4ldV"; dkim=pass (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="MWdnvACF"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4256Jr4Fy3z9sCn for ; Thu, 6 Sep 2018 00:58:20 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; q=dns; s=default; b=VOu iWvBkI/frWEzutpI9VE3ckPMyZuNo3nMtiAQnXBWfo79WVbHoHsY3WlnAndYib3q jnhob7E+mrsVhQOj1oDTo/YpRCjA+YA36pWVfG+bTko/NEjf9U6O4mcSMIHXAq90 tm+CZzrpMicsE8SMIrTkLvzJn88o/HsK6BDwASQk= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; s=default; bh=ZSAFMmQTN iPbkNm0vvfpEqf7ets=; b=TrKT4ldVGr5TRZTfyjV/Ksiax5qCbBQu3QLfDxSi0 pV70Y7zuwB4Aed6+o8EDKZ6msBbx9Z5EVqfZtNqKkQVl1jASvkRUQN1MZJSe7Dw8 2dX7zDAKqVQ8XXqZT9DwisY/eQWdtUedXgAqmmJrwyTfrCvSR7Z3WY0yISqb8lm/ 6o= Received: (qmail 68016 invoked by alias); 5 Sep 2018 14:57:50 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 67975 invoked by uid 89); 5 Sep 2018 14:57:49 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.9 required=5.0 tests=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, complaints, HContent-Transfer-Encoding:8bit X-HELO: mail-wm0-f45.google.com Received: from mail-wm0-f45.google.com (HELO mail-wm0-f45.google.com) (74.125.82.45) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 05 Sep 2018 14:57:48 +0000 Received: by mail-wm0-f45.google.com with SMTP id y2-v6so8334330wma.1; 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=Kdymvr/EsF6JaRycYOCvrfc/5/8c/uVupit1q71LyIQ=; b=MWdnvACFg5yhraQi0m0XKHShbJEw0xjR8m1AeqsgSDI/IuP8AjqNi1oxsxok522zTh ybAnzs5tHiV/yzcahPF7YNDQxHu4xsH6uj1Gv4rTk5RdIq8F/jIlYjF9oibzvb+psC+B v7+cxDVB4TBWpsZteIoljJHiHZQzXOO1n6BzQRPguHXPsMIwl3WwemlrhoU6Nextzv9X Iz8Wg4ybTaVm4rFN4bVAGQNuJYNZX0yHlYQmF6Iw2FTTabM7vhCWiDHivsjowDOjY8lK schzSTqdEOozQG4cXjcq4oPAZHfyjsvTU4oWSASTVqR9FmHSX2SnL9aNeht4vWyqG3qe Bq0Q== Received: from s46.loc (91-119-125-11.dsl.dynamic.surfer.at. [91.119.125.11]) by smtp.gmail.com with ESMTPSA id c10-v6sm4942232wrb.17.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-00007H-Cl; 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 01/29] gdbinit: break on gfc_internal_error Date: Wed, 5 Sep 2018 14:57:04 +0000 Message-Id: <20180905145732.404-2-rep.dot.nop@gmail.com> In-Reply-To: References: MIME-Version: 1.0 X-IsSubscribed: yes From: Bernhard Reutner-Fischer Aids debugging the fortran FE. gcc/ChangeLog: 2017-11-12 Bernhard Reutner-Fischer * gdbinit.in: Break on gfc_internal_error. --- gcc/gdbinit.in | 1 + 1 file changed, 1 insertion(+) diff --git a/gcc/gdbinit.in b/gcc/gdbinit.in index 4db977f0bab..ac4d7c42e21 100644 --- a/gcc/gdbinit.in +++ b/gcc/gdbinit.in @@ -227,6 +227,7 @@ b fancy_abort # Put a breakpoint on internal_error to help with debugging ICEs. b internal_error +b gfc_internal_error set complaints 0 # Don't let abort actually run, as it will make From patchwork Wed Sep 5 14:57:05 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Bernhard Reutner-Fischer X-Patchwork-Id: 966424 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-485221-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="NMyfqgUC"; dkim=pass (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="U7LzijwO"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4256KX0f1vz9sCn for ; Thu, 6 Sep 2018 00:58:55 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; q=dns; s=default; b=tYr C7eCRorzk9djGNaCI46BFEY837mA3uY33gHNelWzzYq2RKBHsH6Cnm3X/r5ApMuQ 7clTKliA0HlOnZdhd9qls+e3YpSPqV/Ilva33baLaKUeiqasRomyV0Daqqb3g4M9 YEbeTX+DIFw7JIAbAm35kNSoKwhw1Ah6n3C7CTeQ= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; s=default; bh=AVrEKHG69 ngaUFQ3uo8hAJhrqGI=; b=NMyfqgUCcU7n4U1lc2aEHGJEMKOU3PuNYoq0evJxQ 1yA110BXDt1nB9CB1H/gjoSoZLhv/GP6WW5uEGa6WZ/sEv70X4rl+16LI34cgJZi 0BrGE2C7fcEibWdo0JIW1zAHj8Yrv4AS+xVXdtlYHgqcpN+kIgO7VR+oQuKcN7K3 PE= Received: (qmail 68239 invoked by alias); 5 Sep 2018 14:57:52 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@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== 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, 5 Sep 2018 14:57:05 +0000 Message-Id: <20180905145732.404-3-rep.dot.nop@gmail.com> In-Reply-To: References: MIME-Version: 1.0 X-IsSubscribed: yes 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 { From patchwork Wed Sep 5 14:57:06 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Bernhard Reutner-Fischer X-Patchwork-Id: 966431 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-485227-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="Bf6gZLAN"; dkim=pass (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="n4D9dK5L"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4256NB3Lwjz9sCn for ; Thu, 6 Sep 2018 01:01:13 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; q=dns; s=default; b=o5g xZ2i78WC7idgxsRyAXv7NgVZrVkiBJL5aOBvlYjekzjXCgWT28etFPvE3o7bj1Xr F2Lv9VL4D5zq/Yz5KsmI++nX3Ko30ErlXEBqJm4u3qi/+dEjjVxkffMSHqt0T2Tu rYdcegCOmnZQ8oLX2mIxbxsmShcdq3eCBoW1q31c= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; s=default; bh=UgnEEyoXr baDjLcM/aM4yvKoQBk=; b=Bf6gZLANSySF8+XyjD3gJZJf+CPkZHwSPzoW4rzBF 3nMSw6Oaef5eBLgDa1h6GFKFWyxxOTQO4pn+IeyrjwVU3P3ZFDBw+e5D7MP0Zq72 6NKt1wB/D88QMgsWxlVMJf+GQG0TkksOCLCjFiWc9ZQIzXM3W5IuhnSmGomCgJH/ ZM= Received: (qmail 68939 invoked by alias); 5 Sep 2018 14:57:57 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 68567 invoked by uid 89); 5 Sep 2018 14:57:55 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.7 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=FILL, Better, non-standard, nonstandard X-HELO: mail-wm0-f41.google.com Received: from mail-wm0-f41.google.com (HELO mail-wm0-f41.google.com) (74.125.82.41) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 05 Sep 2018 14:57:51 +0000 Received: by mail-wm0-f41.google.com with SMTP id r1-v6so11998076wmh.0; Wed, 05 Sep 2018 07:57:50 -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=9RXrPzg00jijJTQl7AnsJ0PofFtl86Iw4eqb7UdheVQ=; b=n4D9dK5L5gjmWirGpnAUbo6gINYFXpSm/m8bkwTdhZ5Y/2MWgk7wEogB5aYXXB7J9g vfB4HO111LcsBej+1d53ddLvK0z/ZBbujrog+mKQhNrC8ynD7Z9Iei22wUdqH2/gAS9g 1mL5WNcoFL/GiCdSctayfQ5VBeBELBdEfJ9+3mBdegzHajMFg3jGtvSBg5lesrv2akTK yf8o8+KndPABhOfdmE5dFxe3n08FQfz4AedBauWgijB3OpMkAP1P1jl2FhxixECZHRM4 B+ZRI5bobBLGch5AhDS8nbNVeGqnhzi+SzlIcM9Yv1O8V06WSQvsfZ56gtBwq0N+KPSq /TPg== Received: from s46.loc (91-119-125-11.dsl.dynamic.surfer.at. [91.119.125.11]) by smtp.gmail.com with ESMTPSA id g2-v6sm3239394wrd.71.2018.09.05.07.57.45 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 05 Sep 2018 07:57:46 -0700 (PDT) Received: from cow by s46.loc with local (Exim 4.91) (envelope-from ) id 1fxZFX-00007L-Lw; 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 03/29] Use stringpool for gfc_get_name Date: Wed, 5 Sep 2018 14:57:06 +0000 Message-Id: <20180905145732.404-4-rep.dot.nop@gmail.com> In-Reply-To: References: MIME-Version: 1.0 X-IsSubscribed: yes From: Bernhard Reutner-Fischer Occurrences of name2 in this patch will be fixed later in this series. gcc/fortran/ChangeLog: 2017-10-23 Bernhard Reutner-Fischer * match.h (gfc_match_name): Pass argument by reference. Adjust all callers. (match_common_name): Likewise. * match.c (gfc_match_name): Set result to IDENTIFIER_POINTER of stringpool node. (gfc_match_member_sep, gfc_match_sym_tree, gfc_match, gfc_match_else, gfc_match_elseif, match_common_name, gfc_match_common, gfc_match_ptr_fcn_assign, match_case_eos, gfc_match_elsewhere): Adjust. * decl.c (variable_decl): Set name via gfc_get_string() and adjust calls to gfc_match_name. (match_data_constant, check_function_name, get_bind_c_idents, gfc_match_formal_arglist, match_result, match_procedure_interface, match_ppc_decl, match_procedure_in_interface, gfc_match_entry, gfc_match_end, attr_decl1, gfc_match_modproc, gfc_match_type, enumerator_decl, match_procedure_in_type, gfc_match_generic, gfc_match_final_decl, gfc_match_gcc_attributes): Adjust. * interface.c (gfc_match_generic_spec): Adjust. * io.c (match_io): Adjust. * module.c (gfc_match_use): Adjust. * openmp.c (gfc_match_omp_clauses, gfc_match_oacc_routine): Adjust. * primary.c (match_kind_param, match_sym_complex_part, match_actual_arg, match_keyword_arg, gfc_match_varspec, gfc_match_rvalue): Adjust. --- gcc/fortran/decl.c | 95 +++++++++++++++++++++-------------------- gcc/fortran/interface.c | 5 ++- gcc/fortran/io.c | 6 +-- gcc/fortran/match.c | 56 +++++++++++++----------- gcc/fortran/match.h | 4 +- gcc/fortran/module.c | 5 ++- gcc/fortran/openmp.c | 25 +++++------ gcc/fortran/primary.c | 31 +++++++------- 8 files changed, 116 insertions(+), 111 deletions(-) diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 03298833c98..f0ff5138ca1 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -352,7 +352,7 @@ syntax: static match match_data_constant (gfc_expr **result) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_symbol *sym, *dt_sym = NULL; gfc_expr *expr; match m; @@ -404,7 +404,7 @@ match_data_constant (gfc_expr **result) gfc_current_locus = old_loc; - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m != MATCH_YES) return m; @@ -2261,7 +2261,7 @@ match_pointer_init (gfc_expr **init, int procptr) static bool -check_function_name (char *name) +check_function_name (const char *name) { /* In functions that have a RESULT variable defined, the function name always refers to function calls. Therefore, the name is not allowed to appear in @@ -2294,7 +2294,7 @@ check_function_name (char *name) static match variable_decl (int elem) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; static unsigned int fill_id = 0; gfc_expr *initializer, *char_len; gfc_array_spec *as; @@ -2326,7 +2326,7 @@ variable_decl (int elem) if (m != MATCH_YES) { - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m != MATCH_YES) goto cleanup; } @@ -2351,7 +2351,7 @@ variable_decl (int elem) } /* %FILL components are given invalid fortran names. */ - snprintf (name, GFC_MAX_SYMBOL_LEN + 1, "%%FILL%u", fill_id++); + name = gfc_get_string ("%%FILL%u", fill_id++); m = MATCH_YES; } @@ -2584,13 +2584,13 @@ variable_decl (int elem) if (gfc_current_state () == COMP_FUNCTION && strcmp ("ppr@", gfc_current_block ()->name) == 0 && strcmp (name, gfc_current_block ()->ns->proc_name->name) == 0) - strcpy (name, "ppr@"); + name = gfc_get_string ("%s", "ppr@"); if (gfc_current_state () == COMP_FUNCTION && strcmp (name, gfc_current_block ()->name) == 0 && gfc_current_block ()->result && strcmp ("ppr@", gfc_current_block ()->result->name) == 0) - strcpy (name, "ppr@"); + name = gfc_get_string ("%s", "ppr@"); /* OK, we've successfully matched the declaration. Now put the symbol in the current namespace, because it might be used in the @@ -5694,13 +5694,13 @@ set_verify_bind_c_com_block (gfc_common_head *com_block, int num_idents) bool get_bind_c_idents (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; int num_idents = 0; gfc_symbol *tmp_sym = NULL; match found_id; gfc_common_head *com_block = NULL; - if (gfc_match_name (name) == MATCH_YES) + if (gfc_match_name (&name) == MATCH_YES) { found_id = MATCH_YES; gfc_get_ha_symbol (name, &tmp_sym); @@ -5745,7 +5745,7 @@ get_bind_c_idents (void) found_id = MATCH_NO; else if (gfc_match_char (',') != MATCH_YES) found_id = MATCH_NO; - else if (gfc_match_name (name) == MATCH_YES) + else if (gfc_match_name (&name) == MATCH_YES) { found_id = MATCH_YES; gfc_get_ha_symbol (name, &tmp_sym); @@ -6126,7 +6126,7 @@ gfc_match_formal_arglist (gfc_symbol *progname, int st_flag, int null_flag, bool typeparam) { gfc_formal_arglist *head, *tail, *p, *q; - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_symbol *sym; match m; gfc_formal_arglist *formal = NULL; @@ -6173,7 +6173,7 @@ gfc_match_formal_arglist (gfc_symbol *progname, int st_flag, } else { - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m != MATCH_YES) { if(typeparam) @@ -6317,14 +6317,14 @@ cleanup: static match match_result (gfc_symbol *function, gfc_symbol **result) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_symbol *r; match m; if (gfc_match (" result (") != MATCH_YES) return MATCH_NO; - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m != MATCH_YES) return m; @@ -6515,7 +6515,7 @@ match_procedure_interface (gfc_symbol **proc_if) gfc_symtree *st; locus old_loc, entry_loc; gfc_namespace *old_ns = gfc_current_ns; - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; old_loc = entry_loc = gfc_current_locus; gfc_clear_ts (¤t_ts); @@ -6538,7 +6538,7 @@ match_procedure_interface (gfc_symbol **proc_if) /* Procedure interface is itself a procedure. */ gfc_current_locus = old_loc; - m = gfc_match_name (name); + m = gfc_match_name (&name); /* First look to see if it is already accessible in the current namespace because it is use associated or contained. */ @@ -6737,7 +6737,7 @@ match_ppc_decl (void) gfc_component *c; gfc_expr *initializer = NULL; gfc_typebound_proc* tb; - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; /* Parse interface (with brackets). */ m = match_procedure_interface (&proc_if); @@ -6778,7 +6778,7 @@ match_ppc_decl (void) ts = current_ts; for(num=1;;num++) { - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m == MATCH_NO) goto syntax; else if (m == MATCH_ERROR) @@ -6855,7 +6855,7 @@ match_procedure_in_interface (void) { match m; gfc_symbol *sym; - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; locus old_locus; if (current_interface.type == INTERFACE_NAMELESS @@ -6879,7 +6879,7 @@ match_procedure_in_interface (void) for(;;) { - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m == MATCH_NO) goto syntax; else if (m == MATCH_ERROR) @@ -7180,7 +7180,7 @@ gfc_match_entry (void) gfc_symbol *proc; gfc_symbol *result; gfc_symbol *entry; - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_compile_state state; match m; gfc_entry_list *el; @@ -7189,7 +7189,7 @@ gfc_match_entry (void) char peek_char; match is_bind_c; - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m != MATCH_YES) return m; @@ -7787,7 +7787,7 @@ set_enum_kind(void) match gfc_match_end (gfc_statement *st) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_compile_state state; locus old_loc; const char *block_name; @@ -8031,7 +8031,7 @@ gfc_match_end (gfc_statement *st) end-name. */ m = gfc_match_space (); if (m == MATCH_YES) - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m == MATCH_NO) gfc_error ("Expected terminating name at %C"); @@ -8113,7 +8113,7 @@ cleanup: static match attr_decl1 (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_array_spec *as; /* Workaround -Wmaybe-uninitialized false positive during @@ -8124,7 +8124,7 @@ attr_decl1 (void) as = NULL; - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m != MATCH_YES) goto cleanup; @@ -9384,7 +9384,7 @@ cleanup: match gfc_match_modproc (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_symbol *sym; match m; locus old_locus; @@ -9433,7 +9433,7 @@ gfc_match_modproc (void) bool last = false; old_locus = gfc_current_locus; - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m == MATCH_NO) goto syntax; if (m != MATCH_YES) @@ -9818,7 +9818,7 @@ gfc_match_structure_decl (void) match gfc_match_type (gfc_statement *st) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; match m; locus old_loc; @@ -9844,7 +9844,7 @@ gfc_match_type (gfc_statement *st) /* By now "TYPE" has already been matched. If we do not see a name, this may * be something like "TYPE *" or "TYPE ". */ - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m != MATCH_YES) { /* Let print match if it can, otherwise throw an error from @@ -10236,7 +10236,7 @@ enum_initializer (gfc_expr *last_initializer, locus where) static match enumerator_decl (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_expr *initializer; gfc_array_spec *as = NULL; gfc_symbol *sym; @@ -10251,7 +10251,7 @@ enumerator_decl (void) /* When we get here, we've just matched a list of attributes and maybe a type and a double colon. The next thing we expect to see is the name of the symbol. */ - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m != MATCH_YES) goto cleanup; @@ -10591,9 +10591,9 @@ error: static match match_procedure_in_type (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; - char target_buf[GFC_MAX_SYMBOL_LEN + 1]; - char* target = NULL, *ifc = NULL; + const char *name = NULL; + const char *target_buf = NULL; + const char *target = NULL, *ifc = NULL; gfc_typebound_proc tb; bool seen_colons; bool seen_attrs; @@ -10611,7 +10611,7 @@ match_procedure_in_type (void) /* Try to match PROCEDURE(interface). */ if (gfc_match (" (") == MATCH_YES) { - m = gfc_match_name (target_buf); + m = gfc_match_name (&target_buf); if (m == MATCH_ERROR) return m; if (m != MATCH_YES) @@ -10665,7 +10665,7 @@ match_procedure_in_type (void) /* Match the binding names. */ for(num=1;;num++) { - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m == MATCH_ERROR) return m; if (m == MATCH_NO) @@ -10697,7 +10697,7 @@ match_procedure_in_type (void) return MATCH_ERROR; } - m = gfc_match_name (target_buf); + m = gfc_match_name (&target_buf); if (m == MATCH_ERROR) return m; if (m == MATCH_NO) @@ -10931,8 +10931,9 @@ gfc_match_generic (void) { gfc_symtree* target_st; gfc_tbp_generic* target; + const char *name2 = NULL; - m = gfc_match_name (name); + m = gfc_match_name (&name2); if (m == MATCH_ERROR) goto error; if (m == MATCH_NO) @@ -10941,14 +10942,14 @@ gfc_match_generic (void) goto error; } - target_st = gfc_get_tbp_symtree (&ns->tb_sym_root, name); + target_st = gfc_get_tbp_symtree (&ns->tb_sym_root, name2); /* See if this is a duplicate specification. */ for (target = tb->u.generic; target; target = target->next) if (target_st == target->specific_st) { gfc_error ("%qs already defined as specific binding for the" - " generic %qs at %C", name, bind_name); + " generic %qs at %C", name2, bind_name); goto error; } @@ -10981,7 +10982,7 @@ error: match gfc_match_final_decl (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_symbol* sym; match m; gfc_namespace* module_ns; @@ -11037,7 +11038,7 @@ gfc_match_final_decl (void) return MATCH_ERROR; } - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m == MATCH_NO) { gfc_error ("Expected module procedure name at %C"); @@ -11120,7 +11121,7 @@ match gfc_match_gcc_attributes (void) { symbol_attribute attr; - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; unsigned id; gfc_symbol *sym; match m; @@ -11130,7 +11131,7 @@ gfc_match_gcc_attributes (void) { char ch; - if (gfc_match_name (name) != MATCH_YES) + if (gfc_match_name (&name) != MATCH_YES) return MATCH_ERROR; for (id = 0; id < EXT_ATTR_LAST; id++) @@ -11166,7 +11167,7 @@ gfc_match_gcc_attributes (void) for(;;) { - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m != MATCH_YES) return m; diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 14137cebd6c..de58eed23f0 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -140,6 +140,7 @@ gfc_match_generic_spec (interface_type *type, gfc_intrinsic_op *op) { char buffer[GFC_MAX_SYMBOL_LEN + 1]; + const char *name2 = NULL; match m; gfc_intrinsic_op i; @@ -212,9 +213,9 @@ gfc_match_generic_spec (interface_type *type, return MATCH_YES; } - if (gfc_match_name (buffer) == MATCH_YES) + if (gfc_match_name (&name2) == MATCH_YES) { - strcpy (name, buffer); + strcpy (name, name2); *type = INTERFACE_GENERIC; return MATCH_YES; } diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index 0aa31bb6a4f..1d07076c377 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -4071,7 +4071,7 @@ if (condition) \ static match match_io (io_kind k) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_code *io_code; gfc_symbol *sym; int comma_flag; @@ -4093,7 +4093,7 @@ match_io (io_kind k) { /* Treat the non-standard case of PRINT namelist. */ if ((gfc_current_form == FORM_FIXED || gfc_peek_ascii_char () == ' ') - && gfc_match_name (name) == MATCH_YES) + && gfc_match_name (&name) == MATCH_YES) { gfc_find_symbol (name, NULL, 1, &sym); if (sym && sym->attr.flavor == FL_NAMELIST) @@ -4219,7 +4219,7 @@ match_io (io_kind k) where = gfc_current_locus; - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m == MATCH_YES) { gfc_find_symbol (name, NULL, 1, &sym); diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 85247dd8334..f3ad91a07c0 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -25,6 +25,8 @@ along with GCC; see the file COPYING3. If not see #include "gfortran.h" #include "match.h" #include "parse.h" +#include "stringpool.h" +#include "tree.h" int gfc_matching_ptr_assignment = 0; int gfc_matching_procptr_assignment = 0; @@ -150,7 +152,7 @@ gfc_op2string (gfc_intrinsic_op op) match gfc_match_member_sep(gfc_symbol *sym) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; locus dot_loc, start_loc; gfc_intrinsic_op iop; match m; @@ -176,7 +178,6 @@ gfc_match_member_sep(gfc_symbol *sym) tsym = sym->ts.u.derived; iop = INTRINSIC_NONE; - name[0] = '\0'; m = MATCH_NO; /* If we have to reject come back here later. */ @@ -190,7 +191,7 @@ gfc_match_member_sep(gfc_symbol *sym) dot_loc = gfc_current_locus; /* Try to match a symbol name following the dot. */ - if (gfc_match_name (name) != MATCH_YES) + if (gfc_match_name (&name) != MATCH_YES) { gfc_error ("Expected structure component or operator name " "after '.' at %C"); @@ -634,17 +635,18 @@ gfc_match_label (void) } -/* See if the current input looks like a name of some sort. Modifies - the passed buffer which must be GFC_MAX_SYMBOL_LEN+1 bytes long. +/* See if the current input looks like a name of some sort. + Upon success RESULT is set to the matched name and MATCH_YES is returned. Note that options.c restricts max_identifier_length to not more than GFC_MAX_SYMBOL_LEN. */ match -gfc_match_name (char *buffer) +gfc_match_name (const char **result) { locus old_loc; int i; char c; + char buffer[GFC_MAX_SYMBOL_LEN + 1]; old_loc = gfc_current_locus; gfc_gobble_whitespace (); @@ -685,7 +687,7 @@ gfc_match_name (char *buffer) return MATCH_ERROR; } - buffer[i] = '\0'; + *result = IDENTIFIER_POINTER (get_identifier_with_length (buffer, i)); gfc_current_locus = old_loc; return MATCH_YES; @@ -698,10 +700,10 @@ gfc_match_name (char *buffer) match gfc_match_sym_tree (gfc_symtree **matched_symbol, int host_assoc) { - char buffer[GFC_MAX_SYMBOL_LEN + 1]; + const char *buffer = NULL; match m; - m = gfc_match_name (buffer); + m = gfc_match_name (&buffer); if (m != MATCH_YES) return m; @@ -1123,6 +1125,7 @@ gfc_match (const char *target, ...) locus old_loc; va_list argp; char c, *np; + const char *name2_hack = NULL; match m, n; void **vp; const char *p; @@ -1186,12 +1189,13 @@ loop: case 'n': np = va_arg (argp, char *); - n = gfc_match_name (np); + n = gfc_match_name (&name2_hack); if (n != MATCH_YES) { m = n; goto not_yes; } + strcpy (np, name2_hack); matches++; goto loop; @@ -1694,12 +1698,12 @@ got_match: match gfc_match_else (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; if (gfc_match_eos () == MATCH_YES) return MATCH_YES; - if (gfc_match_name (name) != MATCH_YES + if (gfc_match_name (&name) != MATCH_YES || gfc_current_block () == NULL || gfc_match_eos () != MATCH_YES) { @@ -1723,7 +1727,7 @@ gfc_match_else (void) match gfc_match_elseif (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_expr *expr; match m; @@ -1734,7 +1738,7 @@ gfc_match_elseif (void) if (gfc_match_eos () == MATCH_YES) goto done; - if (gfc_match_name (name) != MATCH_YES + if (gfc_match_name (&name) != MATCH_YES || gfc_current_block () == NULL || gfc_match_eos () != MATCH_YES) { @@ -5029,23 +5033,23 @@ gfc_get_common (const char *name, int from_module) /* Match a common block name. */ -match match_common_name (char *name) +match match_common_name (const char *&name) { match m; if (gfc_match_char ('/') == MATCH_NO) { - name[0] = '\0'; + name = NULL; return MATCH_YES; } if (gfc_match_char ('/') == MATCH_YES) { - name[0] = '\0'; + name = NULL; return MATCH_YES; } - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m == MATCH_ERROR) return MATCH_ERROR; @@ -5063,7 +5067,7 @@ match gfc_match_common (void) { gfc_symbol *sym, **head, *tail, *other; - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_common_head *t; gfc_array_spec *as; gfc_equiv *e1, *e2; @@ -5077,7 +5081,7 @@ gfc_match_common (void) if (m == MATCH_ERROR) goto cleanup; - if (name[0] == '\0') + if (name == NULL) { t = &gfc_current_ns->blank_common; if (t->head == NULL) @@ -5736,10 +5740,10 @@ gfc_match_ptr_fcn_assign (void) gfc_symbol *sym; gfc_expr *expr; match m; - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; old_loc = gfc_current_locus; - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m != MATCH_YES) return m; @@ -5888,7 +5892,7 @@ cleanup: static match match_case_eos (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; match m; if (gfc_match_eos () == MATCH_YES) @@ -5901,7 +5905,7 @@ match_case_eos (void) gfc_gobble_whitespace (); - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m != MATCH_YES) return m; @@ -6589,7 +6593,7 @@ gfc_match_where (gfc_statement *st) match gfc_match_elsewhere (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_expr *expr; match m; @@ -6622,7 +6626,7 @@ gfc_match_elsewhere (void) goto cleanup; } /* Better be a name at this point. */ - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m == MATCH_NO) goto syntax; if (m == MATCH_ERROR) diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h index b3ced3f8454..62554d9667e 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -50,7 +50,7 @@ match gfc_match_st_label (gfc_st_label **); match gfc_match_label (void); match gfc_match_small_int (int *); match gfc_match_small_int_expr (int *, gfc_expr **); -match gfc_match_name (char *); +match gfc_match_name (const char **); match gfc_match_name_C (const char **buffer); match gfc_match_symbol (gfc_symbol **, int); match gfc_match_sym_tree (gfc_symtree **, int); @@ -107,7 +107,7 @@ match gfc_match_call (void); TODO: should probably rename this now that it'll be globally seen to gfc_match_common_name. */ -match match_common_name (char *name); +match match_common_name (const char *&name); match gfc_match_common (void); match gfc_match_block_data (void); diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 993ea9f16b9..f31677b3b5e 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -520,6 +520,7 @@ match gfc_match_use (void) { char name[GFC_MAX_SYMBOL_LEN + 1], module_nature[GFC_MAX_SYMBOL_LEN + 1]; + const char *name2 = NULL; gfc_use_rename *tail = NULL, *new_use; interface_type type, type2; gfc_intrinsic_op op; @@ -583,14 +584,14 @@ gfc_match_use (void) use_list->where = gfc_current_locus; - m = gfc_match_name (name); + m = gfc_match_name (&name2); if (m != MATCH_YES) { free (use_list); return m; } - use_list->module_name = gfc_get_string ("%s", name); + use_list->module_name = name2; if (gfc_match_eos () == MATCH_YES) goto done; diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index a852fc490db..10a5df92e61 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -1580,8 +1580,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, && gfc_match ("reduction ( ") == MATCH_YES) { gfc_omp_reduction_op rop = OMP_REDUCTION_NONE; - char buffer[GFC_MAX_SYMBOL_LEN + 3]; - const char *op = NULL; + const char *buffer = NULL; if (gfc_match_char ('+') == MATCH_YES) rop = OMP_REDUCTION_PLUS; else if (gfc_match_char ('*') == MATCH_YES) @@ -1597,11 +1596,11 @@ 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) - op = gfc_get_string ("operator %s", + buffer = gfc_get_string ("operator %s", gfc_op2string ((gfc_intrinsic_op) rop)); - else if (gfc_match_defined_op_name (op, 1, 1) == MATCH_YES) + else if (gfc_match_defined_op_name (buffer, 1, 1) == MATCH_YES) ; - else if (gfc_match_name (buffer) == MATCH_YES) + else if (gfc_match_name (&buffer) == MATCH_YES) { gfc_symbol *sym; const char *n = buffer; @@ -1657,11 +1656,9 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, rop = OMP_REDUCTION_NONE; } else - buffer[0] = '\0'; + buffer = NULL; gfc_omp_udr *udr; - if (op != NULL) - udr = gfc_find_omp_udr (gfc_current_ns, op, NULL); - else if (buffer[0]) + if (buffer != NULL) udr = gfc_find_omp_udr (gfc_current_ns, buffer, NULL); else udr = NULL; @@ -1680,7 +1677,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", op ? op : buffer, &old_loc); + "at %L", buffer, &old_loc); gfc_free_omp_namelist (n); } else @@ -2290,13 +2287,13 @@ gfc_match_oacc_routine (void) if (m == MATCH_YES) { - char buffer[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_symtree *st; - m = gfc_match_name (buffer); + m = gfc_match_name (&name); if (m == MATCH_YES) { - st = gfc_find_symtree (gfc_current_ns->sym_root, buffer); + st = gfc_find_symtree (gfc_current_ns->sym_root, name); if (st) { sym = st->n.sym; @@ -2313,7 +2310,7 @@ gfc_match_oacc_routine (void) { gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C, " "invalid function name %s", - (sym) ? sym->name : buffer); + (sym) ? sym->name : name); gfc_current_locus = old_loc; return MATCH_ERROR; } diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 094f2101bbc..b30938ef61c 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -39,7 +39,7 @@ int matching_actual_arglist = 0; static match match_kind_param (int *kind, int *is_iso_c) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_symbol *sym; match m; @@ -49,7 +49,7 @@ match_kind_param (int *kind, int *is_iso_c) if (m != MATCH_NO) return m; - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m != MATCH_YES) return m; @@ -1234,12 +1234,12 @@ match_logical_constant (gfc_expr **result) static match match_sym_complex_part (gfc_expr **result) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_symbol *sym; gfc_expr *e; match m; - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m != MATCH_YES) return m; @@ -1525,7 +1525,7 @@ gfc_is_function_return_value (gfc_symbol *sym, gfc_namespace *ns) static match match_actual_arg (gfc_expr **result) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_symtree *symtree; locus where, w; gfc_expr *e; @@ -1534,7 +1534,7 @@ match_actual_arg (gfc_expr **result) gfc_gobble_whitespace (); where = gfc_current_locus; - switch (gfc_match_name (name)) + switch (gfc_match_name (&name)) { case MATCH_ERROR: return MATCH_ERROR; @@ -1629,13 +1629,13 @@ match_actual_arg (gfc_expr **result) static match match_keyword_arg (gfc_actual_arglist *actual, gfc_actual_arglist *base, bool pdt) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_actual_arglist *a; locus name_locus; match m; name_locus = gfc_current_locus; - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m != MATCH_YES) goto cleanup; @@ -1667,7 +1667,7 @@ match_keyword_arg (gfc_actual_arglist *actual, gfc_actual_arglist *base, bool pd /* Make sure this name has not appeared yet. */ add_name: - if (name[0] != '\0') + if (name != NULL) { for (a = base; a; a = a->next) if (a->name != NULL && strcmp (a->name, name) == 0) @@ -1678,7 +1678,7 @@ add_name: } } - actual->name = gfc_get_string ("%s", name); + actual->name = name; return MATCH_YES; cleanup: @@ -1948,7 +1948,7 @@ match gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, bool ppc_arg) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_ref *substring, *tail, *tmp; gfc_component *component; gfc_symbol *sym = primary->symtree->n.sym; @@ -2136,7 +2136,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, bool t; gfc_symtree *tbp; - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m == MATCH_NO) gfc_error ("Expected structure component name at %C"); if (m != MATCH_YES) @@ -3144,7 +3144,8 @@ match gfc_match_rvalue (gfc_expr **result) { gfc_actual_arglist *actual_arglist; - char name[GFC_MAX_SYMBOL_LEN + 1], argname[GFC_MAX_SYMBOL_LEN + 1]; + char argname[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_state_data *st; gfc_symbol *sym; gfc_symtree *symtree; @@ -3161,12 +3162,12 @@ gfc_match_rvalue (gfc_expr **result) { if (!gfc_notify_std (GFC_STD_LEGACY, "%%LOC() as an rvalue at %C")) return MATCH_ERROR; - strncpy (name, "loc", 4); + name = gfc_get_string ("%s", "loc"); } else { - m = gfc_match_name (name); + m = gfc_match_name (&name); if (m != MATCH_YES) return m; } From patchwork Wed Sep 5 14:57:07 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Bernhard Reutner-Fischer X-Patchwork-Id: 966428 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-485225-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="j0yh9BZV"; dkim=pass (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="lxWMtVdQ"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4256Lh0X4wz9sCw for ; Thu, 6 Sep 2018 00:59:55 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; q=dns; s=default; b=TaN YXSxJNk86gP5bCgL12q2GuPROZJCsXBkkqkjuInPoLIGoGSOTKCmVJQMLyhEFd6p sHP1Co3LdFbPxP5C9cvNZ+Sl1d956KxOeA8Bj24JVWp9HRIIS6QXRwIsP21CAaXv 3E5RPdp4/rDuB+fUFBRy18fuQ8stMwzxOZd6//Xw= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; s=default; bh=6iD7rf1Xq JzPJ/w3NYHqQwxxrxk=; b=j0yh9BZVqFkHQ6Ky+LnGIwUNe9St59uLxtMzAUY06 g7Tf9BuCFRWwB92qF0dXRZwso1VS8WzbNpS/50luI4ahMdDkaqhs/X/JX4eG/A+5 1cDNA+lq6Qmk9EFoTSjMvwdOoVKgEncMQscPf8LBEHQPwMb5rQkFpb0njG3IOc9n o0= Received: (qmail 68673 invoked by alias); 5 Sep 2018 14:57:55 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 68230 invoked by uid 89); 5 Sep 2018 14:57:52 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.6 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=obtained, 66513, H*Ad:U*aldot X-HELO: mail-wr1-f42.google.com Received: from mail-wr1-f42.google.com (HELO mail-wr1-f42.google.com) (209.85.221.42) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 05 Sep 2018 14:57:49 +0000 Received: by mail-wr1-f42.google.com with SMTP id n2-v6so8024516wrw.7; Wed, 05 Sep 2018 07:57:49 -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=9ZLxbku5i1nUe+8DkLO3akxAmqT4+VoBkE1tLkcos7w=; b=lxWMtVdQTBUlVqcs9+i/SIyhbIDjFC95K55ZEMoz+zd9Oml6qjLEDMbIu9ml8rwxCg A0PdCZG4KfkjSEdNbrarwG+gYNaodUK0or1v2xOfCr49A67YQL/1+EQ3yNJZuWddSSYC xJSRsrwOGOO7DMGzM6o4kO4uxcGQYssJuZHrWKLqDlw3S25px9EnHpfMWekqYnLw4IaV SXy8PlovMl4ZGnlK5fwaeK9XNXXOTT83iYpM/l1mXimnRXuP4tSknDlaLWBQLeOSuLlb dTafr2vkTHX83rIKWwRP7Xi4TAJvRGSZA4cASs/Yu+EJGZW9+jPX+rcjJz6KbhGSWPZz nstQ== Received: from s46.loc (91-119-125-11.dsl.dynamic.surfer.at. [91.119.125.11]) by smtp.gmail.com with ESMTPSA id k63-v6sm2789404wmd.46.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-00007N-Qd; 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 04/29] Use stringpool for gfc_match_generic_spec Date: Wed, 5 Sep 2018 14:57:07 +0000 Message-Id: <20180905145732.404-5-rep.dot.nop@gmail.com> In-Reply-To: References: MIME-Version: 1.0 X-IsSubscribed: yes From: Bernhard Reutner-Fischer Ideally we would populate mstrings structs with strings obtained through the stringpool. Doing so by means of minit wouldn't work out too well though, see comment in gfortran.h. We could replace the initialized strings in gfc_init_1 but that's for a later patch. gcc/fortran/ChangeLog: 2017-10-23 Bernhard Reutner-Fischer * match.h (gfc_match_generic_spec): Pass argument name by reference. Adjust all callers. * decl.c (access_attr_decl): Adjust. (gfc_match_generic): Adjust. * interface.c (gfc_match_generic_spec, gfc_match_interface, gfc_match_end_interface): Adjust. * module.c (gfc_match_use): Adjust. --- gcc/fortran/decl.c | 11 +++++------ gcc/fortran/gfortran.h | 5 +++++ gcc/fortran/interface.c | 20 +++++++++----------- gcc/fortran/match.h | 3 ++- gcc/fortran/module.c | 16 +++++++++------- 5 files changed, 30 insertions(+), 25 deletions(-) diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index f0ff5138ca1..2f8d2aca695 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -8582,7 +8582,7 @@ gfc_match_target (void) static match access_attr_decl (gfc_statement st) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; interface_type type; gfc_user_op *uop; gfc_symbol *sym, *dt_sym; @@ -10768,7 +10768,7 @@ syntax: match gfc_match_generic (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; char bind_name[GFC_MAX_SYMBOL_LEN + 16]; /* Allow space for OPERATOR(...). */ gfc_symbol* block; gfc_typebound_proc tbattr; /* Used for match_binding_attributes. */ @@ -10931,9 +10931,8 @@ gfc_match_generic (void) { gfc_symtree* target_st; gfc_tbp_generic* target; - const char *name2 = NULL; - m = gfc_match_name (&name2); + m = gfc_match_name (&name); if (m == MATCH_ERROR) goto error; if (m == MATCH_NO) @@ -10942,14 +10941,14 @@ gfc_match_generic (void) goto error; } - target_st = gfc_get_tbp_symtree (&ns->tb_sym_root, name2); + target_st = gfc_get_tbp_symtree (&ns->tb_sym_root, name); /* See if this is a duplicate specification. */ for (target = tb->u.generic; target; target = target->next) if (target_st == target->specific_st) { gfc_error ("%qs already defined as specific binding for the" - " generic %qs at %C", name2, bind_name); + " generic %qs at %C", name, bind_name); goto error; } diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 04b0024a992..774a6de6168 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -95,6 +95,11 @@ not after. /* Macro to initialize an mstring structure. */ #define minit(s, t) { s, NULL, t } +/* Ideally we would want that to be + { IDENTIFIER_POINTER (get_identifier_with_length (s, sizeof(s)-1)), NULL, t } + but stringpool's hash table is not allocated yet and we would have to do + tricks to have a ctor to initialize it. And even that wouldn't work too + well as toplevel would later on wipe ident_hash. */ /* Structure for storing strings to be matched by gfc_match_string. */ typedef struct diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index de58eed23f0..6a5fe928b93 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -136,11 +136,10 @@ dtio_op (char* mode) match gfc_match_generic_spec (interface_type *type, - char *name, + const char *&name, gfc_intrinsic_op *op) { char buffer[GFC_MAX_SYMBOL_LEN + 1]; - const char *name2 = NULL; match m; gfc_intrinsic_op i; @@ -174,7 +173,7 @@ gfc_match_generic_spec (interface_type *type, if (m != MATCH_YES) return MATCH_ERROR; - strcpy (name, oper); + name = oper; *type = INTERFACE_USER_OP; return MATCH_YES; } @@ -184,12 +183,12 @@ gfc_match_generic_spec (interface_type *type, *op = dtio_op (buffer); if (*op == INTRINSIC_FORMATTED) { - strcpy (name, gfc_code2string (dtio_procs, DTIO_RF)); + name = gfc_code2string (dtio_procs, DTIO_RF); *type = INTERFACE_DTIO; } if (*op == INTRINSIC_UNFORMATTED) { - strcpy (name, gfc_code2string (dtio_procs, DTIO_RUF)); + name = gfc_code2string (dtio_procs, DTIO_RUF); *type = INTERFACE_DTIO; } if (*op != INTRINSIC_NONE) @@ -201,21 +200,20 @@ gfc_match_generic_spec (interface_type *type, *op = dtio_op (buffer); if (*op == INTRINSIC_FORMATTED) { - strcpy (name, gfc_code2string (dtio_procs, DTIO_WF)); + name = gfc_code2string (dtio_procs, DTIO_WF); *type = INTERFACE_DTIO; } if (*op == INTRINSIC_UNFORMATTED) { - strcpy (name, gfc_code2string (dtio_procs, DTIO_WUF)); + name = gfc_code2string (dtio_procs, DTIO_WUF); *type = INTERFACE_DTIO; } if (*op != INTRINSIC_NONE) return MATCH_YES; } - if (gfc_match_name (&name2) == MATCH_YES) + if (gfc_match_name (&name) == MATCH_YES) { - strcpy (name, name2); *type = INTERFACE_GENERIC; return MATCH_YES; } @@ -235,7 +233,7 @@ syntax: match gfc_match_interface (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; interface_type type; gfc_symbol *sym; gfc_intrinsic_op op; @@ -327,7 +325,7 @@ gfc_match_abstract_interface (void) match gfc_match_end_interface (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; interface_type type; gfc_intrinsic_op op; match m; diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h index 62554d9667e..75e0d9204d7 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -296,7 +296,8 @@ match gfc_match_array_constructor (gfc_expr **); /* interface.c. */ match gfc_match_abstract_interface (void); -match gfc_match_generic_spec (interface_type *, char *, gfc_intrinsic_op *); +match gfc_match_generic_spec (interface_type *, const char *&, + gfc_intrinsic_op *); match gfc_match_interface (void); match gfc_match_end_interface (void); diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index f31677b3b5e..1064f3c80cb 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -68,9 +68,9 @@ along with GCC; see the file COPYING3. If not see #include "system.h" #include "coretypes.h" #include "options.h" +#include "stringpool.h" #include "tree.h" #include "gfortran.h" -#include "stringpool.h" #include "arith.h" #include "match.h" #include "parse.h" /* FIXME */ @@ -519,8 +519,8 @@ free_rename (gfc_use_rename *list) match gfc_match_use (void) { - char name[GFC_MAX_SYMBOL_LEN + 1], module_nature[GFC_MAX_SYMBOL_LEN + 1]; - const char *name2 = NULL; + char module_nature[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_use_rename *tail = NULL, *new_use; interface_type type, type2; gfc_intrinsic_op op; @@ -584,14 +584,14 @@ gfc_match_use (void) use_list->where = gfc_current_locus; - m = gfc_match_name (&name2); + m = gfc_match_name (&name); if (m != MATCH_YES) { free (use_list); return m; } - use_list->module_name = name2; + use_list->module_name = name; if (gfc_match_eos () == MATCH_YES) goto done; @@ -650,13 +650,14 @@ gfc_match_use (void) else { strcpy (new_use->local_name, name); - m = gfc_match_generic_spec (&type2, new_use->use_name, &op); + m = gfc_match_generic_spec (&type2, name, &op); if (type != type2) goto syntax; if (m == MATCH_NO) goto syntax; if (m == MATCH_ERROR) goto cleanup; + strcpy (new_use->use_name, name); } } else @@ -665,13 +666,14 @@ gfc_match_use (void) goto syntax; strcpy (new_use->local_name, name); - m = gfc_match_generic_spec (&type2, new_use->use_name, &op); + m = gfc_match_generic_spec (&type2, name, &op); if (type != type2) goto syntax; if (m == MATCH_NO) goto syntax; if (m == MATCH_ERROR) goto cleanup; + strcpy (new_use->use_name, name); } if (strcmp (new_use->use_name, use_list->module_name) == 0 From patchwork Wed Sep 5 14:57:08 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Bernhard Reutner-Fischer X-Patchwork-Id: 966435 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-485233-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="G5hh7MQn"; dkim=pass (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="SCQ8Bhw6"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4256PP0xFrz9sCn for ; Thu, 6 Sep 2018 01:02:16 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; q=dns; s=default; b=N/I y/E5P31d3meAboGlHWsTVxtcPRxoK27hewJyzwLoAQHRk72WK6xu7Iu02mE8TCSh 3GYjYlxvyJ/yWMAbhR8EU4W6AetYF8DRXyU2WcHM1gouXhscBqvCrPZ5mYxmxtfE P7awkxl1CCE4QvTzTcC0T/0SpK8oM7rAoNRUafvE= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; s=default; bh=1c9v4JSPM Z+vhs/JIrt9KdaOu5s=; b=G5hh7MQnZclinXRqxsR7QeDxySWwjfFEp1+5sIhha IzDo6icfK8k3/RVi4GJieS5Xr7rB0WucNg0pmLQbTdH4y9JiVgy1r9b/nayKNxZG /J1atwCKgVLD2S7it9LWxMjA3F7N2KP+JKSjEzhbpLXeyfQfaO9Znx88agwR1p4y p4= Received: (qmail 69814 invoked by alias); 5 Sep 2018 14:58:05 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 68817 invoked by uid 89); 5 Sep 2018 14:57:56 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.7 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=nature, mold, percent X-HELO: mail-wr1-f44.google.com Received: from mail-wr1-f44.google.com (HELO mail-wr1-f44.google.com) (209.85.221.44) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 05 Sep 2018 14:57:52 +0000 Received: by mail-wr1-f44.google.com with SMTP id o37-v6so8009584wrf.6; Wed, 05 Sep 2018 07:57:51 -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=KJbHTBK/tljE7mfB7JJ+58Q1rje02P9SyS16KLzfcVs=; b=SCQ8Bhw6IlPNGq8JUMRhr7ukMpQu9cfNfHqsCW95At3yQw9IYzmSQMax4egCegdL4Q /y0/vXJo5uNMqq4hL8tlYz+nAgyrDUYX9sPUB7oo7+Sj3q1CwT8FWSOTZCkudLs2+EDL QSEFV9CKTf4B209xjcdp3Wn7MKvlfbaH5vYm4Fiv7Tv/8KjK95ox9VZd1hgDlhnJ3sEJ xJ9d0Hk1oOariJUPSFGAUycVPXROoKdgumSPYvYE+PjgQI7Qh9ywYKDW72RusHNEFIgJ wOaFX496VMxQ90E1Rwr9vUVtUUPjrcc/QUPFTrDRe9qm8BiCERbTgaBSY2ukgHP6bcpV gqrQ== Received: from s46.loc (91-119-125-11.dsl.dynamic.surfer.at. [91.119.125.11]) by smtp.gmail.com with ESMTPSA id h8-v6sm2964816wre.15.2018.09.05.07.57.45 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 05 Sep 2018 07:57:46 -0700 (PDT) Received: from cow by s46.loc with local (Exim 4.91) (envelope-from ) id 1fxZFX-00007P-Vm; Wed, 05 Sep 2018 14:57:44 +0000 From: Bernhard Reutner-Fischer To: fortran@gcc.gnu.org Cc: Bernhard Reutner-Fischer , gcc-patches@gcc.gnu.org Subject: [PATCH,FORTRAN 05/29] Use stringpool for gfc_match("%n") Date: Wed, 5 Sep 2018 14:57:08 +0000 Message-Id: <20180905145732.404-6-rep.dot.nop@gmail.com> In-Reply-To: References: MIME-Version: 1.0 X-IsSubscribed: yes From: Bernhard Reutner-Fischer Add matched names into the stringpool. gcc/fortran/ChangeLog: 2017-10-26 Bernhard Reutner-Fischer * match.c (gfc_match): Use pointer to pointer when matching a name via "%n" format. Adjust all callers. (gfc_match_label, gfc_match_iterator, gfc_match_char, gfc_match_associate, match_derived_type_spec, gfc_match_type_spec, match_exit_cycle, gfc_match_allocate, gfc_match_call, gfc_match_block_data, select_type_set_tmp, gfc_match_select_type): Adjust. * decl.c (gfc_match_null, match_record_decl, gfc_match_decl_type_spec, gfc_match_implicit_none, gfc_match_import, gfc_match_function_decl, gfc_match_subroutine, gfc_match_save, gfc_match_submod_proc, check_extended_derived_type, gfc_get_type_attr_spec, gfc_match_structure_decl, gfc_match_derived_decl, match_binding_attributes): Adjust. * interface.c (dtio_op, gfc_match_generic_spec): Adjust. * io.c (match_dt_element): Adjust. * matchexp.c (gfc_match_defined_op_name): Adjust. * module.c (gfc_match_use, gfc_match_submodule): Adjust. * primary.c (match_arg_list_function, gfc_match_rvalue): Adjust. * openmp.c (gfc_match_omp_variable_list, gfc_match_omp_to_link, gfc_match_oacc_clause_link, match_udr_expr, gfc_match_omp_declare_reduction, gfc_match_omp_threadprivate): Adjust. (gfc_match_omp_critical): Adjust. Do not strdup critical_name. (gfc_free_omp_clauses): Do not free critical_name. (gfc_match_omp_end_critical): Adjust. Do not strdup omp_name. * parse.c (parse_omp_structured_block): Do not free omp_name. (match_deferred_characteristics): Adjust. --- gcc/fortran/decl.c | 81 ++++++++++++++++++++--------------------- gcc/fortran/interface.c | 11 +++--- gcc/fortran/io.c | 4 +- gcc/fortran/match.c | 62 +++++++++++++++---------------- gcc/fortran/matchexp.c | 4 +- gcc/fortran/module.c | 12 +++--- gcc/fortran/openmp.c | 70 ++++++++++++++++------------------- gcc/fortran/parse.c | 5 +-- gcc/fortran/primary.c | 8 ++-- 9 files changed, 123 insertions(+), 134 deletions(-) diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 2f8d2aca695..2667c2281f8 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -2169,16 +2169,16 @@ gfc_match_null (gfc_expr **result) if (m == MATCH_NO) { locus old_loc; - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; if ((m2 = gfc_match (" null (")) != MATCH_YES) return m2; old_loc = gfc_current_locus; - if ((m2 = gfc_match (" %n ) ", name)) == MATCH_ERROR) + if ((m2 = gfc_match (" %n ) ", &name)) == MATCH_ERROR) return MATCH_ERROR; if (m2 != MATCH_YES - && ((m2 = gfc_match (" mold = %n )", name)) == MATCH_ERROR)) + && ((m2 = gfc_match (" mold = %n )", &name)) == MATCH_ERROR)) return MATCH_ERROR; if (m2 == MATCH_NO) { @@ -3307,7 +3307,7 @@ done: /* Matches a RECORD declaration. */ static match -match_record_decl (char *name) +match_record_decl (const char **name) { locus old_loc; old_loc = gfc_current_locus; @@ -3824,7 +3824,7 @@ error_return: match gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_symbol *sym, *dt_sym; match m; char c; @@ -3883,7 +3883,7 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag) return MATCH_YES; } - m = gfc_match ("%n", name); + m = gfc_match ("%n", &name); matched_type = (m == MATCH_YES); } @@ -3989,7 +3989,7 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag) } if (m != MATCH_YES) - m = match_record_decl (name); + m = match_record_decl (&name); if (matched_type || m == MATCH_YES) { @@ -4011,7 +4011,7 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag) return m; gcc_assert (!sym->attr.pdt_template && sym->attr.pdt_type); ts->u.derived = sym; - strcpy (name, gfc_dt_lower_string (sym->name)); + name = gfc_dt_lower_string (sym->name); } if (sym && sym->attr.flavor == FL_STRUCT) @@ -4085,7 +4085,7 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag) m = gfc_match (" class ("); if (m == MATCH_YES) - m = gfc_match ("%n", name); + m = gfc_match ("%n", &name); else return m; @@ -4190,7 +4190,7 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag) return m; gcc_assert (!sym->attr.pdt_template && sym->attr.pdt_type); ts->u.derived = sym; - strcpy (name, gfc_dt_lower_string (sym->name)); + name = gfc_dt_lower_string (sym->name); } gfc_save_symbol_data (sym); @@ -4306,7 +4306,7 @@ gfc_match_implicit_none (void) { char c; match m; - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; bool type = false; bool external = false; locus cur_loc = gfc_current_locus; @@ -4335,7 +4335,7 @@ gfc_match_implicit_none (void) else for(;;) { - m = gfc_match (" %n", name); + m = gfc_match (" %n", &name); if (m != MATCH_YES) return MATCH_ERROR; @@ -4589,7 +4589,7 @@ error: match gfc_match_import (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; match m; gfc_symbol *sym; gfc_symtree *st; @@ -4631,7 +4631,7 @@ gfc_match_import (void) for(;;) { sym = NULL; - m = gfc_match (" %n", name); + m = gfc_match (" %n", &name); switch (m) { case MATCH_YES: @@ -6969,7 +6969,7 @@ do_warn_intrinsic_shadow (const gfc_symbol* sym, bool func) match gfc_match_function_decl (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_symbol *sym, *result; locus old_loc; match m; @@ -6992,7 +6992,7 @@ gfc_match_function_decl (void) return m; } - if (gfc_match ("function% %n", name) != MATCH_YES) + if (gfc_match ("function% %n", &name) != MATCH_YES) { gfc_current_locus = old_loc; return MATCH_NO; @@ -7438,7 +7438,7 @@ gfc_match_entry (void) match gfc_match_subroutine (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_symbol *sym; match m; match is_bind_c; @@ -7454,7 +7454,7 @@ gfc_match_subroutine (void) if (m != MATCH_YES) return m; - m = gfc_match ("subroutine% %n", name); + m = gfc_match ("subroutine% %n", &name); if (m != MATCH_YES) return m; @@ -9036,7 +9036,7 @@ syntax: match gfc_match_save (void) { - char n[GFC_MAX_SYMBOL_LEN+1]; + const char *name = NULL; gfc_common_head *c; gfc_symbol *sym; match m; @@ -9081,13 +9081,13 @@ gfc_match_save (void) return MATCH_ERROR; } - m = gfc_match (" / %n /", &n); + m = gfc_match (" / %n /", &name); if (m == MATCH_ERROR) return MATCH_ERROR; if (m == MATCH_NO) goto syntax; - c = gfc_get_common (n, 0); + c = gfc_get_common (name, 0); c->saved = 1; gfc_current_ns->seen_save = 1; @@ -9288,7 +9288,7 @@ syntax: match gfc_match_submod_proc (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_symbol *sym, *fsym; match m; gfc_formal_arglist *formal, *head, *tail; @@ -9299,7 +9299,7 @@ gfc_match_submod_proc (void) || gfc_state_stack->previous->state == COMP_MODULE))) return MATCH_NO; - m = gfc_match (" module% procedure% %n", name); + m = gfc_match (" module% procedure% %n", &name); if (m != MATCH_YES) return m; @@ -9497,7 +9497,7 @@ syntax: /* Check a derived type that is being extended. */ static gfc_symbol* -check_extended_derived_type (char *name) +check_extended_derived_type (const char * const name) { gfc_symbol *extended; @@ -9548,7 +9548,7 @@ check_extended_derived_type (char *name) checking on attribute conflicts needs to be done. */ match -gfc_get_type_attr_spec (symbol_attribute *attr, char *name) +gfc_get_type_attr_spec (symbol_attribute *attr, const char **name) { /* See if the derived type is marked as private. */ if (gfc_match (" , private") == MATCH_YES) @@ -9594,7 +9594,7 @@ gfc_get_type_attr_spec (symbol_attribute *attr, char *name) if (!gfc_add_abstract (attr, &gfc_current_locus)) return MATCH_ERROR; } - else if (name && gfc_match (" , extends ( %n )", name) == MATCH_YES) + else if (gfc_match (" , extends ( %n )", name) == MATCH_YES) { if (!gfc_add_extension (attr, &gfc_current_locus)) return MATCH_ERROR; @@ -9748,7 +9748,7 @@ gfc_match_structure_decl (void) { /* Counter used to give unique internal names to anonymous structures. */ static unsigned int gfc_structure_id = 0; - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_symbol *sym; match m; locus where; @@ -9761,9 +9761,7 @@ gfc_match_structure_decl (void) return MATCH_ERROR; } - name[0] = '\0'; - - m = gfc_match (" /%n/", name); + m = gfc_match (" /%n/", &name); if (m != MATCH_YES) { /* Non-nested structure declarations require a structure name. */ @@ -9779,8 +9777,9 @@ gfc_match_structure_decl (void) and setting gfc_new_symbol, which is immediately used by parse_structure () and variable_decl () to add components of this type. */ - snprintf (name, GFC_MAX_SYMBOL_LEN + 1, "SS$%u", gfc_structure_id++); + name = gfc_get_string ("SS$%u", gfc_structure_id++); } + /* FIXME: should move gfc_is_intrinsic_typename to else branch here! */ where = gfc_current_locus; /* No field list allowed after non-nested structure declaration. */ @@ -9912,8 +9911,8 @@ typeis: match gfc_match_derived_decl (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; - char parent[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; + const char *parent = NULL; symbol_attribute attr; gfc_symbol *sym, *gensym; gfc_symbol *extended; @@ -9927,14 +9926,12 @@ gfc_match_derived_decl (void) if (gfc_comp_struct (gfc_current_state ())) return MATCH_NO; - name[0] = '\0'; - parent[0] = '\0'; gfc_clear_attr (&attr); extended = NULL; do { - is_type_attr_spec = gfc_get_type_attr_spec (&attr, parent); + is_type_attr_spec = gfc_get_type_attr_spec (&attr, &parent); if (is_type_attr_spec == MATCH_ERROR) return MATCH_ERROR; if (is_type_attr_spec == MATCH_YES) @@ -9944,10 +9941,10 @@ gfc_match_derived_decl (void) /* Deal with derived type extensions. The extension attribute has been added to 'attr' but now the parent type must be found and checked. */ - if (parent[0]) + if (parent != NULL) extended = check_extended_derived_type (parent); - if (parent[0] && !extended) + if (parent != NULL && !extended) return MATCH_ERROR; m = gfc_match (" ::"); @@ -9961,7 +9958,7 @@ gfc_match_derived_decl (void) return MATCH_ERROR; } - m = gfc_match (" %n ", name); + m = gfc_match (" %n ", &name); if (m != MATCH_YES) return m; @@ -10474,7 +10471,7 @@ match_binding_attributes (gfc_typebound_proc* ba, bool generic, bool ppc) goto error; if (m == MATCH_YES) { - char arg[GFC_MAX_SYMBOL_LEN + 1]; + const char *arg = NULL; if (found_passing) { @@ -10483,11 +10480,11 @@ match_binding_attributes (gfc_typebound_proc* ba, bool generic, bool ppc) goto error; } - m = gfc_match (" ( %n )", arg); + m = gfc_match (" ( %n )", &arg); if (m == MATCH_ERROR) goto error; if (m == MATCH_YES) - ba->pass_arg = gfc_get_string ("%s", arg); + ba->pass_arg = arg; gcc_assert ((m == MATCH_YES) == (ba->pass_arg != NULL)); found_passing = true; diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 6a5fe928b93..19a0eb28edd 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -120,7 +120,7 @@ fold_unary_intrinsic (gfc_intrinsic_op op) beyond GFC_INTRINSIC_END in gfortran.h:enum gfc_intrinsic_op. */ static gfc_intrinsic_op -dtio_op (char* mode) +dtio_op (const char* mode) { if (strncmp (mode, "formatted", 9) == 0) return INTRINSIC_FORMATTED; @@ -139,7 +139,6 @@ gfc_match_generic_spec (interface_type *type, const char *&name, gfc_intrinsic_op *op) { - char buffer[GFC_MAX_SYMBOL_LEN + 1]; match m; gfc_intrinsic_op i; @@ -178,9 +177,9 @@ gfc_match_generic_spec (interface_type *type, return MATCH_YES; } - if (gfc_match (" read ( %n )", buffer) == MATCH_YES) + if (gfc_match (" read ( %n )", &name) == MATCH_YES) { - *op = dtio_op (buffer); + *op = dtio_op (name); if (*op == INTRINSIC_FORMATTED) { name = gfc_code2string (dtio_procs, DTIO_RF); @@ -195,9 +194,9 @@ gfc_match_generic_spec (interface_type *type, return MATCH_YES; } - if (gfc_match (" write ( %n )", buffer) == MATCH_YES) + if (gfc_match (" write ( %n )", &name) == MATCH_YES) { - *op = dtio_op (buffer); + *op = dtio_op (name); if (*op == INTRINSIC_FORMATTED) { name = gfc_code2string (dtio_procs, DTIO_WF); diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index 1d07076c377..ab7e0f7bd04 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -3077,7 +3077,7 @@ check_namelist (gfc_symbol *sym) static match match_dt_element (io_kind k, gfc_dt *dt) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_symbol *sym; match m; @@ -3095,7 +3095,7 @@ match_dt_element (io_kind k, gfc_dt *dt) return m; } - if (gfc_match (" nml = %n", name) == MATCH_YES) + if (gfc_match (" nml = %n", &name) == MATCH_YES) { if (dt->namelist != NULL) { diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index f3ad91a07c0..1b03e7251a5 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -606,12 +606,12 @@ cleanup: match gfc_match_label (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; match m; gfc_new_block = NULL; - m = gfc_match (" %n :", name); + m = gfc_match (" %n :", &name); if (m != MATCH_YES) return m; @@ -991,7 +991,7 @@ gfc_match_intrinsic_op (gfc_intrinsic_op *result) match gfc_match_iterator (gfc_iterator *iter, int init_flag) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_expr *var, *e1, *e2, *e3; locus start; match m; @@ -1001,7 +1001,7 @@ gfc_match_iterator (gfc_iterator *iter, int init_flag) /* Match the start of an iterator without affecting the symbol table. */ start = gfc_current_locus; - m = gfc_match (" %n =", name); + m = gfc_match (" %n =", &name); gfc_current_locus = start; if (m != MATCH_YES) @@ -1110,7 +1110,7 @@ gfc_match_char (char c) %% Literal percent sign %e Expression, pointer to a pointer is set %s Symbol, pointer to the symbol is set - %n Name, character buffer is set to name + %n Name, pointer to pointer is set %t Matches end of statement. %o Matches an intrinsic operator, returned as an INTRINSIC enum. %l Matches a statement label @@ -1124,8 +1124,7 @@ gfc_match (const char *target, ...) int matches, *ip; locus old_loc; va_list argp; - char c, *np; - const char *name2_hack = NULL; + char c; match m, n; void **vp; const char *p; @@ -1188,14 +1187,13 @@ loop: goto loop; case 'n': - np = va_arg (argp, char *); - n = gfc_match_name (&name2_hack); + vp = va_arg (argp, void **); + n = gfc_match_name ((const char **) vp); if (n != MATCH_YES) { m = n; goto not_yes; } - strcpy (np, name2_hack); matches++; goto loop; @@ -1893,7 +1891,8 @@ gfc_match_associate (void) gfc_association_list* a; /* Match the next association. */ - if (gfc_match (" %n =>", newAssoc->name) != MATCH_YES) + const char *name_hack = NULL; + if (gfc_match (" %n =>", &name_hack) != MATCH_YES) { gfc_error ("Expected association at %C"); goto assocListError; @@ -1910,6 +1909,7 @@ gfc_match_associate (void) } gfc_matching_procptr_assignment = 0; } + strcpy (newAssoc->name, name_hack); newAssoc->where = gfc_current_locus; /* Check that the current name is not yet in the list. */ @@ -1978,7 +1978,7 @@ error: static match match_derived_type_spec (gfc_typespec *ts) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; locus old_locus; gfc_symbol *derived, *der_type; match m = MATCH_YES; @@ -1987,7 +1987,7 @@ match_derived_type_spec (gfc_typespec *ts) old_locus = gfc_current_locus; - if (gfc_match ("%n", name) != MATCH_YES) + if (gfc_match ("%n", &name) != MATCH_YES) { gfc_current_locus = old_locus; return MATCH_NO; @@ -2064,7 +2064,8 @@ gfc_match_type_spec (gfc_typespec *ts) { match m; locus old_locus; - char c, name[GFC_MAX_SYMBOL_LEN + 1]; + char c; + const char *name = NULL; gfc_clear_ts (ts); gfc_gobble_whitespace (); @@ -2131,7 +2132,7 @@ gfc_match_type_spec (gfc_typespec *ts) written the use of LOGICAL as a type-spec or intrinsic subprogram was overlooked. */ - m = gfc_match (" %n", name); + m = gfc_match (" %n", &name); if (m == MATCH_YES && (strcmp (name, "real") == 0 || strcmp (name, "logical") == 0)) { @@ -2173,7 +2174,7 @@ gfc_match_type_spec (gfc_typespec *ts) /* Look for the optional KIND=. */ where = gfc_current_locus; - m = gfc_match ("%n", name); + m = gfc_match ("%n", &name); /* ??? maybe don't hash into identifier ?*/ if (m == MATCH_YES) { gfc_gobble_whitespace (); @@ -2710,10 +2711,10 @@ match_exit_cycle (gfc_statement st, gfc_exec_op op) sym = NULL; else { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_symtree* stree; - m = gfc_match ("% %n%t", name); + m = gfc_match ("% %n%t", &name); if (m == MATCH_ERROR) return MATCH_ERROR; if (m == MATCH_NO) @@ -4130,9 +4131,9 @@ gfc_match_allocate (void) goto cleanup; else if (m == MATCH_NO) { - char name[GFC_MAX_SYMBOL_LEN + 3]; + const char *name = NULL; - if (gfc_match ("%n :: ", name) == MATCH_YES) + if (gfc_match ("%n :: ", &name) == MATCH_YES) { gfc_error ("Error in type-spec at %L", &old_locus); goto cleanup; @@ -4856,7 +4857,7 @@ match_typebound_call (gfc_symtree* varst) match gfc_match_call (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_actual_arglist *a, *arglist; gfc_case *new_case; gfc_symbol *sym; @@ -4867,7 +4868,7 @@ gfc_match_call (void) arglist = NULL; - m = gfc_match ("% %n", name); + m = gfc_match ("% %n", &name); if (m == MATCH_NO) goto syntax; if (m != MATCH_YES) @@ -4937,10 +4938,9 @@ gfc_match_call (void) { gfc_symtree *select_st; gfc_symbol *select_sym; - char name[GFC_MAX_SYMBOL_LEN + 1]; new_st.next = c = gfc_get_code (EXEC_SELECT); - sprintf (name, "_result_%s", sym->name); + name = gfc_get_string ("_result_%s", sym->name); gfc_get_ha_sym_tree (name, &select_st); /* Can't fail. */ select_sym = select_st->n.sym; @@ -5263,7 +5263,7 @@ cleanup: match gfc_match_block_data (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_symbol *sym; match m; @@ -5277,7 +5277,7 @@ gfc_match_block_data (void) return MATCH_YES; } - m = gfc_match ("% %n%t", name); + m = gfc_match ("% %n%t", &name); if (m != MATCH_YES) return MATCH_ERROR; @@ -6095,7 +6095,7 @@ select_intrinsic_set_tmp (gfc_typespec *ts) static void select_type_set_tmp (gfc_typespec *ts) { - char name[GFC_MAX_SYMBOL_LEN]; + const char *name = NULL; gfc_symtree *tmp = NULL; if (!ts) @@ -6112,9 +6112,9 @@ select_type_set_tmp (gfc_typespec *ts) return; if (ts->type == BT_CLASS) - sprintf (name, "__tmp_class_%s", ts->u.derived->name); + name = gfc_get_string ("__tmp_class_%s", ts->u.derived->name); else - sprintf (name, "__tmp_type_%s", ts->u.derived->name); + name = gfc_get_string ("__tmp_type_%s", ts->u.derived->name); gfc_get_sym_tree (name, gfc_current_ns, &tmp, false); gfc_add_type (tmp->n.sym, ts, NULL); @@ -6163,7 +6163,7 @@ gfc_match_select_type (void) { gfc_expr *expr1, *expr2 = NULL; match m; - char name[GFC_MAX_SYMBOL_LEN]; + const char *name = NULL; bool class_array; gfc_symbol *sym; gfc_namespace *ns = gfc_current_ns; @@ -6177,7 +6177,7 @@ gfc_match_select_type (void) return m; gfc_current_ns = gfc_build_block_ns (ns); - m = gfc_match (" %n => %e", name, &expr2); + m = gfc_match (" %n => %e", &name, &expr2); if (m == MATCH_YES) { expr1 = gfc_get_expr (); diff --git a/gcc/fortran/matchexp.c b/gcc/fortran/matchexp.c index bb01af9f636..6e82f5c3ca5 100644 --- a/gcc/fortran/matchexp.c +++ b/gcc/fortran/matchexp.c @@ -44,14 +44,14 @@ gfc_match_defined_op_name (const char *&result, int error_flag, NULL }; - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; locus old_loc; match m; int i; old_loc = gfc_current_locus; - m = gfc_match (" . %n .", name); + m = gfc_match (" . %n .", &name); if (m != MATCH_YES) return m; diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 1064f3c80cb..8628f3aeda9 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -519,7 +519,7 @@ free_rename (gfc_use_rename *list) match gfc_match_use (void) { - char module_nature[GFC_MAX_SYMBOL_LEN + 1]; + const char *module_nature = NULL; const char *name = NULL; gfc_use_rename *tail = NULL, *new_use; interface_type type, type2; @@ -531,7 +531,7 @@ gfc_match_use (void) if (gfc_match (" , ") == MATCH_YES) { - if ((m = gfc_match (" %n ::", module_nature)) == MATCH_YES) + if ((m = gfc_match (" %n ::", &module_nature)) == MATCH_YES) { if (!gfc_notify_std (GFC_STD_F2003, "module " "nature in USE statement at %C")) @@ -555,7 +555,7 @@ gfc_match_use (void) { /* Help output a better error message than "Unclassifiable statement". */ - gfc_match (" %n", module_nature); + gfc_match (" %n", &module_nature); if (strcmp (module_nature, "intrinsic") == 0 || strcmp (module_nature, "non_intrinsic") == 0) gfc_error ("\"::\" was expected after module nature at %C " @@ -738,7 +738,7 @@ match gfc_match_submodule (void) { match m; - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_use_list *use_list; bool seen_colon = false; @@ -760,7 +760,7 @@ gfc_match_submodule (void) while (1) { - m = gfc_match (" %n", name); + m = gfc_match (" %n", &name); if (m != MATCH_YES) goto syntax; @@ -781,7 +781,7 @@ gfc_match_submodule (void) else { module_list = use_list; - use_list->module_name = gfc_get_string ("%s", name); + use_list->module_name = name; use_list->submodule_name = use_list->module_name; } diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 10a5df92e61..08bc05cbc28 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -94,7 +94,6 @@ gfc_free_omp_clauses (gfc_omp_clauses *c) gfc_free_omp_namelist (c->lists[i]); gfc_free_expr_list (c->wait_list); gfc_free_expr_list (c->tile_list); - free (CONST_CAST (char *, c->critical_name)); free (c); } @@ -226,7 +225,7 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list, { gfc_omp_namelist *head, *tail, *p; locus old_loc, cur_loc; - char n[GFC_MAX_SYMBOL_LEN+1]; + const char *name = NULL; gfc_symbol *sym; match m; gfc_symtree *st; @@ -284,16 +283,16 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list, if (!allow_common) goto syntax; - m = gfc_match (" / %n /", n); + m = gfc_match (" / %n /", &name); if (m == MATCH_ERROR) goto cleanup; if (m == MATCH_NO) goto syntax; - st = gfc_find_symtree (gfc_current_ns->common_root, n); + st = gfc_find_symtree (gfc_current_ns->common_root, name); if (st == NULL) { - gfc_error ("COMMON block /%s/ not found at %C", n); + gfc_error ("COMMON block /%s/ not found at %C", name); goto cleanup; } for (sym = st->n.common->head; sym; sym = sym->common_next) @@ -348,7 +347,7 @@ gfc_match_omp_to_link (const char *str, gfc_omp_namelist **list) { gfc_omp_namelist *head, *tail, *p; locus old_loc, cur_loc; - char n[GFC_MAX_SYMBOL_LEN+1]; + const char *name = NULL; gfc_symbol *sym; match m; gfc_symtree *st; @@ -385,16 +384,16 @@ gfc_match_omp_to_link (const char *str, gfc_omp_namelist **list) goto cleanup; } - m = gfc_match (" / %n /", n); + m = gfc_match (" / %n /", &name); if (m == MATCH_ERROR) goto cleanup; if (m == MATCH_NO) goto syntax; - st = gfc_find_symtree (gfc_current_ns->common_root, n); + st = gfc_find_symtree (gfc_current_ns->common_root, name); if (st == NULL) { - gfc_error ("COMMON block /%s/ not found at %C", n); + gfc_error ("COMMON block /%s/ not found at %C", name); goto cleanup; } p = gfc_get_omp_namelist (); @@ -636,7 +635,7 @@ gfc_match_oacc_clause_link (const char *str, gfc_omp_namelist **list) gfc_omp_namelist *head = NULL; gfc_omp_namelist *tail, *p; locus old_loc; - char n[GFC_MAX_SYMBOL_LEN+1]; + const char *name = NULL; gfc_symbol *sym; match m; gfc_symtree *st; @@ -680,16 +679,16 @@ gfc_match_oacc_clause_link (const char *str, gfc_omp_namelist **list) goto cleanup; } - m = gfc_match (" / %n /", n); + m = gfc_match (" / %n /", &name); if (m == MATCH_ERROR) goto cleanup; - if (m == MATCH_NO || n[0] == '\0') + if (m == MATCH_NO) goto syntax; - st = gfc_find_symtree (gfc_current_ns->common_root, n); + st = gfc_find_symtree (gfc_current_ns->common_root, name); if (st == NULL) { - gfc_error ("COMMON block /%s/ not found at %C", n); + gfc_error ("COMMON block /%s/ not found at %C", name); goto cleanup; } @@ -2451,12 +2450,11 @@ match_omp (gfc_exec_op op, const omp_mask mask) match gfc_match_omp_critical (void) { - char n[GFC_MAX_SYMBOL_LEN+1]; + const char *name = NULL; gfc_omp_clauses *c = NULL; - if (gfc_match (" ( %n )", n) != MATCH_YES) + if (gfc_match (" ( %n )", &name) != MATCH_YES) { - n[0] = '\0'; if (gfc_match_omp_eos () != MATCH_YES) { gfc_error ("Unexpected junk after $OMP CRITICAL statement at %C"); @@ -2468,8 +2466,8 @@ gfc_match_omp_critical (void) new_st.op = EXEC_OMP_CRITICAL; new_st.ext.omp_clauses = c; - if (n[0]) - c->critical_name = xstrdup (n); + if (name != NULL) + c->critical_name = name; return MATCH_YES; } @@ -2477,10 +2475,9 @@ gfc_match_omp_critical (void) match gfc_match_omp_end_critical (void) { - char n[GFC_MAX_SYMBOL_LEN+1]; + const char *name = NULL; - if (gfc_match (" ( %n )", n) != MATCH_YES) - n[0] = '\0'; + gfc_match (" ( %n )", &name); if (gfc_match_omp_eos () != MATCH_YES) { gfc_error ("Unexpected junk after $OMP CRITICAL statement at %C"); @@ -2488,7 +2485,7 @@ gfc_match_omp_end_critical (void) } new_st.op = EXEC_OMP_END_CRITICAL; - new_st.ext.omp_name = n[0] ? xstrdup (n) : NULL; + new_st.ext.omp_name = name; return MATCH_YES; } @@ -2601,7 +2598,7 @@ match_udr_expr (gfc_symtree *omp_sym1, gfc_symtree *omp_sym2) { match m; locus old_loc = gfc_current_locus; - char sname[GFC_MAX_SYMBOL_LEN + 1]; + const char *sname = NULL; gfc_symbol *sym; gfc_namespace *ns = gfc_current_ns; gfc_expr *lvalue = NULL, *rvalue = NULL; @@ -2627,7 +2624,7 @@ match_udr_expr (gfc_symtree *omp_sym1, gfc_symtree *omp_sym2) gfc_free_expr (lvalue); } - m = gfc_match (" %n", sname); + m = gfc_match (" %n", &sname); if (m != MATCH_YES) return false; @@ -2799,8 +2796,7 @@ gfc_match_omp_declare_reduction (void) { match m; gfc_intrinsic_op op; - char name[GFC_MAX_SYMBOL_LEN + 3]; - const char *oper = NULL; + const char *name = NULL; auto_vec tss; gfc_typespec ts; unsigned int i; @@ -2818,24 +2814,22 @@ gfc_match_omp_declare_reduction (void) return MATCH_ERROR; if (m == MATCH_YES) { - oper = gfc_get_string ("operator %s", gfc_op2string (op)); - strcpy (name, oper); + name = gfc_get_string ("operator %s", gfc_op2string (op)); rop = (gfc_omp_reduction_op) op; } else { - m = gfc_match_defined_op_name (oper, 1, 1); + m = gfc_match_defined_op_name (name, 1, 1); if (m == MATCH_ERROR) return MATCH_ERROR; if (m == MATCH_YES) { if (gfc_match (" : ") != MATCH_YES) return MATCH_ERROR; - strcpy (name, oper); } else { - if (gfc_match (" %n : ", name) != MATCH_YES) + if (gfc_match (" %n : ", &name) != MATCH_YES) return MATCH_ERROR; } rop = OMP_REDUCTION_USER; @@ -2869,7 +2863,7 @@ gfc_match_omp_declare_reduction (void) const char *predef_name = NULL; omp_udr = gfc_get_omp_udr (); - omp_udr->name = gfc_get_string ("%s", name); + omp_udr->name = name; omp_udr->rop = rop; omp_udr->ts = tss[i]; omp_udr->where = where; @@ -3132,7 +3126,7 @@ match gfc_match_omp_threadprivate (void) { locus old_loc; - char n[GFC_MAX_SYMBOL_LEN+1]; + const char *name = NULL; gfc_symbol *sym; match m; gfc_symtree *st; @@ -3161,16 +3155,16 @@ gfc_match_omp_threadprivate (void) goto cleanup; } - m = gfc_match (" / %n /", n); + m = gfc_match (" / %n /", &name); if (m == MATCH_ERROR) goto cleanup; - if (m == MATCH_NO || n[0] == '\0') + if (m == MATCH_NO) goto syntax; - st = gfc_find_symtree (gfc_current_ns->common_root, n); + st = gfc_find_symtree (gfc_current_ns->common_root, name); if (st == NULL) { - gfc_error ("COMMON block /%s/ not found at %C", n); + gfc_error ("COMMON block /%s/ not found at %C", name); goto cleanup; } st->n.common->threadprivate = 1; diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 13cc6f5fccd..880671b57f4 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -3590,7 +3590,7 @@ match_deferred_characteristics (gfc_typespec * ts) { locus loc; match m = MATCH_ERROR; - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; loc = gfc_current_locus; @@ -3616,7 +3616,7 @@ match_deferred_characteristics (gfc_typespec * ts) /* Set the function locus correctly. If we have not found the function name, there is an error. */ if (m == MATCH_YES - && gfc_match ("function% %n", name) == MATCH_YES + && gfc_match ("function% %n", &name) == MATCH_YES && strcmp (name, gfc_current_block ()->name) == 0) { gfc_current_block ()->declared_at = gfc_current_locus; @@ -5228,7 +5228,6 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only) new_st.ext.omp_name) != 0)) gfc_error ("Name after !$omp critical and !$omp end critical does " "not match at %C"); - free (CONST_CAST (char *, new_st.ext.omp_name)); new_st.ext.omp_name = NULL; break; case EXEC_OMP_END_SINGLE: diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index b30938ef61c..da661372c5c 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -1692,7 +1692,7 @@ cleanup: static match match_arg_list_function (gfc_actual_arglist *result) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; locus old_locus; match m; @@ -1704,7 +1704,7 @@ match_arg_list_function (gfc_actual_arglist *result) goto cleanup; } - m = gfc_match ("%n (", name); + m = gfc_match ("%n (", &name); if (m != MATCH_YES) goto cleanup; @@ -3144,7 +3144,7 @@ match gfc_match_rvalue (gfc_expr **result) { gfc_actual_arglist *actual_arglist; - char argname[GFC_MAX_SYMBOL_LEN + 1]; + const char *argname = NULL; const char *name = NULL; gfc_state_data *st; gfc_symbol *sym; @@ -3526,7 +3526,7 @@ gfc_match_rvalue (gfc_expr **result) symbol would end up in the symbol table. */ old_loc = gfc_current_locus; - m2 = gfc_match (" ( %n =", argname); + m2 = gfc_match (" ( %n =", &argname); gfc_current_locus = old_loc; e = gfc_get_expr (); From patchwork Wed Sep 5 14:57:09 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Bernhard Reutner-Fischer X-Patchwork-Id: 966427 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-485224-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="gCrUArj+"; dkim=pass (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="h5IZxpjL"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4256LM4L6Rz9sCn for ; Thu, 6 Sep 2018 00:59:39 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; q=dns; s=default; b=bMW seBnPfrGlkkJe11ANZWf0I0G0rg9+oAjs379jvBgQcXURTpnZAxtJH7edG6PLCjg msZBwtCPZXlgHPKbXwnM9VypOzrzZqOZ0xpSuTfSeDCZQxA7z7NyTjnfG6aEcVQF I6p6Qkezo72/76nC+kFW2JlagCJ4aJLKPp87SBIg= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; s=default; bh=QO/M9yprr oqnxcNZNBqatj/fIe4=; b=gCrUArj+nYGIM3wBX+BVYxHf9ekxld4axkGMLR+cy QnekzMUImBmISOwEAw7kJwln/m/Y+sbsUxygYQ/bsCnsVFnHDdzv/nDXpQG0IWWd ThenpdhVM01LYUUYq7QHynpUkK+DO+wkk2GB+aysdd5HNBYUEnrJnLkD2DVZn21y WY= Received: (qmail 68501 invoked by alias); 5 Sep 2018 14:57:54 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 68216 invoked by uid 89); 5 Sep 2018 14:57:51 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.5 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=Hx-languages-length:1735, H*Ad:U*aldot, HContent-Transfer-Encoding:8bit X-HELO: mail-wm0-f41.google.com Received: from mail-wm0-f41.google.com (HELO mail-wm0-f41.google.com) (74.125.82.41) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 05 Sep 2018 14:57:50 +0000 Received: by mail-wm0-f41.google.com with SMTP id s12-v6so8356370wmc.0; Wed, 05 Sep 2018 07:57:49 -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=nLSr2Fb7+GgCLPGdQhm3icYIhZiLzTrYRy+eBhBK2FI=; b=h5IZxpjLkyWsp9fnXTpgpFX/FbdlhrHbLpRpKJjNQfEr8DvZuif9+SZOvIkNQlPVq9 8wRNoeIWsb7UwFH4KsPo3ojwDwqrDo4OPsdGXGxdQlGyDZJV7QICHYopaD2oKjLMtH/w tVNNzfQf94KYNuCmbe9zvdV3qmnI6Aea68K7zeUZpKIpYvakAEjak2e8/B75v2m+QqDM H2/uxG2PU3SZuuxrJuz5iIFA3TJnYkoFCWaVAFSpFVx9V2RGQiQ+10YAUjjMf/DmzeQ+ KCBQk3UDj+ftbJPfljfHT2Qn2bWIK5/ltc4AEBH3PmU/VXPwojEZkM+maqkmt3cvle2s dNMA== Received: from s46.loc (91-119-125-11.dsl.dynamic.surfer.at. [91.119.125.11]) by smtp.gmail.com with ESMTPSA id t9-v6sm3523680wra.91.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 1fxZFY-00007W-3x; Wed, 05 Sep 2018 14:57:44 +0000 From: Bernhard Reutner-Fischer To: fortran@gcc.gnu.org Cc: Bernhard Reutner-Fischer , gcc-patches@gcc.gnu.org Subject: [PATCH,FORTRAN 06/29] Use stringpool for association_list Date: Wed, 5 Sep 2018 14:57:09 +0000 Message-Id: <20180905145732.404-7-rep.dot.nop@gmail.com> In-Reply-To: References: MIME-Version: 1.0 X-IsSubscribed: yes From: Bernhard Reutner-Fischer 2017-10-26 Bernhard Reutner-Fischer * gfortran.h (struct gfc_association_list): Change name to pointer. * match.c (gfc_match_associate): Adjust. --- gcc/fortran/gfortran.h | 2 +- gcc/fortran/match.c | 6 ++---- 2 files changed, 3 insertions(+), 5 deletions(-) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 774a6de6168..ff42b39b453 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2482,7 +2482,7 @@ typedef struct gfc_association_list /* True when the rank of the target expression is guessed during parsing. */ unsigned rankguessed:1; - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name; gfc_symtree *st; /* Symtree corresponding to name. */ locus where; diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 1b03e7251a5..38827ed4637 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -1891,8 +1891,7 @@ gfc_match_associate (void) gfc_association_list* a; /* Match the next association. */ - const char *name_hack = NULL; - if (gfc_match (" %n =>", &name_hack) != MATCH_YES) + if (gfc_match (" %n =>", &newAssoc->name) != MATCH_YES) { gfc_error ("Expected association at %C"); goto assocListError; @@ -1909,12 +1908,11 @@ gfc_match_associate (void) } gfc_matching_procptr_assignment = 0; } - strcpy (newAssoc->name, name_hack); newAssoc->where = gfc_current_locus; /* Check that the current name is not yet in the list. */ for (a = new_st.ext.block.assoc; a; a = a->next) - if (!strcmp (a->name, newAssoc->name)) + if (a->name == newAssoc->name) { gfc_error ("Duplicate name %qs in association at %C", newAssoc->name); From patchwork Wed Sep 5 14:57:10 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Bernhard Reutner-Fischer X-Patchwork-Id: 966426 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-485223-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="eFhc6aco"; dkim=pass (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="F4Fa3cJe"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4256Kz3m12z9sCn for ; Thu, 6 Sep 2018 00:59:19 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; q=dns; s=default; b=Beh y6kXrcyS3m//mTp9WHJ83YulKdxKTaCSMDKFGjE14WHL82HFeKgGT3E+4N8yxbQB XdQWzjwlb/f/CLWuOabd8YMgbHtnZBch4ETkOUZ4PHs0pAEGEvACu0hnxMRjBz8T hVe4FBAkFgtP+CjcgxQZK9jkH21kQV4pZOghVUsE= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; s=default; bh=h99i5xCvJ W68Sm5/3XbyuIWHX/s=; b=eFhc6aco00OQZuvmgtqr1fR+ydfyLvVJwSvK/B2lH 4l+b6Q+biu0AKZCPN7pA5UpeTDt9MuUd44NVRZ2/t8MTNxDRgQ1Zs6adlC9jkZ09 XHtCV5qM9AUa/L0AK7S4kihCUu53DRT5qmVHmvAG028Mx/A/2ZA12nh9hn5qnvCQ N4= Received: (qmail 68357 invoked by alias); 5 Sep 2018 14:57:53 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 68058 invoked by uid 89); 5 Sep 2018 14:57:51 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.4 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, HContent-Transfer-Encoding:8bit X-HELO: mail-wr1-f52.google.com Received: from mail-wr1-f52.google.com (HELO mail-wr1-f52.google.com) (209.85.221.52) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 05 Sep 2018 14:57:49 +0000 Received: by mail-wr1-f52.google.com with SMTP id a108-v6so7956255wrc.13; Wed, 05 Sep 2018 07:57:49 -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=2hVyzFEegswvhab18QLj7jCaMRhLv58BnbCRL/0ik+Q=; b=F4Fa3cJeWkSyFXGf8xlL8mpmoUl4JYzdh6ZShNHPn94hUaEnrR5OXyE3DL26Z/xvd8 BqPz5zIMT/mRiRC2USKRnqdNDDR/G7RWbcxuLUfWY2SQPX89154sJhLmR4dGGyAOnmE/ wTAeef2/tLCbD3QQpbhNor/bIZ9xfiDiIwfOtkeSRET7EbzNfxGb9e3cmf96T+WGim4j CS61VUb2jsK//maSU2UaR0OTIxPH8yXWdsPHHHtX5BHkZnndoTQF7xqz5C5ZV3dxkkvL +/iiCHIzzilekwOiWWxlEUooQCLOCye19XlR7LITHtzqgI4X2NlM5g5qKYAlI30tfIcQ ixew== Received: from s46.loc (91-119-125-11.dsl.dynamic.surfer.at. [91.119.125.11]) by smtp.gmail.com with ESMTPSA id o33-v6sm2948820wrf.11.2018.09.05.07.57.45 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 05 Sep 2018 07:57:47 -0700 (PDT) Received: from cow by s46.loc with local (Exim 4.91) (envelope-from ) id 1fxZFY-00007Z-9X; Wed, 05 Sep 2018 14:57:44 +0000 From: Bernhard Reutner-Fischer To: fortran@gcc.gnu.org Cc: Bernhard Reutner-Fischer , gcc-patches@gcc.gnu.org Subject: [PATCH, FORTRAN 07/29] Use stringpool for some gfc_code2string return values Date: Wed, 5 Sep 2018 14:57:10 +0000 Message-Id: <20180905145732.404-8-rep.dot.nop@gmail.com> In-Reply-To: References: MIME-Version: 1.0 X-IsSubscribed: yes From: Bernhard Reutner-Fischer Use a stringpool-node for those gfc_code2string values that are used as names. gcc/fortran/ChangeLog: 2017-10-26 Bernhard Reutner-Fischer * interface.c (gfc_match_generic_spec, gfc_check_dtio_interfaces, gfc_find_typebound_dtio_proc, gfc_find_specific_dtio_proc): Use stringpool node for those return values of gfc_code2string that are used as names. --- gcc/fortran/interface.c | 50 ++++++++++++++++------------------------- 1 file changed, 19 insertions(+), 31 deletions(-) diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 19a0eb28edd..8716813b7b2 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -182,12 +182,12 @@ gfc_match_generic_spec (interface_type *type, *op = dtio_op (name); if (*op == INTRINSIC_FORMATTED) { - name = gfc_code2string (dtio_procs, DTIO_RF); + name = gfc_get_string ("%s", gfc_code2string (dtio_procs, DTIO_RF)); *type = INTERFACE_DTIO; } if (*op == INTRINSIC_UNFORMATTED) { - name = gfc_code2string (dtio_procs, DTIO_RUF); + name = gfc_get_string ("%s", gfc_code2string (dtio_procs, DTIO_RUF)); *type = INTERFACE_DTIO; } if (*op != INTRINSIC_NONE) @@ -199,12 +199,12 @@ gfc_match_generic_spec (interface_type *type, *op = dtio_op (name); if (*op == INTRINSIC_FORMATTED) { - name = gfc_code2string (dtio_procs, DTIO_WF); + name = gfc_get_string ("%s", gfc_code2string (dtio_procs, DTIO_WF)); *type = INTERFACE_DTIO; } if (*op == INTRINSIC_UNFORMATTED) { - name = gfc_code2string (dtio_procs, DTIO_WUF); + name = gfc_get_string ("%s", gfc_code2string (dtio_procs, DTIO_WUF)); *type = INTERFACE_DTIO; } if (*op != INTRINSIC_NONE) @@ -4927,8 +4927,8 @@ gfc_check_dtio_interfaces (gfc_symbol *derived) || ((dtio_codes)code == DTIO_WF); tb_io_st = gfc_find_typebound_proc (derived, &t, - gfc_code2string (dtio_procs, code), - true, &derived->declared_at); + gfc_get_string ("%s", gfc_code2string (dtio_procs, code)), + true, &derived->declared_at); if (tb_io_st != NULL) check_dtio_interface1 (derived, tb_io_st, true, formatted, code); } @@ -4940,7 +4940,7 @@ gfc_check_dtio_interfaces (gfc_symbol *derived) || ((dtio_codes)code == DTIO_WF); tb_io_st = gfc_find_symtree (derived->ns->sym_root, - gfc_code2string (dtio_procs, code)); + gfc_get_string ("%s", gfc_code2string (dtio_procs, code))); if (tb_io_st != NULL) check_dtio_interface1 (derived, tb_io_st, false, formatted, code); } @@ -4961,31 +4961,23 @@ gfc_find_typebound_dtio_proc (gfc_symbol *derived, bool write, bool formatted) { if (write == true) tb_io_st = gfc_find_typebound_proc (derived, &t, - gfc_code2string (dtio_procs, - DTIO_WF), - true, - &derived->declared_at); + gfc_get_string ("%s", gfc_code2string (dtio_procs, DTIO_WF)), + true, &derived->declared_at); else tb_io_st = gfc_find_typebound_proc (derived, &t, - gfc_code2string (dtio_procs, - DTIO_RF), - true, - &derived->declared_at); + gfc_get_string ("%s", gfc_code2string (dtio_procs, DTIO_RF)), + true, &derived->declared_at); } else { if (write == true) tb_io_st = gfc_find_typebound_proc (derived, &t, - gfc_code2string (dtio_procs, - DTIO_WUF), - true, - &derived->declared_at); + gfc_get_string ("%s", gfc_code2string (dtio_procs, DTIO_WUF)), + true, &derived->declared_at); else tb_io_st = gfc_find_typebound_proc (derived, &t, - gfc_code2string (dtio_procs, - DTIO_RUF), - true, - &derived->declared_at); + gfc_get_string ("%s", gfc_code2string (dtio_procs, DTIO_RUF)), + true, &derived->declared_at); } return tb_io_st; } @@ -5041,23 +5033,19 @@ gfc_find_specific_dtio_proc (gfc_symbol *derived, bool write, bool formatted) { if (write == true) tb_io_st = gfc_find_symtree (extended->ns->sym_root, - gfc_code2string (dtio_procs, - DTIO_WF)); + gfc_get_string ("%s", gfc_code2string (dtio_procs, DTIO_WF))); else tb_io_st = gfc_find_symtree (extended->ns->sym_root, - gfc_code2string (dtio_procs, - DTIO_RF)); + gfc_get_string ("%s", gfc_code2string (dtio_procs, DTIO_RF))); } else { if (write == true) tb_io_st = gfc_find_symtree (extended->ns->sym_root, - gfc_code2string (dtio_procs, - DTIO_WUF)); + gfc_get_string ("%s", gfc_code2string (dtio_procs, DTIO_WUF))); else tb_io_st = gfc_find_symtree (extended->ns->sym_root, - gfc_code2string (dtio_procs, - DTIO_RUF)); + gfc_get_string ("%s", gfc_code2string (dtio_procs, DTIO_RUF))); } if (tb_io_st != NULL From patchwork Wed Sep 5 14:57:11 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Bernhard Reutner-Fischer X-Patchwork-Id: 966425 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-485222-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="aG0SMET5"; dkim=pass (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="ZBxUZQvA"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4256Kl6BkDz9sCn for ; Thu, 6 Sep 2018 00:59:07 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; q=dns; s=default; b=dYE SlcO3750SYIREOcQPVZ63TY1iTQeye/hEyorda76nRQ2XnV13NnZrhXScWPusyc7 qE7GozBO8ib5cfNL2CmjZXNj+vlkephFJ/oQwQZ8Q+7zt3HYIe1l8kh9N9mAYxVr 5kvIXZi9rbbCMCc5HCVNTV00V0NsO4zjEkM8yXOs= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; s=default; bh=dU80BdnjZ 1vny4TM7Ue9avLzhwY=; b=aG0SMET5vfzC6JcLe2M0wx/uV+uNxYLvXN5gf0YSh mS8sxPzoumR1q3MunuVThUI4GgD4n6XDxpvJyyc9pMmYzalB2Pquf7P/wDZcG3LL pQBbPg489rINDWoESFZsGffn0azqvix0NpXLMBzyUQC5iFjGK2v33a3rldDV2L29 a4= Received: (qmail 68320 invoked by alias); 5 Sep 2018 14:57:53 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 68054 invoked by uid 89); 5 Sep 2018 14:57:51 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.2 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, management, HContent-Transfer-Encoding:8bit X-HELO: mail-wr1-f41.google.com Received: from mail-wr1-f41.google.com (HELO mail-wr1-f41.google.com) (209.85.221.41) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 05 Sep 2018 14:57:49 +0000 Received: by mail-wr1-f41.google.com with SMTP id g33-v6so8045398wrd.1; Wed, 05 Sep 2018 07:57:49 -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=bn/U5UKqtMCOYhKCRgwt8j7UhDdYFp+4u9mW13k1kLE=; b=ZBxUZQvAeDZMRKE5/PO5whbNQuXVac/cmQugmBwQfFAsv1imhyHrEun50QqxvlDdc/ a+zM0t83jeqUrpjgD7NMh6fsG2hLNuqwVmaT1Z+P5rdjQTfJ2YliVNzvVNfQ9jyv7Jvx xvlLHMccLEAL/OgX7eLB1CFq1YoASCrKuCVlB5XRooiz4AYk7ZDPDACgaZLdEZuUv2vY HPAFwCTL250pJxOdcUJCeMuPqSEleIjRiBuG8p36ciOeKUir+bNnsTmQZn0V4GvMWrFw 9pUJbmBBMWexaHNXo4qqjWoxD8IWPKUs4pLCILSoPeqE8CoIB9j8k6zdrd6n3n9qy8ur p+ZA== Received: from s46.loc (91-119-125-11.dsl.dynamic.surfer.at. [91.119.125.11]) by smtp.gmail.com with ESMTPSA id 124-v6sm4021089wmk.20.2018.09.05.07.57.45 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 05 Sep 2018 07:57:47 -0700 (PDT) Received: from cow by s46.loc with local (Exim 4.91) (envelope-from ) id 1fxZFY-00007c-EJ; Wed, 05 Sep 2018 14:57:44 +0000 From: Bernhard Reutner-Fischer To: fortran@gcc.gnu.org Cc: Bernhard Reutner-Fischer , gcc-patches@gcc.gnu.org Subject: [PATCH,FORTRAN 08/29] Add uop/name helpers Date: Wed, 5 Sep 2018 14:57:11 +0000 Message-Id: <20180905145732.404-9-rep.dot.nop@gmail.com> In-Reply-To: References: MIME-Version: 1.0 X-IsSubscribed: yes From: Bernhard Reutner-Fischer Introduce a helper to construct a user operator from a name and the reverse operation, i.e. a helper to construct a name from a user operator. gcc/fortran/ChangeLog: 2017-10-29 Bernhard Reutner-Fischer * gfortran.h (gfc_get_uop_from_name): (gfc_get_name_from_uop): Declare. * symbol.c (gfc_get_uop_from_name): (gfc_get_name_from_uop): Define. * module.c (load_omp_udrs): Use them. --- gcc/fortran/gfortran.h | 2 ++ gcc/fortran/module.c | 21 +++------------------ gcc/fortran/symbol.c | 21 +++++++++++++++++++++ 3 files changed, 26 insertions(+), 18 deletions(-) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index ff42b39b453..6c32b8ac71f 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -3019,6 +3019,8 @@ void gfc_delete_symtree (gfc_symtree **, const char *); gfc_symtree *gfc_get_unique_symtree (gfc_namespace *); gfc_user_op *gfc_get_uop (const char *); gfc_user_op *gfc_find_uop (const char *, gfc_namespace *); +const char *gfc_get_uop_from_name (const char*); +const char *gfc_get_name_from_uop (const char*); void gfc_free_symbol (gfc_symbol *); void gfc_release_symbol (gfc_symbol *); gfc_symbol *gfc_new_symbol (const char *, gfc_namespace *); diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 8628f3aeda9..b3f68b8803f 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -4785,7 +4785,7 @@ load_omp_udrs (void) while (peek_atom () != ATOM_RPAREN) { const char *name = NULL, *newname; - char *altname; + const char *altname = NULL; gfc_typespec ts; gfc_symtree *st; gfc_omp_reduction_op rop = OMP_REDUCTION_USER; @@ -4812,15 +4812,8 @@ load_omp_udrs (void) else if (strcmp (p, ".neqv.") == 0) rop = OMP_REDUCTION_NEQV; } - altname = NULL; if (rop == OMP_REDUCTION_USER && name[0] == '.') - { - size_t len = strlen (name + 1); - altname = XALLOCAVEC (char, len); - gcc_assert (name[len] == '.'); - memcpy (altname, name + 1, len - 1); - altname[len - 1] = '\0'; - } + altname = gfc_get_name_from_uop (name); newname = name; if (rop == OMP_REDUCTION_USER) newname = find_use_name (altname ? altname : name, !!altname); @@ -4832,15 +4825,7 @@ load_omp_udrs (void) continue; } if (altname && newname != altname) - { - size_t len = strlen (newname); - altname = XALLOCAVEC (char, len + 3); - altname[0] = '.'; - memcpy (altname + 1, newname, len); - altname[len + 1] = '.'; - altname[len + 2] = '\0'; - name = gfc_get_string ("%s", altname); - } + name = altname = gfc_get_uop_from_name (newname); st = gfc_find_symtree (gfc_current_ns->omp_udr_root, name); gfc_omp_udr *udr = gfc_omp_udr_find (st, &ts); if (udr) diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 0a4f7c1711b..a8f841185f1 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -3026,6 +3026,27 @@ gfc_find_uop (const char *name, gfc_namespace *ns) return (st == NULL) ? NULL : st->n.uop; } +/* Given a name return a string usable as user operator name. */ +const char * +gfc_get_uop_from_name (const char* name) { + gcc_assert (name[0] != '.'); + return gfc_get_string (".%s.", name); +} + +/* Given a user operator name return a string usable as name. */ +const char * +gfc_get_name_from_uop (const char* name) { + gcc_assert (name[0] == '.'); + const size_t len = strlen (name) - 1; + gcc_assert (len > 1); + gcc_assert (name[len] == '.'); + char *buffer = XNEWVEC (char, len); + memcpy (buffer, name + 1, len - 1); + buffer[len - 1] = '\0'; + const char *ret = gfc_get_string ("%s", buffer); + XDELETEVEC (buffer); + return ret; +} /* Update a symbol's common_block field, and take care of the associated memory management. */ From patchwork Wed Sep 5 14:57:12 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Bernhard Reutner-Fischer X-Patchwork-Id: 966429 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-485226-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="NiOZjKtY"; dkim=pass (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="QfNv79Qi"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4256M15YByz9sRC for ; Thu, 6 Sep 2018 01:00:13 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; q=dns; s=default; b=LFG j+z03d8aumqhFVxBXk6LLF70ugMiVRw+/81aHzWcmZf6mmE9bj6eJnjTdcmij8/q Jy/KOhoQ9tPKeTRvSDeTUWxDSBkJ8NUwClFwwD/E8jQxB3AEPCZ+J81FfNETeo1R PkBpwgtck2XofApQfGHmi/t0k+T/mcVJrvnmUXqY= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; s=default; bh=F6FZJ7Uqj 9X4S6MansiKQCiukMQ=; b=NiOZjKtYLXCwD26fkhLXY2+mm11Y8c3XJSF7vW/CU no7GUt7rq5wNUhyHORBnVPd9D/+IHJRS0pradaCSMOiylgshPfHJQtS4LMknuKBq JEofFT4VVI9USQ3+envInTyrOOnFj9DdKgm+VZ/0ocZX17FQqgAqNblv51ZgnF2D Cs= Received: (qmail 68882 invoked by alias); 5 Sep 2018 14:57:56 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 68418 invoked by uid 89); 5 Sep 2018 14:57:53 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.6 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=rent, st, sk:number_, everybody X-HELO: mail-wr1-f44.google.com Received: from mail-wr1-f44.google.com (HELO mail-wr1-f44.google.com) (209.85.221.44) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 05 Sep 2018 14:57:51 +0000 Received: by mail-wr1-f44.google.com with SMTP id a108-v6so7956357wrc.13; Wed, 05 Sep 2018 07:57:50 -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=GWDqo4NELDBsqIo5Q4nKJ3hHTHtQcf3FrfRJgdKVWQU=; b=QfNv79QiIMOkUydhePT3XK7haE5ihRKsn6yMRIg4iMuzeuLEvZShUWx7Yac9ohP2NG u7N1M3lC44i4fCVOWD7bxtoZ/58umyQGfbmsNwM01L2Y7DTpMjPmJxYvk2weDG5P1f7V XTB2Mbt5y0ALdyQEwDJFjCU3+SJYtnOB83Itr4Zxl5CHwQzeNZTEvzPw1yEDzBOwJi0k vCh+UFami9UeDS5cOxMeM1nl8Cks53j+lwy58tLTKA56wusK6vaVue4qRqw8kcm+1t23 PK4MIX0gVmUNCFZeKqUd+lBNGMxO2JYvpXHnpSpNvWc4iVtNQKLxadi0Khc3QIE9ZL6o RQLw== Received: from s46.loc (91-119-125-11.dsl.dynamic.surfer.at. [91.119.125.11]) by smtp.gmail.com with ESMTPSA id v1-v6sm2968029wrt.34.2018.09.05.07.57.46 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 05 Sep 2018 07:57:48 -0700 (PDT) Received: from cow by s46.loc with local (Exim 4.91) (envelope-from ) id 1fxZFY-00007f-JF; Wed, 05 Sep 2018 14:57:44 +0000 From: Bernhard Reutner-Fischer To: fortran@gcc.gnu.org Cc: Bernhard Reutner-Fischer , gcc-patches@gcc.gnu.org Subject: [PATCH,FORTRAN 09/29] Use stringpool for modules Date: Wed, 5 Sep 2018 14:57:12 +0000 Message-Id: <20180905145732.404-10-rep.dot.nop@gmail.com> In-Reply-To: References: MIME-Version: 1.0 X-IsSubscribed: yes From: Bernhard Reutner-Fischer gcc/fortran/ChangeLog: 2017-10-29 Bernhard Reutner-Fischer * gfortran.h (struct gfc_use_rename): Use pointers for local_name and use_name. * match.c (gfc_match): Set name to NULL on failed match. * module.c (gfc_match_use): Use pointer comparison instead of string comparison. (find_use_name_n): Likewise. (mio_internal_string): Delete. (mio_expr): Simplify INTRINSIC_USER handling. (load_operator_interfaces): Use pointer for name and module. (load_generic_interfaces): Likewise. (load_commons): Use pointer for name. (load_needed): Use pointer comparison instead of string comparison. (read_module): Use pointer for name. Use pointer comparison instead if string comparison. (import_iso_c_binding_module): Adjust to struct gfc_use_rename changes. (use_iso_fortran_env_module): Likewise. * symbol.c (generate_isocbinding_symbol): Likewise. * trans-decl.c (gfc_trans_use_stmts): Likewise. --- gcc/fortran/gfortran.h | 3 +- gcc/fortran/match.c | 11 +++- gcc/fortran/module.c | 115 ++++++++++++++------------------------- gcc/fortran/symbol.c | 2 +- gcc/fortran/trans-decl.c | 8 +-- 5 files changed, 56 insertions(+), 83 deletions(-) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 6c32b8ac71f..cb9195d393e 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1673,7 +1673,8 @@ gfc_entry_list; typedef struct gfc_use_rename { - char local_name[GFC_MAX_SYMBOL_LEN + 1], use_name[GFC_MAX_SYMBOL_LEN + 1]; + const char *local_name; + const char *use_name; struct gfc_use_rename *next; int found; gfc_intrinsic_op op; diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 38827ed4637..6596bd87c09 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -1274,15 +1274,22 @@ not_yes: case '%': matches++; break; /* Skip. */ +#if 0 + /* If everybody is disciplined we do not need to reset this. */ + case 'n': + vp = va_arg (argp, void **); /* FORNOW: NULL shouldn't be */ + *vp = NULL; + break; +#else + case 'n': +#endif /* Matches that don't have to be undone */ case 'o': case 'l': - case 'n': case 's': (void) va_arg (argp, void **); break; - case 'e': case 'v': vp = va_arg (argp, void **); diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index b3f68b8803f..3ad47f57930 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -646,10 +646,10 @@ gfc_match_use (void) if (use_list->only_flag) { if (m != MATCH_YES) - strcpy (new_use->use_name, name); + new_use->use_name = name; else { - strcpy (new_use->local_name, name); + new_use->local_name = name; m = gfc_match_generic_spec (&type2, name, &op); if (type != type2) goto syntax; @@ -657,15 +657,14 @@ gfc_match_use (void) goto syntax; if (m == MATCH_ERROR) goto cleanup; - strcpy (new_use->use_name, name); + new_use->use_name = name; } } else { if (m != MATCH_YES) goto syntax; - strcpy (new_use->local_name, name); - + new_use->local_name = name; m = gfc_match_generic_spec (&type2, name, &op); if (type != type2) goto syntax; @@ -673,11 +672,11 @@ gfc_match_use (void) goto syntax; if (m == MATCH_ERROR) goto cleanup; - strcpy (new_use->use_name, name); + new_use->use_name = name; } - if (strcmp (new_use->use_name, use_list->module_name) == 0 - || strcmp (new_use->local_name, use_list->module_name) == 0) + if (new_use->use_name == use_list->module_name + || new_use->local_name == use_list->module_name) { gfc_error ("The name %qs at %C has already been used as " "an external module name", use_list->module_name); @@ -848,8 +847,8 @@ find_use_name_n (const char *name, int *inst, bool interface) i = 0; for (u = gfc_rename_list; u; u = u->next) { - if ((!low_name && strcmp (u->use_name, name) != 0) - || (low_name && strcmp (u->use_name, low_name) != 0) + if ((!low_name && u->use_name != name) + || (low_name && u->use_name != low_name) || (u->op == INTRINSIC_USER && !interface) || (u->op != INTRINSIC_USER && interface)) continue; @@ -870,12 +869,11 @@ find_use_name_n (const char *name, int *inst, bool interface) if (low_name) { - if (u->local_name[0] == '\0') + if (u->local_name == NULL) return name; return gfc_dt_upper_string (u->local_name); } - - return (u->local_name[0] != '\0') ? u->local_name : name; + return u->local_name != NULL ? u->local_name : name; } @@ -1980,24 +1978,6 @@ mio_pool_string (const char **stringp) } } - -/* Read or write a string that is inside of some already-allocated - structure. */ - -static void -mio_internal_string (char *string) -{ - if (iomode == IO_OUTPUT) - write_atom (ATOM_STRING, string); - else - { - require_atom (ATOM_STRING); - strcpy (string, atom_string); - free (atom_string); - } -} - - enum ab_attribute { AB_ALLOCATABLE, AB_DIMENSION, AB_EXTERNAL, AB_INTRINSIC, AB_OPTIONAL, AB_POINTER, AB_TARGET, AB_DUMMY, AB_RESULT, AB_DATA, @@ -3536,20 +3516,12 @@ mio_expr (gfc_expr **ep) write_atom (ATOM_STRING, e->value.op.uop->name); else { - char *name = read_string (); + const char *name; + mio_pool_string (&name); const char *uop_name = find_use_name (name, true); if (uop_name == NULL) - { - size_t len = strlen (name); - char *name2 = XCNEWVEC (char, len + 2); - memcpy (name2, name, len); - name2[len] = ' '; - name2[len + 1] = '\0'; - free (name); - uop_name = name = name2; - } + uop_name = name = gfc_get_string ("%s ", name); e->value.op.uop = gfc_get_uop (uop_name); - free (name); } mio_expr (&e->value.op.op1); mio_expr (&e->value.op.op2); @@ -4481,7 +4453,7 @@ static void load_operator_interfaces (void) { const char *p; - char name[GFC_MAX_SYMBOL_LEN + 1], module[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL, *module = NULL; gfc_user_op *uop; pointer_info *pi = NULL; int n, i; @@ -4492,8 +4464,8 @@ load_operator_interfaces (void) { mio_lparen (); - mio_internal_string (name); - mio_internal_string (module); + mio_pool_string (&name); + mio_pool_string (&module); n = number_use_names (name, true); n = n ? n : 1; @@ -4537,7 +4509,7 @@ static void load_generic_interfaces (void) { const char *p; - char name[GFC_MAX_SYMBOL_LEN + 1], module[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL, *module = NULL; gfc_symbol *sym; gfc_interface *generic = NULL, *gen = NULL; int n, i, renamed; @@ -4549,8 +4521,8 @@ load_generic_interfaces (void) { mio_lparen (); - mio_internal_string (name); - mio_internal_string (module); + mio_pool_string (&name); + mio_pool_string (&module); n = number_use_names (name, false); renamed = n ? 1 : 0; @@ -4667,7 +4639,7 @@ load_generic_interfaces (void) static void load_commons (void) { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; gfc_common_head *p; mio_lparen (); @@ -4677,7 +4649,7 @@ load_commons (void) int flags; char* label; mio_lparen (); - mio_internal_string (name); + mio_pool_string (&name); p = gfc_get_common (name, 1); @@ -4955,7 +4927,7 @@ load_needed (pointer_info *p) found, mark it. */ for (u = gfc_rename_list; u; u = u->next) { - if (strcmp (u->use_name, sym->name) == 0) + if (u->use_name == sym->name) { sym->attr.use_only = 1; break; @@ -5073,7 +5045,7 @@ read_module (void) { module_locus operator_interfaces, user_operators, omp_udrs; const char *p; - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name = NULL; int i; /* Workaround -Wmaybe-uninitialized false positive during profiledbootstrap by initializing them. */ @@ -5197,7 +5169,7 @@ read_module (void) while (peek_atom () != ATOM_RPAREN) { - mio_internal_string (name); + mio_pool_string (&name); mio_integer (&ambiguous); mio_integer (&symbol); @@ -5216,7 +5188,7 @@ read_module (void) /* Get the jth local name for this symbol. */ p = find_use_name_n (name, &j, false); - if (p == NULL && strcmp (name, module_name) == 0) + if (p == NULL && name == module_name) p = name; /* Exception: Always import vtabs & vtypes. */ @@ -5246,7 +5218,7 @@ read_module (void) added to the namespace(11.3.2). Note that find_symbol only returns the first occurrence that it finds. */ if (!only_flag && !info->u.rsym.renamed - && strcmp (name, module_name) != 0 + && name != module_name && find_symbol (gfc_current_ns->sym_root, name, module_name, 0)) continue; @@ -5303,7 +5275,7 @@ read_module (void) st->n.sym = sym; st->n.sym->refs++; - if (strcmp (name, p) != 0) + if (name != p) sym->attr.use_rename = 1; if (name[0] != '_' @@ -6349,22 +6321,15 @@ import_iso_c_binding_module (void) u->use_name) == 0) { c_ptr = generate_isocbinding_symbol (iso_c_module_name, - (iso_c_binding_symbol) - ISOCBINDING_PTR, - u->local_name[0] ? u->local_name - : u->use_name, - NULL, false); + (iso_c_binding_symbol) ISOCBINDING_PTR, + u->local_name ? u->local_name : u->use_name, NULL, false); } else if (strcmp (c_interop_kinds_table[ISOCBINDING_FUNPTR].name, u->use_name) == 0) { - c_funptr - = generate_isocbinding_symbol (iso_c_module_name, - (iso_c_binding_symbol) - ISOCBINDING_FUNPTR, - u->local_name[0] ? u->local_name - : u->use_name, - NULL, false); + c_funptr = generate_isocbinding_symbol (iso_c_module_name, + (iso_c_binding_symbol) ISOCBINDING_FUNPTR, + u->local_name ? u->local_name : u->use_name, NULL, false); } } @@ -6442,7 +6407,7 @@ import_iso_c_binding_module (void) return_type = c_funptr->n.sym; \ else \ return_type = NULL; \ - create_intrinsic_function (u->local_name[0] \ + create_intrinsic_function (u->local_name \ ? u->local_name : u->use_name, \ a, iso_c_module_name, \ INTMOD_ISO_C_BINDING, false, \ @@ -6450,7 +6415,7 @@ import_iso_c_binding_module (void) break; #define NAMED_SUBROUTINE(a,b,c,d) \ case a: \ - create_intrinsic_function (u->local_name[0] ? u->local_name \ + create_intrinsic_function (u->local_name ? u->local_name \ : u->use_name, \ a, iso_c_module_name, \ INTMOD_ISO_C_BINDING, true, NULL); \ @@ -6470,7 +6435,7 @@ import_iso_c_binding_module (void) tmp_symtree = NULL; generate_isocbinding_symbol (iso_c_module_name, (iso_c_binding_symbol) i, - u->local_name[0] + u->local_name ? u->local_name : u->use_name, tmp_symtree, false); } @@ -6790,7 +6755,7 @@ use_iso_fortran_env_module (void) #define NAMED_INTCST(a,b,c,d) \ case a: #include "iso-fortran-env.def" - create_int_parameter (u->local_name[0] ? u->local_name + create_int_parameter (u->local_name ? u->local_name : u->use_name, symbol[i].value, mod, INTMOD_ISO_FORTRAN_ENV, symbol[i].id); @@ -6805,7 +6770,7 @@ use_iso_fortran_env_module (void) gfc_constructor_append_expr (&expr->value.constructor, \ gfc_get_int_expr (gfc_default_integer_kind, NULL, \ KINDS[j].kind), NULL); \ - create_int_parameter_array (u->local_name[0] ? u->local_name \ + create_int_parameter_array (u->local_name ? u->local_name \ : u->use_name, \ j, expr, mod, \ INTMOD_ISO_FORTRAN_ENV, \ @@ -6816,7 +6781,7 @@ use_iso_fortran_env_module (void) #define NAMED_DERIVED_TYPE(a,b,TYPE,STD) \ case a: #include "iso-fortran-env.def" - create_derived_type (u->local_name[0] ? u->local_name + create_derived_type (u->local_name ? u->local_name : u->use_name, mod, INTMOD_ISO_FORTRAN_ENV, symbol[i].id); @@ -6825,7 +6790,7 @@ use_iso_fortran_env_module (void) #define NAMED_FUNCTION(a,b,c,d) \ case a: #include "iso-fortran-env.def" - create_intrinsic_function (u->local_name[0] ? u->local_name + create_intrinsic_function (u->local_name ? u->local_name : u->use_name, symbol[i].id, mod, INTMOD_ISO_FORTRAN_ENV, false, diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index a8f841185f1..e576bc1cb69 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -4761,7 +4761,7 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s, const char *local_name, gfc_symtree *dt_symtree, bool hidden) { - const char *const name = (local_name && local_name[0]) + const char *const name = local_name ? local_name : c_interop_kinds_table[s].name; gfc_symtree *tmp_symtree; gfc_symbol *tmp_sym = NULL; diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index eea6b81ebfa..e2adfa2e2db 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -5040,7 +5040,7 @@ gfc_trans_use_stmts (gfc_namespace * ns) if (rent->op != INTRINSIC_NONE) continue; - hashval_t hash = htab_hash_string (rent->use_name); + hashval_t hash = htab_hash_string (rent->use_name); tree *slot = entry->decls->find_slot_with_hash (rent->use_name, hash, INSERT); if (*slot == NULL) @@ -5048,14 +5048,14 @@ gfc_trans_use_stmts (gfc_namespace * ns) gfc_symtree *st; st = gfc_find_symtree (ns->sym_root, - rent->local_name[0] + rent->local_name ? rent->local_name : rent->use_name); /* The following can happen if a derived type is renamed. */ if (!st) { char *name; - name = xstrdup (rent->local_name[0] + name = xstrdup (rent->local_name ? rent->local_name : rent->use_name); name[0] = (char) TOUPPER ((unsigned char) name[0]); st = gfc_find_symtree (ns->sym_root, name); @@ -5102,7 +5102,7 @@ gfc_trans_use_stmts (gfc_namespace * ns) *slot = decl; } decl = (tree) *slot; - if (rent->local_name[0]) + if (rent->local_name) local_name = get_identifier (rent->local_name); else local_name = NULL_TREE; From patchwork Wed Sep 5 14:57:13 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Bernhard Reutner-Fischer X-Patchwork-Id: 966436 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-485231-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="ovq00N1l"; dkim=pass (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="dTnHvYYQ"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4256Pl1Hp0z9s5c for ; Thu, 6 Sep 2018 01:02:34 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; q=dns; s=default; b=gSq V/Wm0UgBCYBsXMV98nj5iNNPmTHlQtaKj+tfIyR2Yfxw4r/wT3S4vrbq2tvm2KQ3 b7fldICVSG5mKdKydRi4Jh6A9enu/p+odD4EC5ZgjSSF2Cnhsq64j1tD+sPHodzX jFUqRlO1x5Z0Vv783ObDvykz7/qXyDkrpNd6HAEY= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; s=default; bh=wKeuKm61I Tl8bzifjqih+HNVYyU=; b=ovq00N1lptnqce+doYOipocHgt1PKpDmq2GlqNeyW 27IcHXdexSAqquGEREQ1byKOsIqarWszYH8Hx9ihIVxh/7MC58NUymsIhNPStDeQ f7JTpedu2GMUPqvt5lV1c7MahMejMBSvDGeUccvZnJxYzYywlIY9c4rpCWDmiu8R 7w= Received: (qmail 69608 invoked by alias); 5 Sep 2018 14:58:02 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 68507 invoked by uid 89); 5 Sep 2018 14:57:54 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.6 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=HContent-Transfer-Encoding:8bit X-HELO: mail-wm0-f45.google.com Received: from mail-wm0-f45.google.com (HELO mail-wm0-f45.google.com) (74.125.82.45) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 05 Sep 2018 14:57:53 +0000 Received: by mail-wm0-f45.google.com with SMTP id y2-v6so8334595wma.1; Wed, 05 Sep 2018 07:57:52 -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=oxnzTP1aClWew8MasCgnafxAv9zZXfht0sPQuoC9bvg=; b=dTnHvYYQgzM+dELprqxs6TuyCSgCvRh28y1tlQZ5z9cZTR6R/weekxPZWZ6A3Imn4p J3k5EUaPWVKnfY+/l2PRrVk/idZ0qqKqFcGygSbuoy8yiPPv+uruFUIIBQRSZiJRkoj0 tEZLXYHfV3RD5M1NYZMn43cYgCNr6oS9n9Cemcxo5Yc61YsA23pr6qeZc3liAemQgfgK LD/oQF/5Td5HZp8S3jMJcSJMqBVVWFKU+ruYVmNk/bkQ/PLdmewpplvG3mEmGbeK9ukX hCb4GN6uShi5jvKmxj6JeZoEykGM2wWk2aGwLb3UFyrNSvMarx8BaKEIvsF2ephiliq1 H54g== Received: from s46.loc (91-119-125-11.dsl.dynamic.surfer.at. [91.119.125.11]) by smtp.gmail.com with ESMTPSA id g126-v6sm2505331wmg.5.2018.09.05.07.57.46 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 05 Sep 2018 07:57:49 -0700 (PDT) Received: from cow by s46.loc with local (Exim 4.91) (envelope-from ) id 1fxZFY-00007i-TK; Wed, 05 Sep 2018 14:57:45 +0000 From: Bernhard Reutner-Fischer To: fortran@gcc.gnu.org Cc: Bernhard Reutner-Fischer , gcc-patches@gcc.gnu.org Subject: [PATCH,FORTRAN 10/29] Do not copy name for check_function_name Date: Wed, 5 Sep 2018 14:57:13 +0000 Message-Id: <20180905145732.404-11-rep.dot.nop@gmail.com> In-Reply-To: References: MIME-Version: 1.0 X-IsSubscribed: yes From: Bernhard Reutner-Fischer Copying the sym->name ruins pointer equality checks and first and foremost is not needed nowadays. gcc/fortran/ChangeLog: 2018-09-02 Bernhard Reutner-Fischer * decl.c (gfc_match_volatile, gfc_match_asynchronous): Do not copy sym->name. --- gcc/fortran/decl.c | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 2667c2281f8..b0c45b88505 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -9167,7 +9167,6 @@ match gfc_match_volatile (void) { gfc_symbol *sym; - char *name; match m; if (!gfc_notify_std (GFC_STD_F2003, "VOLATILE statement at %C")) @@ -9189,9 +9188,7 @@ gfc_match_volatile (void) switch (m) { case MATCH_YES: - name = XCNEWVAR (char, strlen (sym->name) + 1); - strcpy (name, sym->name); - if (!check_function_name (name)) + if (!check_function_name (sym->name)) return MATCH_ERROR; /* F2008, C560+C561. VOLATILE for host-/use-associated variable or for variable in a BLOCK which is defined outside of the BLOCK. */ @@ -9231,7 +9228,6 @@ match gfc_match_asynchronous (void) { gfc_symbol *sym; - char *name; match m; if (!gfc_notify_std (GFC_STD_F2003, "ASYNCHRONOUS statement at %C")) @@ -9253,9 +9249,7 @@ gfc_match_asynchronous (void) switch (m) { case MATCH_YES: - name = XCNEWVAR (char, strlen (sym->name) + 1); - strcpy (name, sym->name); - if (!check_function_name (name)) + if (!check_function_name (sym->name)) return MATCH_ERROR; if (!gfc_add_asynchronous (&sym->attr, sym->name, &gfc_current_locus)) return MATCH_ERROR; From patchwork Wed Sep 5 14:57:14 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Bernhard Reutner-Fischer X-Patchwork-Id: 966438 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-485235-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="hMk7flCD"; dkim=pass (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="qbJ+c9fG"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4256QT1pPqz9s5c for ; Thu, 6 Sep 2018 01:03:11 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; q=dns; s=default; b=Ug5 ae/1moZuz28roQqTxj9ozSVRxkiM3O7RUmCnQ79a3frs0c3t4GLpJ3TvZ4593vVJ 6ZUK7H+jZXKjKmtgaMQ2bYRjj8AU8RJev5IGpvHoMH0pu00vTeZB2BUzy5m2gLuq 1wB+fzScCXiARCw37oVqLLeyQ0bz6/w8tKB6HVMM= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; s=default; bh=1eV7QDiqI pmnXCczXr18HBibCfk=; b=hMk7flCDaIynHjCXZi5yUznhvccieFCWiGMoq5Vhp yW/2iiBf8qVSqTytNu/8vQjLT26jPE5O9NliM//GZhbuIvCp5uw8qFcPZRSrDmfx jV13TqQrGnKtcG5Urdjhn+YjUrqpSK3rnZpLqTSjDqXVFzXlq9Ui835shIOiD9Sy Pk= Received: (qmail 69972 invoked by alias); 5 Sep 2018 14:58:06 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 69084 invoked by uid 89); 5 Sep 2018 14:57:59 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-25.4 required=5.0 tests=AWL, BAYES_00, FREEMAIL_FROM, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, KAM_STOCKGEN, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy=UD:cl, UNION, tse, HX-Google-Smtp-Source:ANB0Vda X-HELO: mail-wm0-f49.google.com Received: from mail-wm0-f49.google.com (HELO mail-wm0-f49.google.com) (74.125.82.49) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 05 Sep 2018 14:57:54 +0000 Received: by mail-wm0-f49.google.com with SMTP id f21-v6so8313125wmc.5; Wed, 05 Sep 2018 07:57:54 -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=xPxRh3kENSFu6L+S53nIalgXxssAVSUBBsOh+siUAGQ=; b=qbJ+c9fGiKV5L/UdSq5G8BODT6RlNzw9nSFlhBwtbDV81DtbFZsfmv3HUSGs0iQSx0 FAgnb+b6b/msn5Qgdga/9AzyXbtPbfgfhzJAiuhmN2RwG3SCJJD8fQiT+rJNwg/ARK3C 3zZCvp9AbL2OvCmGTvw1Ua96f/1zGby08alsH7dB2A/p5yi0m5DI4DVm3ypD2euELLv1 YKRTUcV+kLNB57+qfSZ0o9IrSIhPwzT0UsFZvV+DFKVWSoUA9cw4e3TcG4xXXVTZfj9l IvnufVTkA4ZGJpC+LnsuZH5+2GCPBaWYx174kMUchQa+1lczd1AL8riSl3uFzABNlVil n9WQ== Received: from s46.loc (91-119-125-11.dsl.dynamic.surfer.at. [91.119.125.11]) by smtp.gmail.com with ESMTPSA id v5-v6sm1400656wru.60.2018.09.05.07.57.47 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 05 Sep 2018 07:57:49 -0700 (PDT) Received: from cow by s46.loc with local (Exim 4.91) (envelope-from ) id 1fxZFZ-00007m-8W; Wed, 05 Sep 2018 14:57:45 +0000 From: Bernhard Reutner-Fischer To: fortran@gcc.gnu.org Cc: Bernhard Reutner-Fischer , gcc-patches@gcc.gnu.org Subject: [PATCH,FORTRAN 11/29] Do pointer comparison instead of strcmp Date: Wed, 5 Sep 2018 14:57:14 +0000 Message-Id: <20180905145732.404-12-rep.dot.nop@gmail.com> In-Reply-To: References: MIME-Version: 1.0 X-IsSubscribed: yes From: Bernhard Reutner-Fischer This gets rid of some of the str[n]*cmp in favour of (faster) pointer equality checks. gcc/fortran/ChangeLog: 2017-11-02 Bernhard Reutner-Fischer * check.c (gfc_check_move_alloc): Use pointer comparison instead of strcmp. * class.c (find_intrinsic_vtab): Likewise. * decl.c (find_special, check_function_name, variable_decl, insert_parameter_exprs, gfc_get_pdt_instance, gfc_match_formal_arglist, match_result, add_hidden_procptr_result, add_global_entry, gfc_match_end): Likewise. * interface.c (gfc_match_end_interface, compare_components, gfc_compare_derived_types, find_keyword_arg, count_types_test, generic_correspondence, compare_actual_formal, gfc_check_typebound_override): Likewise. * match.c (gfc_match_else, gfc_match_elseif, match_case_eos, gfc_match_elsewhere): Likewise. * openmp.c (gfc_match_oacc_routine, match_udr_expr, gfc_omp_udr_find): Likewise. * parse.c (match_deferred_characteristics, parse_omp_structured_block, add_global_procedure): Likewise. * resolve.c (check_proc_interface, resolve_formal_arglist, resolve_contained_fntype, resolve_common_blocks, count_specific_procs, not_entry_self_reference, resolve_global_procedure, resolve_select_type, gfc_verify_binding_labels, build_init_assign, compare_fsyms, resolve_typebound_procedure, resolve_component): Likewise. * symbol.c (gfc_add_component, gfc_find_component): Likewise. * trans-array.c (structure_alloc_comps): Likewise. * trans-decl.c (gfc_get_extern_function_decl, build_entry_thunks, gfc_get_fake_result_decl, struct module_hasher, module_decl_hasher::equal, gfc_trans_use_stmts, generate_local_decl): Likewise. * trans-expr.c (conv_parent_component_references, gfc_conv_procedure_call): Likewise. * module.c (mio_namelist, find_symbol, load_omp_udrs, read_module): Likewise. --- gcc/fortran/check.c | 2 +- gcc/fortran/class.c | 2 +- gcc/fortran/decl.c | 31 +++++++++++++++--------------- gcc/fortran/interface.c | 34 ++++++++++++++++----------------- gcc/fortran/match.c | 8 ++++---- gcc/fortran/module.c | 17 ++++++++--------- gcc/fortran/openmp.c | 7 +++---- gcc/fortran/parse.c | 10 ++++------ gcc/fortran/resolve.c | 40 +++++++++++++++++++-------------------- gcc/fortran/symbol.c | 6 +++--- gcc/fortran/trans-array.c | 4 ++-- gcc/fortran/trans-decl.c | 24 +++++++++++------------ gcc/fortran/trans-expr.c | 7 +++---- 13 files changed, 91 insertions(+), 101 deletions(-) diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 30214fef4c7..cb18a3af519 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -3566,7 +3566,7 @@ gfc_check_move_alloc (gfc_expr *from, gfc_expr *to) of reflection reveals that this can only occur for derived types with recursive allocatable components. */ if (to->expr_type == EXPR_VARIABLE && from->expr_type == EXPR_VARIABLE - && !strcmp (to->symtree->n.sym->name, from->symtree->n.sym->name)) + && to->symtree->n.sym->name == from->symtree->n.sym->name) { gfc_ref *to_ref, *from_ref; to_ref = to->ref; diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index 2eae7f0f351..8e637689fae 100644 --- a/gcc/fortran/class.c +++ b/gcc/fortran/class.c @@ -2736,7 +2736,7 @@ find_intrinsic_vtab (gfc_typespec *ts) contained = ns->contained; for (; contained; contained = contained->sibling) if (contained->proc_name - && strcmp (name, contained->proc_name->name) == 0) + && name == contained->proc_name->name) { copy = contained->proc_name; goto got_char_copy; diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index b0c45b88505..2baa1783434 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -1118,7 +1118,7 @@ find_special (const char *name, gfc_symbol **result, bool allow_subroutine) if (s->sym == NULL) goto end; /* Nameless interface. */ - if (strcmp (name, s->sym->name) == 0) + if (name == s->sym->name) { *result = s->sym; return 0; @@ -2273,7 +2273,7 @@ check_function_name (const char *name) gfc_symbol *block = gfc_current_block (); if (block && block->result && block->result != block && strcmp (block->result->name, "ppr@") != 0 - && strcmp (block->name, name) == 0) + && block->name == name) { gfc_error ("RESULT variable %qs at %L prohibits FUNCTION name %qs at %C " "from appearing in a specification statement", @@ -2583,11 +2583,11 @@ variable_decl (int elem) /* Procedure pointer as function result. */ if (gfc_current_state () == COMP_FUNCTION && strcmp ("ppr@", gfc_current_block ()->name) == 0 - && strcmp (name, gfc_current_block ()->ns->proc_name->name) == 0) + && name == gfc_current_block ()->ns->proc_name->name) name = gfc_get_string ("%s", "ppr@"); if (gfc_current_state () == COMP_FUNCTION - && strcmp (name, gfc_current_block ()->name) == 0 + && name == gfc_current_block ()->name && gfc_current_block ()->result && strcmp ("ppr@", gfc_current_block ()->result->name) == 0) name = gfc_get_string ("%s", "ppr@"); @@ -3359,7 +3359,7 @@ insert_parameter_exprs (gfc_expr* e, gfc_symbol* sym ATTRIBUTE_UNUSED, || (*f != 0 && e->symtree->n.sym->attr.pdt_len)) { for (param = type_param_spec_list; param; param = param->next) - if (strcmp (e->symtree->n.sym->name, param->name) == 0) + if (e->symtree->n.sym->name == param->name) break; if (param) @@ -3483,7 +3483,7 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym, actual_param = param_list; for (;actual_param; actual_param = actual_param->next) if (actual_param->name - && strcmp (actual_param->name, param->name) == 0) + && actual_param->name == param->name) break; if (actual_param && actual_param->spec_type == SPEC_EXPLICIT) kind_expr = gfc_copy_expr (actual_param->expr); @@ -6215,7 +6215,7 @@ gfc_match_formal_arglist (gfc_symbol *progname, int st_flag, so check for it explicitly. After the statement is accepted, the name is checked for especially in gfc_get_symbol(). */ if (gfc_new_block != NULL && sym != NULL && !typeparam - && strcmp (sym->name, gfc_new_block->name) == 0) + && sym->name == gfc_new_block->name) { gfc_error ("Name %qs at %C is the name of the procedure", sym->name); @@ -6290,7 +6290,7 @@ ok: || (p->next == NULL && q->next != NULL)) arg_count_mismatch = true; else if ((p->sym == NULL && q->sym == NULL) - || strcmp (p->sym->name, q->sym->name) == 0) + || p->sym->name == q->sym->name) continue; else gfc_error_now ("Mismatch in MODULE PROCEDURE formal " @@ -6336,7 +6336,7 @@ match_result (gfc_symbol *function, gfc_symbol **result) return MATCH_ERROR; } - if (strcmp (function->name, name) == 0) + if (function->name == name) { gfc_error ("RESULT variable at %C must be different than function name"); return MATCH_ERROR; @@ -6451,12 +6451,12 @@ add_hidden_procptr_result (gfc_symbol *sym) /* First usage case: PROCEDURE and EXTERNAL statements. */ case1 = gfc_current_state () == COMP_FUNCTION && gfc_current_block () - && strcmp (gfc_current_block ()->name, sym->name) == 0 + && gfc_current_block ()->name == sym->name && sym->attr.external; /* Second usage case: INTERFACE statements. */ case2 = gfc_current_state () == COMP_INTERFACE && gfc_state_stack->previous && gfc_state_stack->previous->state == COMP_FUNCTION - && strcmp (gfc_state_stack->previous->sym->name, sym->name) == 0; + && gfc_state_stack->previous->sym->name == sym->name; if (case1 || case2) { @@ -7148,7 +7148,7 @@ add_global_entry (const char *name, const char *binding_label, bool sub, /* Don't add the symbol multiple times. */ if (binding_label && (!gfc_notification_std (GFC_STD_F2008) - || strcmp (name, binding_label) != 0)) + || name != binding_label)) { s = gfc_get_gsymbol (binding_label); @@ -8044,9 +8044,8 @@ gfc_match_end (gfc_statement *st) /* We have to pick out the declared submodule name from the composite required by F2008:11.2.3 para 2, which ends in the declared name. */ if (state == COMP_SUBMODULE) - block_name = strchr (block_name, '.') + 1; - - if (strcmp (name, block_name) != 0 && strcmp (block_name, "ppr@") != 0) + block_name = gfc_get_string ("%s", strchr (block_name, '.') + 1); + if (name != block_name && strcmp (block_name, "ppr@") != 0) { gfc_error ("Expected label %qs for %s statement at %C", block_name, gfc_ascii_statement (*st)); @@ -8054,7 +8053,7 @@ gfc_match_end (gfc_statement *st) } /* Procedure pointer as function result. */ else if (strcmp (block_name, "ppr@") == 0 - && strcmp (name, gfc_current_block ()->ns->proc_name->name) != 0) + && name != gfc_current_block ()->ns->proc_name->name) { gfc_error ("Expected label %qs for %s statement at %C", gfc_current_block ()->ns->proc_name->name, diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 8716813b7b2..d18590da331 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -411,7 +411,7 @@ gfc_match_end_interface (void) /* Comparing the symbol node names is OK because only use-associated symbols can be renamed. */ if (type != current_interface.type - || strcmp (current_interface.uop->name, name) != 0) + || current_interface.uop->name != name) { gfc_error ("Expecting % at %C", current_interface.uop->name); @@ -423,7 +423,7 @@ gfc_match_end_interface (void) case INTERFACE_DTIO: case INTERFACE_GENERIC: if (type != current_interface.type - || strcmp (current_interface.sym->name, name) != 0) + || current_interface.sym->name != name) { gfc_error ("Expecting % at %C", current_interface.sym->name); @@ -476,7 +476,7 @@ compare_components (gfc_component *cmp1, gfc_component *cmp2, { /* Compare names, but not for anonymous components such as UNION or MAP. */ if (!is_anonymous_component (cmp1) && !is_anonymous_component (cmp2) - && strcmp (cmp1->name, cmp2->name) != 0) + && cmp1->name != cmp2->name) return false; if (cmp1->attr.access != cmp2->attr.access) @@ -624,9 +624,9 @@ gfc_compare_derived_types (gfc_symbol *derived1, gfc_symbol *derived2) /* Special case for comparing derived types across namespaces. If the true names and module names are the same and the module name is nonnull, then they are equal. */ - if (strcmp (derived1->name, derived2->name) == 0 + if (derived1->name == derived2->name && derived1->module != NULL && derived2->module != NULL - && strcmp (derived1->module, derived2->module) == 0) + && derived1->module == derived2->module) return true; /* Compare type via the rules of the standard. Both types must have @@ -636,7 +636,7 @@ gfc_compare_derived_types (gfc_symbol *derived1, gfc_symbol *derived2) /* Compare names, but not for anonymous types such as UNION or MAP. */ if (!is_anonymous_dt (derived1) && !is_anonymous_dt (derived2) - && strcmp (derived1->name, derived2->name) != 0) + && derived1->name != derived2->name) return false; if (derived1->component_access == ACCESS_PRIVATE @@ -839,7 +839,7 @@ static gfc_symbol * find_keyword_arg (const char *name, gfc_formal_arglist *f) { for (; f; f = f->next) - if (strcmp (f->sym->name, name) == 0) + if (f->sym->name == name) return f->sym; return NULL; @@ -1140,7 +1140,7 @@ count_types_test (gfc_formal_arglist *f1, gfc_formal_arglist *f2, continue; if (arg[i].sym && (arg[i].sym->attr.optional - || (p1 && strcmp (arg[i].sym->name, p1) == 0))) + || (p1 && arg[i].sym->name == p1))) continue; /* Skip OPTIONAL and PASS arguments. */ arg[i].flag = k; @@ -1149,7 +1149,7 @@ count_types_test (gfc_formal_arglist *f1, gfc_formal_arglist *f2, for (j = i + 1; j < n1; j++) if ((arg[j].sym == NULL || !(arg[j].sym->attr.optional - || (p1 && strcmp (arg[j].sym->name, p1) == 0))) + || (p1 && arg[j].sym->name == p1))) && (compare_type_rank_if (arg[i].sym, arg[j].sym) || compare_type_rank_if (arg[j].sym, arg[i].sym))) arg[j].flag = k; @@ -1176,7 +1176,7 @@ count_types_test (gfc_formal_arglist *f1, gfc_formal_arglist *f2, ac2 = 0; for (f = f2; f; f = f->next) - if ((!p2 || strcmp (f->sym->name, p2) != 0) + if ((!p2 || f->sym->name != p2) && (compare_type_rank_if (arg[i].sym, f->sym) || compare_type_rank_if (f->sym, arg[i].sym))) ac2++; @@ -1249,9 +1249,9 @@ generic_correspondence (gfc_formal_arglist *f1, gfc_formal_arglist *f2, if (f1->sym->attr.optional) goto next; - if (p1 && strcmp (f1->sym->name, p1) == 0) + if (p1 && f1->sym->name == p1) f1 = f1->next; - if (f2 && p2 && strcmp (f2->sym->name, p2) == 0) + if (f2 && p2 && f2->sym->name == p2) f2 = f2->next; if (f2 != NULL && (compare_type_rank (f1->sym, f2->sym) @@ -1265,7 +1265,7 @@ generic_correspondence (gfc_formal_arglist *f1, gfc_formal_arglist *f2, the current non-match. */ for (g = f1; g; g = g->next) { - if (g->sym->attr.optional || (p1 && strcmp (g->sym->name, p1) == 0)) + if (g->sym->attr.optional || (p1 && g->sym->name == p1)) continue; sym = find_keyword_arg (g->sym->name, f2_save); @@ -2914,7 +2914,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, { if (f->sym == NULL) continue; - if (strcmp (f->sym->name, a->name) == 0) + if (f->sym->name == a->name) break; } @@ -4644,14 +4644,14 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old) proc_formal = proc_formal->next, old_formal = old_formal->next) { if (proc->n.tb->pass_arg - && !strcmp (proc->n.tb->pass_arg, proc_formal->sym->name)) + && proc->n.tb->pass_arg == proc_formal->sym->name) proc_pass_arg = argpos; if (old->n.tb->pass_arg - && !strcmp (old->n.tb->pass_arg, old_formal->sym->name)) + && old->n.tb->pass_arg == old_formal->sym->name) old_pass_arg = argpos; /* Check that the names correspond. */ - if (strcmp (proc_formal->sym->name, old_formal->sym->name)) + if (proc_formal->sym->name != old_formal->sym->name) { gfc_error ("Dummy argument %qs of %qs at %L should be named %qs as" " to match the corresponding argument of the overridden" diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 6596bd87c09..f27249ec6ed 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -1716,7 +1716,7 @@ gfc_match_else (void) return MATCH_ERROR; } - if (strcmp (name, gfc_current_block ()->name) != 0) + if (name != gfc_current_block ()->name) { gfc_error ("Label %qs at %C doesn't match IF label %qs", name, gfc_current_block ()->name); @@ -1751,7 +1751,7 @@ gfc_match_elseif (void) goto cleanup; } - if (strcmp (name, gfc_current_block ()->name) != 0) + if (name != gfc_current_block ()->name) { gfc_error ("Label %qs at %C doesn't match IF label %qs", name, gfc_current_block ()->name); @@ -5914,7 +5914,7 @@ match_case_eos (void) if (m != MATCH_YES) return m; - if (strcmp (name, gfc_current_block ()->name) != 0) + if (name != gfc_current_block ()->name) { gfc_error ("Expected block name %qs of SELECT construct at %C", gfc_current_block ()->name); @@ -6640,7 +6640,7 @@ gfc_match_elsewhere (void) if (gfc_match_eos () != MATCH_YES) goto syntax; - if (strcmp (name, gfc_current_block ()->name) != 0) + if (name != gfc_current_block ()->name) { gfc_error ("Label %qs at %C doesn't match WHERE label %qs", name, gfc_current_block ()->name); diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 3ad47f57930..fe5ae34dd13 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -3689,7 +3689,7 @@ mio_namelist (gfc_symbol *sym) if (sym->attr.flavor == FL_NAMELIST) { check_name = find_use_name (sym->name, false); - if (check_name && strcmp (check_name, sym->name) != 0) + if (check_name && check_name != sym->name) gfc_error ("Namelist %s cannot be renamed by USE " "association to %s", sym->name, check_name); } @@ -4379,16 +4379,15 @@ static gfc_symtree * find_symbol (gfc_symtree *st, const char *name, const char *module, int generic) { - int c; gfc_symtree *retval, *s; if (st == NULL || st->n.sym == NULL) return NULL; - c = strcmp (name, st->n.sym->name); - if (c == 0 && st->n.sym->module - && strcmp (module, st->n.sym->module) == 0 - && !check_unique_name (st->name)) + if (name == st->n.sym->name + && st->n.sym->module + && module == st->n.sym->module + && !check_unique_name (st->name)) { s = gfc_find_symtree (gfc_current_ns->sym_root, name); @@ -4804,7 +4803,7 @@ load_omp_udrs (void) { require_atom (ATOM_INTEGER); pointer_info *p = get_integer (atom_int); - if (strcmp (p->u.rsym.module, udr->omp_out->module)) + if (p->u.rsym.module != udr->omp_out->module) { gfc_error ("Ambiguous !$OMP DECLARE REDUCTION from " "module %s at %L", @@ -5203,9 +5202,9 @@ read_module (void) { st = gfc_find_symtree (gfc_current_ns->sym_root, name); if (st != NULL - && strcmp (st->n.sym->name, info->u.rsym.true_name) == 0 + && st->n.sym->name == info->u.rsym.true_name && st->n.sym->module != NULL - && strcmp (st->n.sym->module, info->u.rsym.module) == 0) + && st->n.sym->module == info->u.rsym.module) { info->u.rsym.symtree = st; info->u.rsym.sym = st->n.sym; diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 08bc05cbc28..a868e34193f 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -2297,7 +2297,7 @@ gfc_match_oacc_routine (void) { sym = st->n.sym; if (gfc_current_ns->proc_name != NULL - && strcmp (sym->name, gfc_current_ns->proc_name->name) == 0) + && sym->name == gfc_current_ns->proc_name->name) sym = NULL; } @@ -2628,8 +2628,7 @@ match_udr_expr (gfc_symtree *omp_sym1, gfc_symtree *omp_sym2) if (m != MATCH_YES) return false; - if (strcmp (sname, omp_sym1->name) == 0 - || strcmp (sname, omp_sym2->name) == 0) + if (sname == omp_sym1->name || sname == omp_sym2->name) return false; gfc_current_ns = ns->parent; @@ -2763,7 +2762,7 @@ gfc_omp_udr_find (gfc_symtree *st, gfc_typespec *ts) { if (omp_udr->ts.type == BT_DERIVED || omp_udr->ts.type == BT_CLASS) { - if (strcmp (omp_udr->ts.u.derived->name, ts->u.derived->name) == 0) + if (omp_udr->ts.u.derived->name == ts->u.derived->name) return omp_udr; } else if (omp_udr->ts.kind == ts->kind) diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 880671b57f4..389eead0691 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -3569,8 +3569,7 @@ decl: if (current_interface.ns && current_interface.ns->proc_name - && strcmp (current_interface.ns->proc_name->name, - prog_unit->name) == 0) + && current_interface.ns->proc_name->name == prog_unit->name) gfc_error ("INTERFACE procedure %qs at %L has the same name as the " "enclosing procedure", prog_unit->name, ¤t_interface.ns->proc_name->declared_at); @@ -3617,7 +3616,7 @@ match_deferred_characteristics (gfc_typespec * ts) function name, there is an error. */ if (m == MATCH_YES && gfc_match ("function% %n", &name) == MATCH_YES - && strcmp (name, gfc_current_block ()->name) == 0) + && name == gfc_current_block ()->name) { gfc_current_block ()->declared_at = gfc_current_locus; gfc_commit_symbols (); @@ -5224,8 +5223,7 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only) case EXEC_OMP_END_CRITICAL: if (((cp->ext.omp_clauses == NULL) ^ (new_st.ext.omp_name == NULL)) || (new_st.ext.omp_name != NULL - && strcmp (cp->ext.omp_clauses->critical_name, - new_st.ext.omp_name) != 0)) + && cp->ext.omp_clauses->critical_name != new_st.ext.omp_name)) gfc_error ("Name after !$omp critical and !$omp end critical does " "not match at %C"); new_st.ext.omp_name = NULL; @@ -5998,7 +5996,7 @@ add_global_procedure (bool sub) /* Don't add the symbol multiple times. */ if (gfc_new_block->binding_label && (!gfc_notification_std (GFC_STD_F2008) - || strcmp (gfc_new_block->name, gfc_new_block->binding_label) != 0)) + || gfc_new_block->name != gfc_new_block->binding_label)) { s = gfc_get_gsymbol (gfc_new_block->binding_label); diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index ded27624283..afb745bddc5 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -149,7 +149,7 @@ check_proc_interface (gfc_symbol *ifc, locus *where) /* For generic interfaces, check if there is a specific procedure with the same name. */ gfc_interface *gen = ifc->generic; - while (gen && strcmp (gen->sym->name, ifc->name) != 0) + while (gen && gen->sym->name != ifc->name) gen = gen->next; if (!gen) { @@ -310,7 +310,7 @@ resolve_formal_arglist (gfc_symbol *proc) && !resolve_procedure_interface (sym)) return; - if (strcmp (proc->name, sym->name) == 0) + if (proc->name == sym->name) { gfc_error ("Self-referential argument " "%qs at %L is not allowed", sym->name, @@ -573,7 +573,7 @@ resolve_contained_fntype (gfc_symbol *sym, gfc_namespace *ns) && sym->ns->parent && sym->ns->parent->proc_name && sym->ns->parent->proc_name->attr.flavor == FL_PROCEDURE - && !strcmp (sym->name, sym->ns->parent->proc_name->name)) + && sym->name == sym->ns->parent->proc_name->name) gfc_error ("Contained procedure %qs at %L has the same name as its " "encompassing procedure", sym->name, &sym->declared_at); @@ -1015,8 +1015,8 @@ resolve_common_blocks (gfc_symtree *common_root) && gsym->type == GSYM_COMMON && ((common_root->n.common->binding_label && (!gsym->binding_label - || strcmp (common_root->n.common->binding_label, - gsym->binding_label) != 0)) + || common_root->n.common->binding_label != + gsym->binding_label)) || (!common_root->n.common->binding_label && gsym->binding_label))) { @@ -1650,7 +1650,7 @@ count_specific_procs (gfc_expr *e) sym = e->symtree->n.sym; for (p = sym->generic; p; p = p->next) - if (strcmp (sym->name, p->sym->name) == 0) + if (sym->name == p->sym->name) { e->symtree = gfc_find_symtree (p->sym->ns->sym_root, sym->name); @@ -2337,15 +2337,14 @@ not_entry_self_reference (gfc_symbol *sym, gfc_namespace *gsym_ns) for (; entry; entry = entry->next) { - if (strcmp (sym->name, entry->sym->name) == 0) + if (sym->name == entry->sym->name) { - if (strcmp (gsym_ns->proc_name->name, - sym->ns->proc_name->name) == 0) + if (gsym_ns->proc_name->name == sym->ns->proc_name->name) return false; if (sym->ns->parent - && strcmp (gsym_ns->proc_name->name, - sym->ns->parent->proc_name->name) == 0) + && gsym_ns->proc_name->name == + sym->ns->parent->proc_name->name) return false; } } @@ -2550,7 +2549,7 @@ resolve_global_procedure (gfc_symbol *sym, locus *where, { gfc_entry_list *entry; for (entry = gsym->ns->entries; entry; entry = entry->next) - if (strcmp (entry->sym->name, sym->name) == 0) + if (entry->sym->name == sym->name) { def_sym = entry->sym; break; @@ -8912,8 +8911,7 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) if (c->ts.type == d->ts.type && ((c->ts.type == BT_DERIVED && c->ts.u.derived && d->ts.u.derived - && !strcmp (c->ts.u.derived->name, - d->ts.u.derived->name)) + && c->ts.u.derived->name == d->ts.u.derived->name) || c->ts.type == BT_UNKNOWN || (!(c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS) && c->ts.kind == d->ts.kind))) @@ -11733,7 +11731,7 @@ gfc_verify_binding_labels (gfc_symbol *sym) } else if (sym->attr.flavor == FL_VARIABLE && module && (strcmp (module, gsym->mod_name) != 0 - || strcmp (sym->name, gsym->sym_name) != 0)) + || sym->name != gsym->sym_name)) { /* This can only happen if the variable is defined in a module - if it isn't the same module, reject it. */ @@ -11748,7 +11746,7 @@ gfc_verify_binding_labels (gfc_symbol *sym) || (gsym->defined && sym->attr.if_source != IFSRC_IFBODY)) && sym != gsym->ns->proc_name && (module != gsym->mod_name - || strcmp (gsym->sym_name, sym->name) != 0 + || gsym->sym_name != sym->name || (module && strcmp (module, gsym->mod_name) != 0))) { /* Print an error if the procedure is defined multiple times; we have to @@ -11895,7 +11893,7 @@ build_init_assign (gfc_symbol *sym, gfc_expr *init) { ns = ns->contained; for (;ns; ns = ns->sibling) - if (strcmp (ns->proc_name->name, sym->name) == 0) + if (ns->proc_name->name == sym->name) break; } @@ -12388,7 +12386,7 @@ compare_fsyms (gfc_symbol *sym) if (sym == fsym) return; - if (strcmp (sym->name, fsym->name) == 0) + if (sym->name == fsym->name) { if (!gfc_check_dummy_characteristics (fsym, sym, true, errmsg, 200)) gfc_error ("%s at %L", errmsg, &fsym->declared_at); @@ -13382,7 +13380,7 @@ resolve_typebound_procedure (gfc_symtree* stree) stree->n.tb->pass_arg_num = 1; for (i = dummy_args; i; i = i->next) { - if (!strcmp (i->sym->name, stree->n.tb->pass_arg)) + if (i->sym->name == stree->n.tb->pass_arg) { me_arg = i->sym; break; @@ -13812,7 +13810,7 @@ resolve_component (gfc_component *c, gfc_symbol *sym) c->tb->pass_arg_num = 1; for (i = c->ts.interface->formal; i; i = i->next) { - if (!strcmp (i->sym->name, c->tb->pass_arg)) + if (i->sym->name == c->tb->pass_arg) { me_arg = i->sym; break; @@ -13914,7 +13912,7 @@ resolve_component (gfc_component *c, gfc_symbol *sym) && ((sym->attr.is_class && c == sym->components->ts.u.derived->components) || (!sym->attr.is_class && c == sym->components)) - && strcmp (super_type->name, c->name) == 0) + && super_type->name == c->name) c->attr.access = super_type->attr.access; /* If this type is an extension, see if this component has the same name diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index e576bc1cb69..00a178772df 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -2239,7 +2239,7 @@ gfc_add_component (gfc_symbol *sym, const char *name, for (p = sym->components; p; p = p->next) { - if (strcmp (p->name, name) == 0) + if (p->name == name) { gfc_error ("Component %qs at %C already declared at %L", name, &p->loc); @@ -2504,7 +2504,8 @@ gfc_find_component (gfc_symbol *sym, const char *name, return check; } } - else if (strcmp (p->name, name) == 0) + else if (p->name == name || strcmp (p->name, name) == 0) + /* FORNOW: name could be "_data" et al so fallback to strcmp. */ break; continue; @@ -2902,7 +2903,6 @@ compare_symtree (void *_st1, void *_st2) st1 = (gfc_symtree *) _st1; st2 = (gfc_symtree *) _st2; - return strcmp (st1->name, st2->name); } diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index adb2c0575a8..78132908929 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -9024,7 +9024,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, gfc_actual_arglist *param = pdt_param_list; gfc_init_se (&tse, NULL); for (; param; param = param->next) - if (param->name && !strcmp (c->name, param->name)) + if (param->name && c->name == param->name) c_expr = param->expr; if (!c_expr) @@ -9266,7 +9266,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, gfc_init_se (&tse, NULL); for (; param; param = param->next) - if (!strcmp (c->name, param->name) + if (c->name == param->name && param->spec_type == SPEC_EXPLICIT) c_expr = param->expr; diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index e2adfa2e2db..6e717633a8f 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1994,7 +1994,7 @@ gfc_get_extern_function_decl (gfc_symbol * sym) for (; entry; entry = entry->next) { - if (strcmp (gsym->name, entry->sym->name) == 0) + if (gsym->name == entry->sym->name) { sym->backend_decl = entry->sym->backend_decl; break; @@ -2787,9 +2787,10 @@ build_entry_thunks (gfc_namespace * ns, bool global) for (field = TYPE_FIELDS (TREE_TYPE (union_decl)); field; field = DECL_CHAIN (field)) - if (strcmp (IDENTIFIER_POINTER (DECL_NAME (field)), - thunk_sym->result->name) == 0) + if (IDENTIFIER_POINTER (DECL_NAME (field)) == + thunk_sym->result->name) break; + gcc_assert (field != NULL_TREE); tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field), union_decl, field, @@ -2912,7 +2913,7 @@ gfc_get_fake_result_decl (gfc_symbol * sym, int parent_flag) tree t = NULL, var; if (this_fake_result_decl != NULL) for (t = TREE_CHAIN (this_fake_result_decl); t; t = TREE_CHAIN (t)) - if (strcmp (IDENTIFIER_POINTER (TREE_PURPOSE (t)), sym->name) == 0) + if (IDENTIFIER_POINTER (TREE_PURPOSE (t)) == sym->name) break; if (t) return TREE_VALUE (t); @@ -2929,10 +2930,8 @@ gfc_get_fake_result_decl (gfc_symbol * sym, int parent_flag) for (field = TYPE_FIELDS (TREE_TYPE (decl)); field; field = DECL_CHAIN (field)) - if (strcmp (IDENTIFIER_POINTER (DECL_NAME (field)), - sym->name) == 0) + if (IDENTIFIER_POINTER (DECL_NAME (field)) == sym->name) break; - gcc_assert (field != NULL_TREE); decl = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field), decl, field, NULL_TREE); @@ -4794,7 +4793,7 @@ struct module_hasher : ggc_ptr_hash static bool equal (module_htab_entry *a, const char *b) { - return !strcmp (a->name, b); + return a->name == b; } }; @@ -4817,7 +4816,7 @@ module_decl_hasher::equal (tree t1, const char *x2) const_tree n1 = DECL_NAME (t1); if (n1 == NULL_TREE) n1 = TYPE_NAME (TREE_TYPE (t1)); - return strcmp (IDENTIFIER_POINTER (n1), x2) == 0; + return IDENTIFIER_POINTER (n1) == x2; } struct module_htab_entry * @@ -5071,7 +5070,7 @@ gfc_trans_use_stmts (gfc_namespace * ns) if (st->n.sym->backend_decl && DECL_P (st->n.sym->backend_decl) && st->n.sym->module - && strcmp (st->n.sym->module, use_stmt->module_name) == 0) + && st->n.sym->module == use_stmt->module_name) { gcc_assert (DECL_EXTERNAL (entry->namespace_decl) || !VAR_P (st->n.sym->backend_decl)); @@ -5084,8 +5083,7 @@ gfc_trans_use_stmts (gfc_namespace * ns) else if (st->n.sym->attr.flavor == FL_NAMELIST && st->n.sym->attr.use_only && st->n.sym->module - && strcmp (st->n.sym->module, use_stmt->module_name) - == 0) + && st->n.sym->module == use_stmt->module_name) { decl = generate_namelist_decl (st->n.sym); DECL_CONTEXT (decl) = entry->namespace_decl; @@ -5613,7 +5611,7 @@ generate_local_decl (gfc_symbol * sym) gfc_entry_list *el; for (el = sym->ns->entries; el; el=el->next) - if (strcmp(sym->name, el->sym->name) == 0) + if (sym->name == el->sym->name) enter = true; if (!enter) diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 56ce98c78c6..6c8a5b30568 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -2490,7 +2490,7 @@ conv_parent_component_references (gfc_se * se, gfc_ref * ref) /* Return if the component is in the parent type. */ for (cmp = dt->components; cmp; cmp = cmp->next) - if (strcmp (c->name, cmp->name) == 0) + if (c->name == cmp->name) return; /* Build a gfc_ref to recursively call gfc_conv_component_ref. */ @@ -5199,8 +5199,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, && fsym->ts.type == BT_CLASS && !CLASS_DATA (fsym)->as && !CLASS_DATA (e)->as - && strcmp (fsym->ts.u.derived->name, - e->ts.u.derived->name)) + && fsym->ts.u.derived->name != e->ts.u.derived->name) { type = gfc_typenode_for_spec (&fsym->ts); var = gfc_create_var (type, fsym->name); @@ -6001,7 +6000,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, { formal = gfc_sym_get_dummy_args (sym->ns->proc_name); for (; formal; formal = formal->next) - if (strcmp (formal->sym->name, sym->name) == 0) + if (formal->sym->name == sym->name) cl.backend_decl = formal->sym->ts.u.cl->backend_decl; } len = cl.backend_decl; From patchwork Wed Sep 5 14:57:15 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Bernhard Reutner-Fischer X-Patchwork-Id: 966444 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-485241-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="JWsKQFYP"; dkim=pass (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="upOtgwRL"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4256Sk38wTz9s5c for ; Thu, 6 Sep 2018 01:05:10 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; q=dns; s=default; b=g4q CZ2GV5JjLHGYo5WXD3MRgakz/YSyWiK75UxqBx9eXFJ+lWPYpIkovEeA1q+eWkLo jgBxK77c9+O8c0X7E1wKCVFTPxr23a7zdWGIM66jLFPRGJHP4+N9GB3tlFgOof1+ oUZN6gR60FkanfN40s5dBf1til/eCrnHX8oBVcq0= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; s=default; bh=yQwS+xftQ kWyT1af81s6eDOegEo=; b=JWsKQFYPKixOzeW+iN0sqkj0D8YzpTNI5dyBhFCc/ x9J+ImqubGEiYREd/cYKu1CFLZ3/MkLmMkSr09h3j270yNHBVpzLXJMwMaDoqAwd vvt5p1oBA9G8V7kcnU9UAT2M7LwJuIHJtKPY8rIcNV05YAszlB+p/ar05fcB7F88 P4= Received: (qmail 70577 invoked by alias); 5 Sep 2018 14:58:11 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 69370 invoked by uid 89); 5 Sep 2018 14:58:01 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.8 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=HX-Received:sk:z12-v6m X-HELO: mail-wm0-f47.google.com Received: from mail-wm0-f47.google.com (HELO mail-wm0-f47.google.com) (74.125.82.47) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 05 Sep 2018 14:57:58 +0000 Received: by mail-wm0-f47.google.com with SMTP id y2-v6so8334923wma.1; Wed, 05 Sep 2018 07:57:58 -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=/CVrPrp2stIqToTV3z8MRH9QAYnsc5lQtryHN9mkLuo=; b=upOtgwRLGqSizKvsBN6OcXmzmttdbpfWTD2Yt+nPCsKY2J9ZqCe08WN7VStNyVZ3ae /Rbj6iJRLnKEtE3SEMXOzbvM3I87Ia19C+5tixjoWcnnRVlHEOXprGSiPbhvgWqzvqXV lCB7TzlJ5W22yDPSBNYu2yMfb+R4J3lcRu49VZ5uk4zWBZ8VuWnIzEZ620f2aHXHIYP8 XhgnUhg1S+wRXDK1jXIw4bcWXaT1TMblEfdHqE0GiBECSJYUIuSuIMiEsIlLvPoLa+/X nf1YUQzGAVivNYoTzH7/jlBj0N+cAhOEsyqX9e/SOQqS5e5q6+zYZkIg64JNITeDmNAW UBTQ== Received: from s46.loc (91-119-125-11.dsl.dynamic.surfer.at. [91.119.125.11]) by smtp.gmail.com with ESMTPSA id t69-v6sm1484432wmt.40.2018.09.05.07.57.48 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 05 Sep 2018 07:57:51 -0700 (PDT) Received: from cow by s46.loc with local (Exim 4.91) (envelope-from ) id 1fxZFZ-00007o-Dn; Wed, 05 Sep 2018 14:57:45 +0000 From: Bernhard Reutner-Fischer To: fortran@gcc.gnu.org Cc: Bernhard Reutner-Fischer , gcc-patches@gcc.gnu.org Subject: [PATCH,FORTRAN 12/29] Use stringpool for remaining names Date: Wed, 5 Sep 2018 14:57:15 +0000 Message-Id: <20180905145732.404-13-rep.dot.nop@gmail.com> In-Reply-To: References: MIME-Version: 1.0 X-IsSubscribed: yes From: Bernhard Reutner-Fischer This replaces the remaining occurrences of names and name manipulation to go through the stringpool. Required to make TYPE (IS) handling work later on. gcc/fortran/ChangeLog: 2017-11-14 Bernhard Reutner-Fischer * class.c (gfc_build_class_symbol): Use pointer for name. (generate_finalization_wrapper): Likewise. (gfc_find_derived_vtab): Likewise. (find_intrinsic_vtab): Likewise. * decl.c (gfc_get_pdt_instance): Likewise. * frontend-passes.c (create_do_loop): Likewise. * match.c (select_intrinsic_set_tmp): Likewise. * resolve.c (resolve_select_type): Likewise. (resolve_critical): Likewise. (get_temp_from_expr): Likewise. (resolve_component): Likewise. * trans-expr.c (alloc_scalar_allocatable_for_subcomponent_assignment): Likewise. * trans.c (gfc_deferred_strlen): Likewise. --- gcc/fortran/class.c | 44 ++++++++++++++++------------------- gcc/fortran/decl.c | 2 +- gcc/fortran/frontend-passes.c | 6 ++--- gcc/fortran/match.c | 6 ++--- gcc/fortran/resolve.c | 30 +++++++++++------------- gcc/fortran/trans-expr.c | 4 ++-- gcc/fortran/trans.c | 6 ++--- 7 files changed, 46 insertions(+), 52 deletions(-) diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index 8e637689fae..c2dc3411811 100644 --- a/gcc/fortran/class.c +++ b/gcc/fortran/class.c @@ -602,7 +602,7 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr, gfc_array_spec **as) { char tname[GFC_MAX_SYMBOL_LEN+1]; - char *name; + const char *name; gfc_symbol *fclass; gfc_symbol *vtab; gfc_component *c; @@ -633,17 +633,17 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr, rank = !(*as) || (*as)->rank == -1 ? GFC_MAX_DIMENSIONS : (*as)->rank; get_unique_hashed_string (tname, ts->u.derived); if ((*as) && attr->allocatable) - name = xasprintf ("__class_%s_%d_%da", tname, rank, (*as)->corank); + name = gfc_get_string ("__class_%s_%d_%da", tname, rank, (*as)->corank); else if ((*as) && attr->pointer) - name = xasprintf ("__class_%s_%d_%dp", tname, rank, (*as)->corank); + name = gfc_get_string ("__class_%s_%d_%dp", tname, rank, (*as)->corank); else if ((*as)) - name = xasprintf ("__class_%s_%d_%dt", tname, rank, (*as)->corank); + name = gfc_get_string ("__class_%s_%d_%dt", tname, rank, (*as)->corank); else if (attr->pointer) - name = xasprintf ("__class_%s_p", tname); + name = gfc_get_string ("__class_%s_p", tname); else if (attr->allocatable) - name = xasprintf ("__class_%s_a", tname); + name = gfc_get_string ("__class_%s_a", tname); else - name = xasprintf ("__class_%s_t", tname); + name = gfc_get_string ("__class_%s_t", tname); if (ts->u.derived->attr.unlimited_polymorphic) { @@ -738,7 +738,6 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr, ts->u.derived = fclass; attr->allocatable = attr->pointer = attr->dimension = attr->codimension = 0; (*as) = NULL; - free (name); return true; } @@ -1528,7 +1527,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, gfc_component *comp; gfc_namespace *sub_ns; gfc_code *last_code, *block; - char *name; + const char *name; bool finalizable_comp = false; bool expr_null_wrapper = false; gfc_expr *ancestor_wrapper = NULL, *rank; @@ -1607,7 +1606,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, sub_ns->resolved = 1; /* Set up the procedure symbol. */ - name = xasprintf ("__final_%s", tname); + name = gfc_get_string ("__final_%s", tname); gfc_get_symbol (name, sub_ns, &final); sub_ns->proc_name = final; final->attr.flavor = FL_PROCEDURE; @@ -2173,7 +2172,6 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, gfc_free_expr (rank); vtab_final->initializer = gfc_lval_expr_from_sym (final); vtab_final->ts.interface = final; - free (name); } @@ -2242,10 +2240,10 @@ gfc_find_derived_vtab (gfc_symbol *derived) if (ns) { char tname[GFC_MAX_SYMBOL_LEN+1]; - char *name; + const char *name; get_unique_hashed_string (tname, derived); - name = xasprintf ("__vtab_%s", tname); + name = gfc_get_string ("__vtab_%s", tname); /* Look for the vtab symbol in various namespaces. */ if (gsym && gsym->ns) @@ -2273,7 +2271,7 @@ gfc_find_derived_vtab (gfc_symbol *derived) vtab->attr.vtab = 1; vtab->attr.access = ACCESS_PUBLIC; gfc_set_sym_referenced (vtab); - name = xasprintf ("__vtype_%s", tname); + name = gfc_get_string ("__vtype_%s", tname); gfc_find_symbol (name, ns, 0, &vtype); if (vtype == NULL) @@ -2376,7 +2374,7 @@ gfc_find_derived_vtab (gfc_symbol *derived) else { /* Construct default initialization variable. */ - name = xasprintf ("__def_init_%s", tname); + name = gfc_get_string ("__def_init_%s", tname); gfc_get_symbol (name, ns, &def_init); def_init->attr.target = 1; def_init->attr.artificial = 1; @@ -2409,7 +2407,7 @@ gfc_find_derived_vtab (gfc_symbol *derived) ns->contained = sub_ns; sub_ns->resolved = 1; /* Set up procedure symbol. */ - name = xasprintf ("__copy_%s", tname); + name = gfc_get_string ("__copy_%s", tname); gfc_get_symbol (name, sub_ns, ©); sub_ns->proc_name = copy; copy->attr.flavor = FL_PROCEDURE; @@ -2486,7 +2484,7 @@ gfc_find_derived_vtab (gfc_symbol *derived) ns->contained = sub_ns; sub_ns->resolved = 1; /* Set up procedure symbol. */ - name = xasprintf ("__deallocate_%s", tname); + name = gfc_get_string ("__deallocate_%s", tname); gfc_get_symbol (name, sub_ns, &dealloc); sub_ns->proc_name = dealloc; dealloc->attr.flavor = FL_PROCEDURE; @@ -2535,7 +2533,6 @@ have_vtype: vtab->ts.u.derived = vtype; vtab->value = gfc_default_initializer (&vtab->ts); } - free (name); } found_sym = vtab; @@ -2628,13 +2625,13 @@ find_intrinsic_vtab (gfc_typespec *ts) if (ns) { char tname[GFC_MAX_SYMBOL_LEN+1]; - char *name; + const char *name; /* Encode all types as TYPENAME_KIND_ including especially character arrays, whose length is now consistently stored in the _len component of the class-variable. */ sprintf (tname, "%s_%d_", gfc_basic_typename (ts->type), ts->kind); - name = xasprintf ("__vtab_%s", tname); + name = gfc_get_string ("__vtab_%s", tname); /* Look for the vtab symbol in the top-level namespace only. */ gfc_find_symbol (name, ns, 0, &vtab); @@ -2651,7 +2648,7 @@ find_intrinsic_vtab (gfc_typespec *ts) vtab->attr.vtab = 1; vtab->attr.access = ACCESS_PUBLIC; gfc_set_sym_referenced (vtab); - name = xasprintf ("__vtype_%s", tname); + name = gfc_get_string ("__vtype_%s", tname); gfc_find_symbol (name, ns, 0, &vtype); if (vtype == NULL) @@ -2727,12 +2724,12 @@ find_intrinsic_vtab (gfc_typespec *ts) c->tb->ppc = 1; if (ts->type != BT_CHARACTER) - name = xasprintf ("__copy_%s", tname); + name = gfc_get_string ("__copy_%s", tname); else { /* __copy is always the same for characters. Check to see if copy function already exists. */ - name = xasprintf ("__copy_character_%d", ts->kind); + name = gfc_get_string ("__copy_character_%d", ts->kind); contained = ns->contained; for (; contained; contained = contained->sibling) if (contained->proc_name @@ -2801,7 +2798,6 @@ find_intrinsic_vtab (gfc_typespec *ts) vtab->ts.u.derived = vtype; vtab->value = gfc_default_initializer (&vtab->ts); } - free (name); } found_sym = vtab; diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 2baa1783434..48ef5637e36 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -3582,7 +3582,7 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym, /* Now we search for the PDT instance 'name'. If it doesn't exist, we build it, using 'pdt' as a template. */ - if (gfc_get_symbol (name, pdt->ns, &instance)) + if (gfc_get_symbol (gfc_get_string ("%s", name), pdt->ns, &instance)) { gfc_error ("Parameterized derived type at %C is ambiguous"); goto error_return; diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index 0a5e8937015..d549d8b6ffd 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -3427,7 +3427,7 @@ create_do_loop (gfc_expr *start, gfc_expr *end, gfc_expr *step, locus *where, gfc_namespace *ns, char *vname) { - char name[GFC_MAX_SYMBOL_LEN +1]; + const char *name; gfc_symtree *symtree; gfc_symbol *symbol; gfc_expr *i; @@ -3435,9 +3435,9 @@ create_do_loop (gfc_expr *start, gfc_expr *end, gfc_expr *step, locus *where, /* Create an expression for the iteration variable. */ if (vname) - sprintf (name, "__var_%d_do_%s", var_num++, vname); + name = gfc_get_string ("__var_%d_do_%s", var_num++, vname); else - sprintf (name, "__var_%d_do", var_num++); + name = gfc_get_string ("__var_%d_do", var_num++); if (gfc_get_sym_tree (name, ns, &symtree, false) != 0) diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index f27249ec6ed..2c4d6e8228c 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -6048,7 +6048,7 @@ select_type_push (gfc_symbol *sel) static gfc_symtree * select_intrinsic_set_tmp (gfc_typespec *ts) { - char name[GFC_MAX_SYMBOL_LEN]; + const char *name; gfc_symtree *tmp; HOST_WIDE_INT charlen = 0; @@ -6064,10 +6064,10 @@ select_intrinsic_set_tmp (gfc_typespec *ts) charlen = gfc_mpz_get_hwi (ts->u.cl->length->value.integer); if (ts->type != BT_CHARACTER) - sprintf (name, "__tmp_%s_%d", gfc_basic_typename (ts->type), + name = gfc_get_string ("__tmp_%s_%d", gfc_basic_typename (ts->type), ts->kind); else - snprintf (name, sizeof (name), "__tmp_%s_" HOST_WIDE_INT_PRINT_DEC "_%d", + name = gfc_get_string ("__tmp_%s_" HOST_WIDE_INT_PRINT_DEC "_%d", gfc_basic_typename (ts->type), charlen, ts->kind); gfc_get_sym_tree (name, gfc_current_ns, &tmp, false); diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index afb745bddc5..e98e6a6d53e 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -8842,7 +8842,7 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) gfc_code *class_is = NULL, *default_case = NULL; gfc_case *c; gfc_symtree *st; - char name[GFC_MAX_SYMBOL_LEN]; + const char *name; gfc_namespace *ns; int error = 0; int rank = 0; @@ -9096,21 +9096,20 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) 'global' one). */ if (c->ts.type == BT_CLASS) - sprintf (name, "__tmp_class_%s", c->ts.u.derived->name); + name = gfc_get_string ("__tmp_class_%s", c->ts.u.derived->name); else if (c->ts.type == BT_DERIVED) - sprintf (name, "__tmp_type_%s", c->ts.u.derived->name); + name = gfc_get_string ("__tmp_type_%s", c->ts.u.derived->name); else if (c->ts.type == BT_CHARACTER) { HOST_WIDE_INT charlen = 0; if (c->ts.u.cl && c->ts.u.cl->length && c->ts.u.cl->length->expr_type == EXPR_CONSTANT) charlen = gfc_mpz_get_hwi (c->ts.u.cl->length->value.integer); - snprintf (name, sizeof (name), - "__tmp_%s_" HOST_WIDE_INT_PRINT_DEC "_%d", + name = gfc_get_string ("__tmp_%s_" HOST_WIDE_INT_PRINT_DEC "_%d", gfc_basic_typename (c->ts.type), charlen, c->ts.kind); } else - sprintf (name, "__tmp_%s_%d", gfc_basic_typename (c->ts.type), + name = gfc_get_string ("__tmp_%s_%d", gfc_basic_typename (c->ts.type), c->ts.kind); st = gfc_find_symtree (ns->sym_root, name); @@ -9553,20 +9552,19 @@ resolve_critical (gfc_code *code) { gfc_symtree *symtree; gfc_symbol *lock_type; - char name[GFC_MAX_SYMBOL_LEN]; + const char *name; static int serial = 0; if (flag_coarray != GFC_FCOARRAY_LIB) return; - symtree = gfc_find_symtree (gfc_current_ns->sym_root, - GFC_PREFIX ("lock_type")); + name = gfc_get_string (GFC_PREFIX ("lock_type")); + symtree = gfc_find_symtree (gfc_current_ns->sym_root, name); if (symtree) lock_type = symtree->n.sym; else { - if (gfc_get_sym_tree (GFC_PREFIX ("lock_type"), gfc_current_ns, &symtree, - false) != 0) + if (gfc_get_sym_tree (name, gfc_current_ns, &symtree, false) != 0) gcc_unreachable (); lock_type = symtree->n.sym; lock_type->attr.flavor = FL_DERIVED; @@ -9575,7 +9573,7 @@ resolve_critical (gfc_code *code) lock_type->intmod_sym_id = ISOFORTRAN_LOCK_TYPE; } - sprintf(name, GFC_PREFIX ("lock_var") "%d",serial++); + name = gfc_get_string (GFC_PREFIX ("lock_var") "%d", serial++); if (gfc_get_sym_tree (name, gfc_current_ns, &symtree, false) != 0) gcc_unreachable (); @@ -10569,13 +10567,13 @@ static gfc_expr* get_temp_from_expr (gfc_expr *e, gfc_namespace *ns) { static int serial = 0; - char name[GFC_MAX_SYMBOL_LEN]; + const char *name; gfc_symtree *tmp; gfc_array_spec *as; gfc_array_ref *aref; gfc_ref *ref; - sprintf (name, GFC_PREFIX("DA%d"), serial++); + name = gfc_get_string (GFC_PREFIX("DA%d"), serial++); gfc_get_sym_tree (name, ns, &tmp, false); gfc_add_type (tmp->n.sym, &e->ts, NULL); @@ -13956,9 +13954,9 @@ resolve_component (gfc_component *c, gfc_symbol *sym) && !c->attr.function && !sym->attr.is_class) { - char name[GFC_MAX_SYMBOL_LEN+9]; + const char *name; gfc_component *strlen; - sprintf (name, "_%s_length", c->name); + name = gfc_get_string ("_%s_length", c->name); strlen = gfc_find_component (sym, name, true, true, NULL); if (strlen == NULL) { diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 6c8a5b30568..d502c127951 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -7307,7 +7307,7 @@ alloc_scalar_allocatable_for_subcomponent_assignment (stmtblock_t *block, if (cm->ts.type == BT_CHARACTER && cm->ts.deferred) { - char name[GFC_MAX_SYMBOL_LEN+9]; + const char *name; gfc_component *strlen; /* Use the rhs string length and the lhs element size. */ gcc_assert (expr2->ts.type == BT_CHARACTER); @@ -7321,7 +7321,7 @@ alloc_scalar_allocatable_for_subcomponent_assignment (stmtblock_t *block, /* Ensure that cm->ts.u.cl->backend_decl is a componentref to _%s_length component. */ - sprintf (name, "_%s_length", cm->name); + name = gfc_get_string ("_%s_length", cm->name); strlen = gfc_find_component (sym, name, true, true, NULL); lhs_cl_size = fold_build3_loc (input_location, COMPONENT_REF, gfc_charlen_type_node, diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index 153bab63396..66ba0572e0c 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -2330,14 +2330,14 @@ gfc_likely (tree cond, enum br_predictor predictor) bool gfc_deferred_strlen (gfc_component *c, tree *decl) { - char name[GFC_MAX_SYMBOL_LEN+9]; + const char *name; gfc_component *strlen; if (!(c->ts.type == BT_CHARACTER && (c->ts.deferred || c->attr.pdt_string))) return false; - sprintf (name, "_%s_length", c->name); + name = gfc_get_string ("_%s_length", c->name); for (strlen = c; strlen; strlen = strlen->next) - if (strcmp (strlen->name, name) == 0) + if (strlen->name == name) break; *decl = strlen ? strlen->backend_decl : NULL_TREE; return strlen != NULL; From patchwork Wed Sep 5 14:57:16 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Bernhard Reutner-Fischer X-Patchwork-Id: 966430 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-485228-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="vSLMJBB4"; dkim=pass (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="hzdC0gAV"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4256Mn50W7z9sD2 for ; Thu, 6 Sep 2018 01:00:53 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; q=dns; s=default; b=JBT /APMf81JGkI/Lsw/RurdPPFnEbCYUsG3TQqdcqx+Qr7I1lxuagRdyOFzLvY/SczB vOrNfIe171T2ummm5v5tg/pQ5Dp46ey59BE1bPK3nGjitrvTgouJe0FlVwNSBNBv 9S/sjKknjKikzgV/0f6ZIcJaQvcy1ssI/u8YXcmM= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; s=default; bh=9Fd8y0Efc cFaRC2riQJW8HseaGg=; b=vSLMJBB4j0s1R5e4GDW8I9KY7ihTOXgVrWecnYce0 YJX1RY6fsuDBO0lc1MfIUO7O+HPlsJfzmVPFrPindXbbFKODgv52o6kgyCIkc3ep C0OlH1EHnlqn0RDtaJUNo+gc44rVqMum/9Mowd2xMKvvopy09AcoBYzG7QH6N7iy mw= Received: (qmail 69095 invoked by alias); 5 Sep 2018 14:57:59 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 68505 invoked by uid 89); 5 Sep 2018 14:57:54 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.7 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= X-HELO: mail-wm0-f48.google.com Received: from mail-wm0-f48.google.com (HELO mail-wm0-f48.google.com) (74.125.82.48) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 05 Sep 2018 14:57:52 +0000 Received: by mail-wm0-f48.google.com with SMTP id b19-v6so8340401wme.3; Wed, 05 Sep 2018 07:57:52 -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=XAEHNH6jBpMiP0Le4ohfUKzpTRMmT0QHMUEr3aBHyFA=; b=hzdC0gAVRLRLLd6ff4tF81HrPzRYRmfH2G3C9oDZg+GfwRbqtIJ2u9lT4Bx/Fr+TX5 Dw7vucijUJlZr2u2x292WaR+xwXny4Ag+TCqeTxspWoJR20nL5zPYfNxC8B/Wls/c9p5 8Qi/nCWaCqYhgEdllgnAp6lsFD5/c8SpTyRLFa2wcUEeZMIWVnXhMvDBj1vRC9f66JkY JYDvj74sYqyeRayeMZvSs8O3xgwd00SY21QYNueSGbt5KGCEvBz4pcMn5Awyk4g5uvi/ 4vDw2ZREbofqFjP1mcKin4Hu3TI69tq6HxvKhys8JagvX+lX19laPs37jlMcwP7qQRYd h8Mw== Received: from s46.loc (91-119-125-11.dsl.dynamic.surfer.at. [91.119.125.11]) by smtp.gmail.com with ESMTPSA id 144-v6sm3219583wma.45.2018.09.05.07.57.47 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 05 Sep 2018 07:57:49 -0700 (PDT) Received: from cow by s46.loc with local (Exim 4.91) (envelope-from ) id 1fxZFZ-00007r-Hx; Wed, 05 Sep 2018 14:57:45 +0000 From: Bernhard Reutner-Fischer To: fortran@gcc.gnu.org Cc: Bernhard Reutner-Fischer , gcc-patches@gcc.gnu.org Subject: [PATCH,FORTRAN 13/29] Use stringpool for intrinsics and common Date: Wed, 5 Sep 2018 14:57:16 +0000 Message-Id: <20180905145732.404-14-rep.dot.nop@gmail.com> In-Reply-To: References: MIME-Version: 1.0 X-IsSubscribed: yes From: Bernhard Reutner-Fischer gcc/fortran/ChangeLog: 2017-11-15 Bernhard Reutner-Fischer * gfortran.h (struct gfc_common_head, struct gfc_intrinsic_arg): Make name a pointer. * intrinsic.c (add_sym): Use stringpool for name. * match.c (gfc_get_common): Likewise. * symbol.c (set_symbol_common_block): Likewise. * trans-common.c (gfc_sym_mangled_common_id): Likewise. (finish_equivalences): Likewise. (gfc_trans_common): Likewise. --- gcc/fortran/gfortran.h | 4 ++-- gcc/fortran/intrinsic.c | 11 +++-------- gcc/fortran/match.c | 2 +- gcc/fortran/symbol.c | 2 +- gcc/fortran/trans-common.c | 10 +++++----- 5 files changed, 12 insertions(+), 17 deletions(-) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index cb9195d393e..039719644ea 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1641,7 +1641,7 @@ typedef struct gfc_common_head char use_assoc, saved, threadprivate; unsigned char omp_declare_target : 1; unsigned char omp_declare_target_link : 1; - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name; struct gfc_symbol *head; const char* binding_label; int is_bind_c; @@ -1978,7 +1978,7 @@ gfc_ref; /* Structures representing intrinsic symbols and their arguments lists. */ typedef struct gfc_intrinsic_arg { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name; gfc_typespec ts; unsigned optional:1, value:1; diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 609668613a7..3a32a7824bf 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -317,7 +317,6 @@ add_sym (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type int standard, gfc_check_f check, gfc_simplify_f simplify, gfc_resolve_f resolve, ...) { - char buf[GFC_MAX_SYMBOL_LEN + 11]; /* 10 for '_gfortran_', 1 for '\0' */ int optional, first_flag; sym_intent intent; va_list argp; @@ -334,11 +333,7 @@ add_sym (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type case SZ_NOTHING: next_sym->name = gfc_get_string ("%s", name); - - strcpy (buf, "_gfortran_"); - strcat (buf, name); - next_sym->lib_name = gfc_get_string ("%s", buf); - + next_sym->lib_name = gfc_get_string ("_gfortran_%s", name); next_sym->pure = (cl != CLASS_IMPURE); next_sym->elemental = (cl == CLASS_ELEMENTAL); next_sym->inquiry = (cl == CLASS_INQUIRY); @@ -388,7 +383,7 @@ add_sym (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type first_flag = 0; - strcpy (next_arg->name, name); + next_arg->name = gfc_get_string ("%s", name); next_arg->ts.type = type; next_arg->ts.kind = kind; next_arg->optional = optional; @@ -4145,7 +4140,7 @@ keywords: for (; a; a = a->next) { for (f = formal; f; f = f->next) - if (strcmp (a->name, f->name) == 0) + if (a->name == f->name) break; if (f == NULL) diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 2c4d6e8228c..fd91e280b93 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -5029,7 +5029,7 @@ gfc_get_common (const char *name, int from_module) { st->n.common = gfc_get_common_head (); st->n.common->where = gfc_current_locus; - strcpy (st->n.common->name, name); + st->n.common->name = name; } return st->n.common; diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 00a178772df..cc9d4e3f9d8 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -3057,7 +3057,7 @@ set_symbol_common_block (gfc_symbol *sym, gfc_common_head *common_block) if (sym->common_block == common_block) return; - if (sym->common_block && sym->common_block->name[0] != '\0') + if (sym->common_block && sym->common_block->name != NULL) { sym->common_block->refs--; if (sym->common_block->refs == 0) diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c index bd9721dee41..18f87e00320 100644 --- a/gcc/fortran/trans-common.c +++ b/gcc/fortran/trans-common.c @@ -243,16 +243,16 @@ gfc_sym_mangled_common_id (gfc_common_head *com) { int has_underscore; char mangled_name[GFC_MAX_MANGLED_SYMBOL_LEN + 1]; - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name; /* Get the name out of the common block pointer. */ - strcpy (name, com->name); + name = com->name; /* If we're suppose to do a bind(c). */ if (com->is_bind_c == 1 && com->binding_label) return get_identifier (com->binding_label); - if (strcmp (name, BLANK_COMMON_NAME) == 0) + if (name == gfc_get_string (BLANK_COMMON_NAME)) return get_identifier (name); if (flag_underscoring) @@ -1252,7 +1252,7 @@ finish_equivalences (gfc_namespace *ns) c->where = ns->proc_name->declared_at; else if (ns->is_block_data) c->where = ns->sym_root->n.sym->declared_at; - strcpy (c->name, z->module); + c->name = z->module; } else c = NULL; @@ -1286,7 +1286,7 @@ gfc_trans_common (gfc_namespace *ns) { c = gfc_get_common_head (); c->where = ns->blank_common.head->common_head->where; - strcpy (c->name, BLANK_COMMON_NAME); + c->name = gfc_get_string (BLANK_COMMON_NAME); translate_common (c, ns->blank_common.head); } From patchwork Wed Sep 5 14:57:17 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Bernhard Reutner-Fischer X-Patchwork-Id: 966433 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-485229-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="UTQcnTx0"; dkim=pass (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="oLROz4VG"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4256Nr3kPxz9sCn for ; Thu, 6 Sep 2018 01:01:47 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; q=dns; s=default; b=pJl bE91BJl5ElxkY6K1HsS03YUt4IluTXt4oaDgoUJqy4ixSXqGEe+8IHcQu4jGBx/h jnyNQjC4b2U9UXg2xw3mWPYSKUstPGDns53Qdm15SGJ7qkhwJ23fdQEU4Jyq5zZ3 wM6J9ziMZqmEz3YNbQ2kAWpW8uCKK3dTIBCAKRbs= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; s=default; bh=CXt+jfl30 q3PEfqTjGGx8BSL8jI=; b=UTQcnTx0Hfd96UEqR/gNvRWxXcIyjzmqArEOfRTgB CSiG/W4zBT127c5dH4HuzjYmVi8HOjlfXAt2izIKHShOfTXetGdhl1YuuVzSdIqF NWOUz2xq18MGD64NWH8iBSWI+EZRq1gNW8lglxc5PlWa1jc2/9WRqFFNOsNf7laj 9E= Received: (qmail 69297 invoked by alias); 5 Sep 2018 14:58:00 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 68569 invoked by uid 89); 5 Sep 2018 14:57:55 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.7 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=Hx-languages-length:1459 X-HELO: mail-wm0-f47.google.com Received: from mail-wm0-f47.google.com (HELO mail-wm0-f47.google.com) (74.125.82.47) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 05 Sep 2018 14:57:53 +0000 Received: by mail-wm0-f47.google.com with SMTP id n11-v6so8057993wmc.2; Wed, 05 Sep 2018 07:57:53 -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=Q9rtq/sc/pgIp5eXCTv2YkdzqGruCT8VDLBbmhOmzGY=; b=oLROz4VGwPTf7kcc4Tfgq+57Wew3bZ+dj4i+ekyjhmHdhrMkSDJuaIQgmv+X6FeEEX OgkmhsG92HErAjqmAloUboigv/3Nxn4oD3rsIQ1VDtUSzRwweHBWGR8w1e3Bg0QL0sHg javIuawCq1oudV1zHddPIizJOxYJMQobjjjWyqgAljRCnBrByFYTNcvqeXjQY99y0Pd7 5YwAssspEop0NFmVCqkb9xnFEOVWJmtzJ+IZ0lKw+H9y7w/yXS1B0TUW9N+Xh3uvKjMr X+qu7HF6dymm6OMmqQMc/ICHOL4JUuiVRwuCExUNr9AID33ndlntJzJ7AkgZhLiBcfb7 6oWQ== Received: from s46.loc (91-119-125-11.dsl.dynamic.surfer.at. [91.119.125.11]) by smtp.gmail.com with ESMTPSA id b189-v6sm3037387wmd.39.2018.09.05.07.57.47 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 05 Sep 2018 07:57:49 -0700 (PDT) Received: from cow by s46.loc with local (Exim 4.91) (envelope-from ) id 1fxZFZ-00007u-ME; Wed, 05 Sep 2018 14:57:45 +0000 From: Bernhard Reutner-Fischer To: fortran@gcc.gnu.org Cc: Bernhard Reutner-Fischer , gcc-patches@gcc.gnu.org, Jakub Jelinek Subject: [PATCH, FORTRAN 14/29] Fix write_omp_udr for user-operator REDUCTIONs Date: Wed, 5 Sep 2018 14:57:17 +0000 Message-Id: <20180905145732.404-15-rep.dot.nop@gmail.com> In-Reply-To: References: MIME-Version: 1.0 X-IsSubscribed: yes From: Bernhard Reutner-Fischer Due to a typo a user operator used in a reduction was not found in the symtree so would have been written multiple times (in theory). E.g. user operator ".add." was looked up as ".ad" instead of "add". For gcc-8 branch and earlier one would - memcpy (name, udr->name, len - 1); + memcpy (name, udr->name + 1, len - 1); but for gcc-9 we have an appropriate helper already. Jakub, please take care of non-trunk branches if you want it fixed there. gcc/fortran/ChangeLog: 2017-11-16 Bernhard Reutner-Fischer * module.c (write_omp_udr): Use gfc_get_name_from_uop. --- gcc/fortran/module.c | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index fe5ae34dd13..b94411ac68b 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -5685,12 +5685,8 @@ write_omp_udr (gfc_omp_udr *udr) return; else { - gfc_symtree *st; - size_t len = strlen (udr->name + 1); - char *name = XALLOCAVEC (char, len); - memcpy (name, udr->name, len - 1); - name[len - 1] = '\0'; - st = gfc_find_symtree (gfc_current_ns->uop_root, name); + const char *name = gfc_get_name_from_uop (udr->name); + gfc_symtree *st = gfc_find_symtree (gfc_current_ns->uop_root, name); /* If corresponding user operator is private, don't write the UDR. */ if (st != NULL) From patchwork Wed Sep 5 14:57:18 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Bernhard Reutner-Fischer X-Patchwork-Id: 966450 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-485247-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="wL7o7VEk"; dkim=pass (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="M1h+vLuc"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4256Vm4G8Zz9s5c for ; Thu, 6 Sep 2018 01:06:55 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; q=dns; s=default; b=m4v ye9OrKHY7/Zyy9Zul7red0hjACqKEMliGMm1VmXTjQcXqEyRRgtBxU+lxvcSRhfp Xs5OKgqQqhW+c+m2xM4XDUgLGaVVKFbY2XOh2RyeqRRKN8peJmziKWkk40rP+pSw sEaZDi1iDL+piGmIKFEJ93eQW/TLcryaM91QKcfE= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; s=default; bh=Pd6NQOTTv mnVp4oWaBLYSbJrDhk=; b=wL7o7VEkEpr4cORQHp7O1aSbuoPBzq9+n5kgAlXJW Oo8HmXhNy8+3+smElnyV+g4wMz0sBRCfvTBuduWWFXhKbbvLt0V4JBVLT4QCEOeJ XDCWdVsdwXPw/4wEtmN5rLpVKT+xgrxYTL4Dfr7o7+XMwUugaWxynPlgSb8SsT54 TM= Received: (qmail 103406 invoked by alias); 5 Sep 2018 15:02:53 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 103167 invoked by uid 89); 5 Sep 2018 15:02:52 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.8 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= X-HELO: mail-wm0-f43.google.com Received: from mail-wm0-f43.google.com (HELO mail-wm0-f43.google.com) (74.125.82.43) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 05 Sep 2018 15:02:49 +0000 Received: by mail-wm0-f43.google.com with SMTP id t25-v6so8074388wmi.3; Wed, 05 Sep 2018 08:02:49 -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=CdsBaF20ZtwuwyVD/U3LDMIbZ2+nQaqFpPsSlLytU28=; b=M1h+vLuc/EE3pXsay3x/2phmfchycWie5Ei32okb+dAgyL82UfiHX88TLr0tAkv4PA GNPyvMr8EnolUWgZWPZxkHWQb3M4pefcGm1vFg7BMxxSxwMp6n9aU4kh2P7qqFSXJVdj FbsATgZkV7ynAuGClYknmlyN0+Hx+dM7AuRUVppwNtpHp+ffst9GiqYfaLd7oPGtBpWy ihJGNlWgrQ6XQ5xwPf6Uvp5DggfQw0y75XLP/asdcBG6oXTB6ezR8vMZKDdmDZTjOh5f c6HXqfN8UH38SjunCVS8FE0noAYxqlA1bLILR0orrtNm+xjIC3SsqHYiPbIJ66lS1BKu bEaQ== Received: from s46.loc (91-119-125-11.dsl.dynamic.surfer.at. [91.119.125.11]) by smtp.gmail.com with ESMTPSA id l18-v6sm2501052wru.75.2018.09.05.08.02.46 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 05 Sep 2018 08:02:46 -0700 (PDT) Received: from cow by s46.loc with local (Exim 4.91) (envelope-from ) id 1fxZFZ-00007x-Qb; Wed, 05 Sep 2018 14:57:45 +0000 From: Bernhard Reutner-Fischer To: fortran@gcc.gnu.org Cc: Bernhard Reutner-Fischer , gcc-patches@gcc.gnu.org Subject: [PATCH, FORTRAN 15/29] Use stringpool for iso_c_binding module names Date: Wed, 5 Sep 2018 14:57:18 +0000 Message-Id: <20180905145732.404-16-rep.dot.nop@gmail.com> In-Reply-To: References: MIME-Version: 1.0 X-IsSubscribed: yes From: Bernhard Reutner-Fischer gcc/fortran/ChangeLog: 2017-11-20 Bernhard Reutner-Fischer * gfortran.h (struct CInteropKind_t): Make name a pointer. * misc.c (get_c_kind): Use pointer comparison on name to determine index. * symbol.c (generate_isocbinding_symbol): Use stringpool pointer for argument to get_c_kind (). * trans-types.c (gfc_init_c_interop_kinds): Use stringpool node for name. * module.c (import_iso_c_binding_module): Likewise. --- gcc/fortran/gfortran.h | 2 +- gcc/fortran/misc.c | 2 +- gcc/fortran/module.c | 16 +++++++++------- gcc/fortran/symbol.c | 3 ++- gcc/fortran/trans-types.c | 20 ++++++++++---------- 5 files changed, 23 insertions(+), 20 deletions(-) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 039719644ea..0e164c35300 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -719,7 +719,7 @@ enum intmod_id typedef struct { - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name; int value; /* Used for both integer and character values. */ bt f90_type; } diff --git a/gcc/fortran/misc.c b/gcc/fortran/misc.c index fb18c5ceb6f..29aae591ed3 100644 --- a/gcc/fortran/misc.c +++ b/gcc/fortran/misc.c @@ -278,7 +278,7 @@ get_c_kind(const char *c_kind_name, CInteropKind_t kinds_table[]) int index = 0; for (index = 0; index < ISOCBINDING_LAST; index++) - if (strcmp (kinds_table[index].name, c_kind_name) == 0) + if (kinds_table[index].name == c_kind_name) return index; return ISOCBINDING_INVALID; diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index b94411ac68b..22d9abb247f 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -6357,27 +6357,27 @@ import_iso_c_binding_module (void) #define NAMED_FUNCTION(a,b,c,d) \ case a: \ not_in_std = (gfc_option.allow_std & d) == 0; \ - name = b; \ + name = gfc_get_string ("%s", b); \ break; #define NAMED_SUBROUTINE(a,b,c,d) \ case a: \ not_in_std = (gfc_option.allow_std & d) == 0; \ - name = b; \ + name = gfc_get_string ("%s", b); \ break; #define NAMED_INTCST(a,b,c,d) \ case a: \ not_in_std = (gfc_option.allow_std & d) == 0; \ - name = b; \ + name = gfc_get_string ("%s", b); \ break; #define NAMED_REALCST(a,b,c,d) \ case a: \ not_in_std = (gfc_option.allow_std & d) == 0; \ - name = b; \ + name = gfc_get_string ("%s", b); \ break; #define NAMED_CMPXCST(a,b,c,d) \ case a: \ not_in_std = (gfc_option.allow_std & d) == 0; \ - name = b; \ + name = gfc_get_string ("%s", b); \ break; #include "iso-c-binding.def" default: @@ -6481,13 +6481,15 @@ import_iso_c_binding_module (void) return_type = c_funptr->n.sym; \ else \ return_type = NULL; \ - create_intrinsic_function (b, a, iso_c_module_name, \ + create_intrinsic_function (gfc_get_string ("%s", b), \ + a, iso_c_module_name, \ INTMOD_ISO_C_BINDING, false, \ return_type); \ break; #define NAMED_SUBROUTINE(a,b,c,d) \ case a: \ - create_intrinsic_function (b, a, iso_c_module_name, \ + create_intrinsic_function (gfc_get_string ("%s", b), \ + a, iso_c_module_name, \ INTMOD_ISO_C_BINDING, true, NULL); \ break; #include "iso-c-binding.def" diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index cc9d4e3f9d8..ce134d2b441 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -4985,7 +4985,8 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s, tmp_comp->ts.f90_type = BT_INTEGER; /* The kinds for c_ptr and c_funptr are the same. */ - index = get_c_kind ("c_ptr", c_interop_kinds_table); + index = get_c_kind (gfc_get_string ("%s", "c_ptr"), + c_interop_kinds_table); tmp_comp->ts.kind = c_interop_kinds_table[index].value; tmp_comp->attr.access = ACCESS_PRIVATE; diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 46f6d8c03a6..deb9993b0e3 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -360,45 +360,45 @@ gfc_init_c_interop_kinds (void) for (i = 0; i < ISOCBINDING_NUMBER; i++) { /* Initialize the name and value fields. */ - c_interop_kinds_table[i].name[0] = '\0'; + c_interop_kinds_table[i].name = NULL; c_interop_kinds_table[i].value = -100; c_interop_kinds_table[i].f90_type = BT_UNKNOWN; } #define NAMED_INTCST(a,b,c,d) \ - strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \ + c_interop_kinds_table[a].name = gfc_get_string ("%s", b); \ c_interop_kinds_table[a].f90_type = BT_INTEGER; \ c_interop_kinds_table[a].value = c; #define NAMED_REALCST(a,b,c,d) \ - strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \ + c_interop_kinds_table[a].name = gfc_get_string ("%s", b); \ c_interop_kinds_table[a].f90_type = BT_REAL; \ c_interop_kinds_table[a].value = c; #define NAMED_CMPXCST(a,b,c,d) \ - strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \ + c_interop_kinds_table[a].name = gfc_get_string ("%s", b); \ c_interop_kinds_table[a].f90_type = BT_COMPLEX; \ c_interop_kinds_table[a].value = c; #define NAMED_LOGCST(a,b,c) \ - strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \ + c_interop_kinds_table[a].name = gfc_get_string ("%s", b); \ c_interop_kinds_table[a].f90_type = BT_LOGICAL; \ c_interop_kinds_table[a].value = c; #define NAMED_CHARKNDCST(a,b,c) \ - strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \ + c_interop_kinds_table[a].name = gfc_get_string ("%s", b); \ c_interop_kinds_table[a].f90_type = BT_CHARACTER; \ c_interop_kinds_table[a].value = c; #define NAMED_CHARCST(a,b,c) \ - strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \ + c_interop_kinds_table[a].name = gfc_get_string ("%s", b); \ c_interop_kinds_table[a].f90_type = BT_CHARACTER; \ c_interop_kinds_table[a].value = c; #define DERIVED_TYPE(a,b,c) \ - strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \ + c_interop_kinds_table[a].name = gfc_get_string ("%s", b); \ c_interop_kinds_table[a].f90_type = BT_DERIVED; \ c_interop_kinds_table[a].value = c; #define NAMED_FUNCTION(a,b,c,d) \ - strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \ + c_interop_kinds_table[a].name = gfc_get_string ("%s", b); \ c_interop_kinds_table[a].f90_type = BT_PROCEDURE; \ c_interop_kinds_table[a].value = c; #define NAMED_SUBROUTINE(a,b,c,d) \ - strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \ + c_interop_kinds_table[a].name = gfc_get_string ("%s", b); \ c_interop_kinds_table[a].f90_type = BT_PROCEDURE; \ c_interop_kinds_table[a].value = c; #include "iso-c-binding.def" From patchwork Wed Sep 5 14:57:19 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Bernhard Reutner-Fischer X-Patchwork-Id: 966451 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-485248-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="pg2XjE0H"; dkim=pass (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="AT7pBe7N"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4256W05wFwz9s5c for ; Thu, 6 Sep 2018 01:07:08 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; q=dns; s=default; b=Oro JnwBx8CaMzFiMzaBfwnYzVfWPJWqfwjQT2BO021hVQSNscFKyefV8gp4Ghjd5p85 +pcSLMlC8WEkOxOlNZQ2pmhK5c5scuebm07DQkQStLR21lzwNSwvbLQX6XvtCnFE zd4FiMB6LSCZxWXt5pzRCMyATzDk45v4wcKhTzgk= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; s=default; bh=DwIa/Gcu0 TYzABQCrgLOHmTxNxA=; b=pg2XjE0HMRP5d4VRsgdQE/h0XYAkx38NdSdFuJX9e jvRy7+oXvZilBHgSjSIL9XKcmJYKOtfblSqqMF1Vm+JhbKDqphvBUzdb4qG5kX1X IICJjv7fUKTYZrTw5LlrfqUm6HbzHvjaiHqhdcaPJsKhIyqwDO7ol5COr/JceMgD cI= Received: (qmail 103601 invoked by alias); 5 Sep 2018 15:02:54 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 103324 invoked by uid 89); 5 Sep 2018 15:02:53 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.8 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= X-HELO: mail-wm0-f50.google.com Received: from mail-wm0-f50.google.com (HELO mail-wm0-f50.google.com) (74.125.82.50) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 05 Sep 2018 15:02:46 +0000 Received: by mail-wm0-f50.google.com with SMTP id j192-v6so8145580wmj.1; Wed, 05 Sep 2018 08:02:46 -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=YTmOtcd8SmORcujhjamwRExQHeqJWt+Cpwk+WCAv+VU=; b=AT7pBe7NoN/uYd4VvOEL0CrEJmM4ZyTKrj83DN0/TMcDd3AlxyQ9IOk+bIkQvg6JOb iYtjmGgBG0mpdgoLcpOP61DKzcsp2A9Aynmu4LbzESmVMVV8+y52LZ4/y6CK+HrzD/sv 35cX57RgmlYpYFGNcNFIaLaWrAnxOXrp07xUgshaq4Qmewe+G3a758RzGkU0qOyAY6aP 8PJwigCCsc7eEr6JzxQ8DlM6REHSTacGtMvjuI8o4EG+ub1HupigY1U69DcdVsjaBoqZ 6x0gbhB161gWIvq5nawIdk6TOUrSOJmhadQvCzPkjMuca2jEGZ1thgfboITkUW2kExAf slWw== Received: from s46.loc (91-119-125-11.dsl.dynamic.surfer.at. [91.119.125.11]) by smtp.gmail.com with ESMTPSA id y203-v6sm2410188wmd.1.2018.09.05.08.02.43 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 05 Sep 2018 08:02:43 -0700 (PDT) Received: from cow by s46.loc with local (Exim 4.91) (envelope-from ) id 1fxZFZ-000080-VB; Wed, 05 Sep 2018 14:57:45 +0000 From: Bernhard Reutner-Fischer To: fortran@gcc.gnu.org Cc: Bernhard Reutner-Fischer , gcc-patches@gcc.gnu.org Subject: [PATCH, FORTRAN 16/29] Do pointer comparison in iso_c_binding_module Date: Wed, 5 Sep 2018 14:57:19 +0000 Message-Id: <20180905145732.404-17-rep.dot.nop@gmail.com> In-Reply-To: References: MIME-Version: 1.0 X-IsSubscribed: yes From: Bernhard Reutner-Fischer gcc/fortran/ChangeLog: 2017-11-23 Bernhard Reutner-Fischer * module.c (import_iso_c_binding_module): Use pointer comparison instead instead of strcmp. --- gcc/fortran/module.c | 25 ++++++++++--------------- 1 file changed, 10 insertions(+), 15 deletions(-) diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 22d9abb247f..d7bc7fbef1c 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -6269,7 +6269,7 @@ import_iso_c_binding_module (void) gfc_symbol *mod_sym = NULL, *return_type; gfc_symtree *mod_symtree = NULL, *tmp_symtree; gfc_symtree *c_ptr = NULL, *c_funptr = NULL; - const char *iso_c_module_name = "__iso_c_binding"; + const char *iso_c_module_name = gfc_get_string ("%s", "__iso_c_binding"); gfc_use_rename *u; int i; bool want_c_ptr = false, want_c_funptr = false; @@ -6291,7 +6291,7 @@ import_iso_c_binding_module (void) mod_sym->attr.flavor = FL_MODULE; mod_sym->attr.intrinsic = 1; - mod_sym->module = gfc_get_string ("%s", iso_c_module_name); + mod_sym->module = iso_c_module_name; mod_sym->from_intmod = INTMOD_ISO_C_BINDING; } @@ -6300,27 +6300,22 @@ import_iso_c_binding_module (void) need C_(FUN)PTR. */ for (u = gfc_rename_list; u; u = u->next) { - if (strcmp (c_interop_kinds_table[ISOCBINDING_NULL_PTR].name, - u->use_name) == 0) + if (c_interop_kinds_table[ISOCBINDING_NULL_PTR].name == u->use_name) want_c_ptr = true; - else if (strcmp (c_interop_kinds_table[ISOCBINDING_LOC].name, - u->use_name) == 0) + else if (c_interop_kinds_table[ISOCBINDING_LOC].name == u->use_name) want_c_ptr = true; - else if (strcmp (c_interop_kinds_table[ISOCBINDING_NULL_FUNPTR].name, - u->use_name) == 0) + else if (c_interop_kinds_table[ISOCBINDING_NULL_FUNPTR].name == + u->use_name) want_c_funptr = true; - else if (strcmp (c_interop_kinds_table[ISOCBINDING_FUNLOC].name, - u->use_name) == 0) + else if (c_interop_kinds_table[ISOCBINDING_FUNLOC].name == u->use_name) want_c_funptr = true; - else if (strcmp (c_interop_kinds_table[ISOCBINDING_PTR].name, - u->use_name) == 0) + else if (c_interop_kinds_table[ISOCBINDING_PTR].name == u->use_name) { c_ptr = generate_isocbinding_symbol (iso_c_module_name, (iso_c_binding_symbol) ISOCBINDING_PTR, u->local_name ? u->local_name : u->use_name, NULL, false); } - else if (strcmp (c_interop_kinds_table[ISOCBINDING_FUNPTR].name, - u->use_name) == 0) + else if (c_interop_kinds_table[ISOCBINDING_FUNPTR].name == u->use_name) { c_funptr = generate_isocbinding_symbol (iso_c_module_name, (iso_c_binding_symbol) ISOCBINDING_FUNPTR, @@ -6345,7 +6340,7 @@ import_iso_c_binding_module (void) { bool found = false; for (u = gfc_rename_list; u; u = u->next) - if (strcmp (c_interop_kinds_table[i].name, u->use_name) == 0) + if (c_interop_kinds_table[i].name == u->use_name) { bool not_in_std; const char *name; From patchwork Wed Sep 5 14:57:20 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Bernhard Reutner-Fischer X-Patchwork-Id: 966449 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-485246-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="KrnEIwin"; dkim=pass (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="pMChUuHx"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4256VK59RCz9s5c for ; Thu, 6 Sep 2018 01:06:32 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; q=dns; s=default; b=lYL 0SHLM8FmBgIc1BH4S96Ni7Ru3vw2KMmzi+6cVMk+h+bSPnwFgig4aojK+HTtHuyv /8Jnn/0D/dYlUTQ5osaORq7oByuBKKd1L7aHPXNmFYvITkbx83latjHinzbv2gUS 8C3FzLMgIm33qKhj6MOy5quNctbHLhnnDW9EfNbE= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; s=default; bh=29erUxdRF Zf1FxagkTElYRFEWg0=; b=KrnEIwinDEPBhgn1/uGd2Qlqn+dBUAW12wGfvWETh mR4hQpJiK7RLYourVcTsQIazPGxXSh5Y+KtYZRgNZWtDZnskPk9VE5AJYo8qtxqY kdw7xxrotESSI0QclTesZLvNFXVwDVQRh9Imohr7i9EnIOcF4dt2FywYJ6+GNy86 PM= Received: (qmail 102817 invoked by alias); 5 Sep 2018 15:02:50 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 102652 invoked by uid 89); 5 Sep 2018 15:02:49 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.8 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= X-HELO: mail-wm0-f53.google.com Received: from mail-wm0-f53.google.com (HELO mail-wm0-f53.google.com) (74.125.82.53) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 05 Sep 2018 15:02:48 +0000 Received: by mail-wm0-f53.google.com with SMTP id n11-v6so8077148wmc.2; Wed, 05 Sep 2018 08:02:47 -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=wTl/pOKRnBBXO0Tz9iv3IuPQUxrjuxL/fOKa0qFHxKo=; b=pMChUuHx4Po2VsBJiHY99CLb0vqV80MWHbfzuP6hMzu8HbsnZOgvTl9EqImACvPAby XA2lknCZnriCuBEI1zPdSJFYd5G5qebe8APjzGTTLdAGZ2L0m4XScMbHPTL0AlqK07gX Nj+b82eP+XiJYUZ+KMbq13zBM2pius6ifngL8JQFwnTFvyd3mBMvxTt51ldcEcrMtYwU FVBdmmlBkrSHqnQ7Ym4wGYlPXt2pri7+NB/I8T/fs4R6/TjeyG2gARyDMplNmq4AKPem 48VJHTrY5uePOGAQMqkhA6TEMKa3on33+jrWzmU+NOCzlf1LlVBVrRTcNG54J6mouMJk e3Dg== Received: from s46.loc (91-119-125-11.dsl.dynamic.surfer.at. [91.119.125.11]) by smtp.gmail.com with ESMTPSA id h10-v6sm3302783wmf.44.2018.09.05.08.02.45 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 05 Sep 2018 08:02:45 -0700 (PDT) Received: from cow by s46.loc with local (Exim 4.91) (envelope-from ) id 1fxZFa-000083-3B; Wed, 05 Sep 2018 14:57:46 +0000 From: Bernhard Reutner-Fischer To: fortran@gcc.gnu.org Cc: Bernhard Reutner-Fischer , gcc-patches@gcc.gnu.org Subject: [PATCH,FORTRAN 17/29] Use stringpool for iso_fortran_env Date: Wed, 5 Sep 2018 14:57:20 +0000 Message-Id: <20180905145732.404-18-rep.dot.nop@gmail.com> In-Reply-To: References: MIME-Version: 1.0 X-IsSubscribed: yes From: Bernhard Reutner-Fischer gcc/fortran/ChangeLog: 2017-11-23 Bernhard Reutner-Fischer * module.c (use_iso_fortran_env_module): Use stringpool and use pointer comparison instead of strcmp. --- gcc/fortran/module.c | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index d7bc7fbef1c..3b644234921 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -6678,7 +6678,7 @@ read_module_to_tmpbuf () static void use_iso_fortran_env_module (void) { - static char mod[] = "iso_fortran_env"; + const char *mod = gfc_get_string ("%s", "iso_fortran_env"); gfc_use_rename *u; gfc_symbol *mod_sym; gfc_symtree *mod_symtree; @@ -6686,11 +6686,11 @@ use_iso_fortran_env_module (void) int i, j; intmod_sym symbol[] = { -#define NAMED_INTCST(a,b,c,d) { a, b, 0, d }, -#define NAMED_KINDARRAY(a,b,c,d) { a, b, 0, d }, -#define NAMED_DERIVED_TYPE(a,b,c,d) { a, b, 0, d }, -#define NAMED_FUNCTION(a,b,c,d) { a, b, c, d }, -#define NAMED_SUBROUTINE(a,b,c,d) { a, b, c, d }, +#define NAMED_INTCST(a,b,c,d) { a, gfc_get_string ("%s", b), 0, d }, +#define NAMED_KINDARRAY(a,b,c,d) { a, gfc_get_string ("%s", b), 0, d }, +#define NAMED_DERIVED_TYPE(a,b,c,d) { a, gfc_get_string ("%s", b), 0, d }, +#define NAMED_FUNCTION(a,b,c,d) { a, gfc_get_string ("%s", b), c, d }, +#define NAMED_SUBROUTINE(a,b,c,d) { a, gfc_get_string ("%s", b), c, d }, #include "iso-fortran-env.def" { ISOFORTRANENV_INVALID, NULL, -1234, 0 } }; @@ -6708,7 +6708,7 @@ use_iso_fortran_env_module (void) mod_sym->attr.flavor = FL_MODULE; mod_sym->attr.intrinsic = 1; - mod_sym->module = gfc_get_string ("%s", mod); + mod_sym->module = mod; mod_sym->from_intmod = INTMOD_ISO_FORTRAN_ENV; } else @@ -6723,7 +6723,7 @@ use_iso_fortran_env_module (void) bool found = false; for (u = gfc_rename_list; u; u = u->next) { - if (strcmp (symbol[i].name, u->use_name) == 0) + if (symbol[i].name == u->use_name) { found = true; u->found = 1; From patchwork Wed Sep 5 14:57:21 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Bernhard Reutner-Fischer X-Patchwork-Id: 966446 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-485243-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="rBEnj5MD"; dkim=pass (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="OfPYYTIy"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4256TK2NZdz9sCw for ; Thu, 6 Sep 2018 01:05:41 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; q=dns; s=default; b=OaV q/w8flFxzupaj1LrRKWSQt9XAWlRuAd7gecC8j6oLtKVJNk4YFrv0cInStSO61E0 12lwdXykDP+TL9+wTB2rhe50/bPTWhnDWn2baADvsuKtVPLohNaeMo2F1wsDgnop RF3pdJfQ6khrxQH+nIjS6YNhXOmt9A7enGjGzuAY= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; s=default; bh=vqB5YveAr ILgChV/lHpH1pCDC/A=; b=rBEnj5MDtnehAP+ir9QXmoraGM4bSzwt0fWZ9Ys1J XMgAyqKttpz32omckXIba3u3Hig5jFoiebc6cp6b8RWL7kjzB/0PyGfYXx72uYtL 8bIEo7j9xF0E189nRb5O63SQxyYAYfoK4XRCRok2J0l3IDLJrUlOOcoMO3h2/uDO hE= Received: (qmail 101686 invoked by alias); 5 Sep 2018 15:02:45 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 101548 invoked by uid 89); 5 Sep 2018 15:02:44 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.8 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=HX-Received:a05 X-HELO: mail-wr1-f42.google.com Received: from mail-wr1-f42.google.com (HELO mail-wr1-f42.google.com) (209.85.221.42) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 05 Sep 2018 15:02:39 +0000 Received: by mail-wr1-f42.google.com with SMTP id g33-v6so8064720wrd.1; Wed, 05 Sep 2018 08:02:39 -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=JXQLvWaw+jEtZpo0cMkwDMk/JrCaTghuQc13gbU67DY=; b=OfPYYTIyD/b3G5VZS/xj0edYHULp42Mjd9AcFKAqbrcUmgXNf0M6xb1VgVsyjBGKiJ Ynca2APTgZU9V9upz6ArgPrRxbNW3ZR21qWgRK2BuCzSPx+7h2PSShskPzHgFC4qVD4z 47E1ySgS6EpJmQPl/TeyJi36XVeLc56hDbO5FwHTryUcKkcHxtVnRDtJ2BbpeJ5tNVyY qjmuxJiizaVInlpewqWpzX9oo733ZLTl3ojYp/dmhRk+RtvBqFjHLGHViAzf3dx44eXd T4HmrRUQ2w05E5FF5iAf2iT/1wFrFLwkttA/W2PTTDfNyvxQWGT59TIgW1tRl+dKSRdu gLOA== Received: from s46.loc (91-119-125-11.dsl.dynamic.surfer.at. [91.119.125.11]) by smtp.gmail.com with ESMTPSA id 139-v6sm4049468wmp.4.2018.09.05.08.02.36 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 05 Sep 2018 08:02:36 -0700 (PDT) Received: from cow by s46.loc with local (Exim 4.91) (envelope-from ) id 1fxZFa-000086-7F; Wed, 05 Sep 2018 14:57:46 +0000 From: Bernhard Reutner-Fischer To: fortran@gcc.gnu.org Cc: Bernhard Reutner-Fischer , gcc-patches@gcc.gnu.org Subject: [PATCH,FORTRAN 18/29] Use stringpool for charkind Date: Wed, 5 Sep 2018 14:57:21 +0000 Message-Id: <20180905145732.404-19-rep.dot.nop@gmail.com> In-Reply-To: References: MIME-Version: 1.0 X-IsSubscribed: yes From: Bernhard Reutner-Fischer gcc/fortran/ChangeLog: 2017-11-24 Bernhard Reutner-Fischer * primary.c (match_charkind_name): Return stringpool node. (match_string_constant): Use stringpool node for name. --- gcc/fortran/primary.c | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index da661372c5c..cd5f81542cb 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -950,8 +950,9 @@ next_string_char (gfc_char_t delimiter, int *ret) the name will be detected later. */ static match -match_charkind_name (char *name) +match_charkind_name (const char **result) { + char buffer [GFC_MAX_SYMBOL_LEN + 1]; locus old_loc; char c, peek; int len; @@ -961,8 +962,8 @@ match_charkind_name (char *name) if (!ISALPHA (c)) return MATCH_NO; - *name++ = c; - len = 1; + len = 0; + buffer[len++] = c; for (;;) { @@ -976,7 +977,8 @@ match_charkind_name (char *name) if (peek == '\'' || peek == '\"') { gfc_current_locus = old_loc; - *name = '\0'; + buffer[len] = '\0'; + *result = gfc_get_string ("%s", buffer); return MATCH_YES; } } @@ -986,8 +988,8 @@ match_charkind_name (char *name) && (c != '$' || !flag_dollar_ok)) break; - *name++ = c; - if (++len > GFC_MAX_SYMBOL_LEN) + buffer[len++] = c; + if (len > GFC_MAX_SYMBOL_LEN) break; } @@ -1005,9 +1007,10 @@ match_charkind_name (char *name) static match match_string_constant (gfc_expr **result) { - char name[GFC_MAX_SYMBOL_LEN + 1], peek; + char peek; + const char *name = NULL; size_t length; - int kind,save_warn_ampersand, ret; + int kind, save_warn_ampersand, ret; locus old_locus, start_locus; gfc_symbol *sym; gfc_expr *e; @@ -1043,7 +1046,7 @@ match_string_constant (gfc_expr **result) { gfc_current_locus = old_locus; - m = match_charkind_name (name); + m = match_charkind_name (&name); if (m != MATCH_YES) goto no_match; From patchwork Wed Sep 5 14:57:22 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Bernhard Reutner-Fischer X-Patchwork-Id: 966447 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-485244-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="UX8cG/MX"; dkim=pass (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="Fbero/t6"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4256Td5fDQz9sDT for ; Thu, 6 Sep 2018 01:05:57 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; q=dns; s=default; b=nP0 JCGqOzQ79Aau4mM15HH6CjWu1+66QQYLwUO7be1MsZwuTwfm1l+XmY7IOvlKt2hP pkwDJHn57PcDhP8VNJPoK6hJMh1dDtlyhcTrIIknT+nW7WO19HNS4iOWCYjANxfm ZybtEuJvKXM/S9dpBkg2VpjcCkE9diOZmexzBRY4= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; s=default; bh=9pDYCxM0W lBsXo1YBgz4UejOI3o=; b=UX8cG/MX6bC5skKLyiE4LHnv8k+Tbf8iP7YLaoUH6 S2GvT/yvfI4FtPPB+DFKf+njcA+T7NdeqVfnTu1VQW3QKr0A25IdBjSBO9n08trS 3kLwbQ/1Q8BygZsWi1ps4zLPxTAxPcupDG9L4pNJEv6ZQqcptmRnkPi2UlSu26EN fk= Received: (qmail 101797 invoked by alias); 5 Sep 2018 15:02:46 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 101600 invoked by uid 89); 5 Sep 2018 15:02:45 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.8 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=mm, uu, UU, MM X-HELO: mail-wr1-f65.google.com Received: from mail-wr1-f65.google.com (HELO mail-wr1-f65.google.com) (209.85.221.65) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 05 Sep 2018 15:02:43 +0000 Received: by mail-wr1-f65.google.com with SMTP id u12-v6so8026350wrr.4; Wed, 05 Sep 2018 08:02:42 -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=PEFfP6r9wPZS86+dlZR9Zu3fDTmnX8tbtEMn3mQEcKk=; b=Fbero/t65NvHe5VpaLHIYw6OwAFyHaYsgol5b7vJZJ1kj6ZKfkgJSG5fGRhs25y7ij oIaY1yp0wyxm6yxNiyFjSKjzg4K3/YBUFdn6i2UUH/VlWJ0fBhPw/5u9qptBdTAEEFX2 2wBijv2KMdfEHVTPCCfGGXTNuih3vnDxqJQnn2Wcqo8pkiJEb6KR2VI7lq8uzAvK+fbD qFvhjOGHmv7nZkczYDvjHW1VQxOfWcb1AotgyqzNcsmC9R+ZlyTAQkIlLZxSKzsDRjkC Ewi8Hct09xLN8LszCrdDbigF1u8E3xcyo0gPnqA5M1ixAFu+vS97eDikInRCgmUQHcYF 9yNw== Received: from s46.loc (91-119-125-11.dsl.dynamic.surfer.at. [91.119.125.11]) by smtp.gmail.com with ESMTPSA id 139-v6sm4049625wmp.4.2018.09.05.08.02.39 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 05 Sep 2018 08:02:40 -0700 (PDT) Received: from cow by s46.loc with local (Exim 4.91) (envelope-from ) id 1fxZFa-000089-Bd; Wed, 05 Sep 2018 14:57:46 +0000 From: Bernhard Reutner-Fischer To: fortran@gcc.gnu.org Cc: Bernhard Reutner-Fischer , gcc-patches@gcc.gnu.org Subject: [PATCH, FORTRAN 19/29] Use stringpool and unified uppercase handling for types Date: Wed, 5 Sep 2018 14:57:22 +0000 Message-Id: <20180905145732.404-20-rep.dot.nop@gmail.com> In-Reply-To: References: MIME-Version: 1.0 X-IsSubscribed: yes From: Bernhard Reutner-Fischer Use the existing helper function to create type names. The helper function uses the stringpool already. gcc/fortran/ChangeLog: 2017-11-24 Bernhard Reutner-Fischer * decl.c (build_sym): Use stringpool node instead of stack variables. (gfc_match_map): Likewise. (gfc_match_union): Likewise. * trans-decl.c (gfc_trans_use_stmts): Call gfc_dt_upper_string and thus use stringpool node for the type name. --- gcc/fortran/decl.c | 25 ++++++++++--------------- gcc/fortran/trans-decl.c | 8 +++----- 2 files changed, 13 insertions(+), 20 deletions(-) diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 48ef5637e36..55a59008f66 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -1490,7 +1490,7 @@ build_sym (const char *name, gfc_charlen *cl, bool cl_deferred, { symbol_attribute attr; gfc_symbol *sym; - int upper; + const char *upper; gfc_symtree *st; /* Symbols in a submodule are host associated from the parent module or @@ -1520,20 +1520,15 @@ build_sym (const char *name, gfc_charlen *cl, bool cl_deferred, course, this is only necessary if the upper case letter is actually different. */ - upper = TOUPPER(name[0]); - if (upper != name[0]) + upper = gfc_dt_upper_string (name); + if (upper[0] != name[0]) { - char u_name[GFC_MAX_SYMBOL_LEN + 1]; gfc_symtree *st; - - gcc_assert (strlen(name) <= GFC_MAX_SYMBOL_LEN); - strcpy (u_name, name); - u_name[0] = upper; - - st = gfc_find_symtree (gfc_current_ns->sym_root, u_name); + gcc_assert (strlen (upper) <= GFC_MAX_SYMBOL_LEN); + st = gfc_find_symtree (gfc_current_ns->sym_root, upper); /* STRUCTURE types can alias symbol names */ - if (st != 0 && st->n.sym->attr.flavor != FL_STRUCT) + if (st && st->n.sym->attr.flavor != FL_STRUCT) { gfc_error ("Symbol %qs at %C also declared as a type at %L", name, &st->n.sym->declared_at); @@ -9672,7 +9667,7 @@ gfc_match_map (void) { /* Counter used to give unique internal names to map structures. */ static unsigned int gfc_map_id = 0; - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name; gfc_symbol *sym; locus old_loc; @@ -9687,7 +9682,7 @@ gfc_match_map (void) /* Map blocks are anonymous so we make up unique names for the symbol table which are invalid Fortran identifiers. */ - snprintf (name, GFC_MAX_SYMBOL_LEN + 1, "MM$%u", gfc_map_id++); + name = gfc_get_string ("MM$%u", gfc_map_id++); if (!get_struct_decl (name, FL_STRUCT, &old_loc, &sym)) return MATCH_ERROR; @@ -9705,7 +9700,7 @@ gfc_match_union (void) { /* Counter used to give unique internal names to union types. */ static unsigned int gfc_union_id = 0; - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name; gfc_symbol *sym; locus old_loc; @@ -9720,7 +9715,7 @@ gfc_match_union (void) /* Unions are anonymous so we make up unique names for the symbol table which are invalid Fortran identifiers. */ - snprintf (name, GFC_MAX_SYMBOL_LEN + 1, "UU$%u", gfc_union_id++); + name = gfc_get_string ("UU$%u", gfc_union_id++); if (!get_struct_decl (name, FL_UNION, &old_loc, &sym)) return MATCH_ERROR; diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 6e717633a8f..023350723ff 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -5053,12 +5053,10 @@ gfc_trans_use_stmts (gfc_namespace * ns) /* The following can happen if a derived type is renamed. */ if (!st) { - char *name; - name = xstrdup (rent->local_name + const char *upper; + upper = gfc_dt_upper_string (rent->local_name ? rent->local_name : rent->use_name); - name[0] = (char) TOUPPER ((unsigned char) name[0]); - st = gfc_find_symtree (ns->sym_root, name); - free (name); + st = gfc_find_symtree (ns->sym_root, upper); gcc_assert (st); } From patchwork Wed Sep 5 14:57:23 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Bernhard Reutner-Fischer X-Patchwork-Id: 966448 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-485245-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="IaQU9VRD"; dkim=pass (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="ilG4HG1m"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4256Tz6mZCz9s5c for ; Thu, 6 Sep 2018 01:06:15 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; q=dns; s=default; b=hG4 bIrOTSRlJ2vHTLAgo40BarwhqlVoJy6QASXEzBkb8iEIUfwab1TWf/Yx0/QrpOa7 x/hDy2ZGFsBo4AxUZHCCediyH5n2lUku6z0OZTABvCwbhqulU/UxCoGbM9Bpr1oH tL3g8AhG7E0GzZ2FgqdZIFLJm/jOeFkE8pkKf/lM= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; s=default; bh=9It5ywClh +UMU+7VQhq1SIMa6a4=; b=IaQU9VRD0h9mlif1j5XQfmBcbb9GhL/xzf6G8wvKA vbfnlY7qMm2NFVY0gkSKjaIolk0SHgCv323FTdj9nlDElKgTmGbkWA4H0jcGC6hU IU3yRONMVvl7W9qVhD9rksvgB9yB08c76nX1Auqs3ECvoPQKitQlfGpJRaUmJo4S 0I= Received: (qmail 102500 invoked by alias); 5 Sep 2018 15:02:49 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 102328 invoked by uid 89); 5 Sep 2018 15:02:48 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.8 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=dimensions X-HELO: mail-wr1-f49.google.com Received: from mail-wr1-f49.google.com (HELO mail-wr1-f49.google.com) (209.85.221.49) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 05 Sep 2018 15:02:45 +0000 Received: by mail-wr1-f49.google.com with SMTP id v16-v6so7993681wro.11; Wed, 05 Sep 2018 08:02:44 -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=7cuoRs8n/EUFYbVrMXvXUz3JygojyqS1wixyUrj/uHY=; b=ilG4HG1mfcmOzhisjoJdfOHWeGq0rkifonVJaZFAgls/dd/FoiKKJ7xvX11G2RDU3V oSOMpfLl8v8Z6edgHuFvUtXd0v+mLc4tkFJD+TnkstzkGOjq15tTsE57sUmJoluAM5eC FYa1I64wZKvqudNXm2LaFXS2aQ1uqF8H4klfzz0jeYQUd9dkYul3Ss0DK4SmQ8FOO++5 fATcaWp4ST9MYT7fExDa05Rp7bE+M6KIrD+gUlqp5bkMYNWc0yLC03GH8ud6UZRzA/Ox SCFop/JFBqlZsUO/azF7PtWuf49cinkld5VgIjlC2dzvd4bEMrBxq0sWTkCGpTywVfbM ruLg== Received: from s46.loc (91-119-125-11.dsl.dynamic.surfer.at. [91.119.125.11]) by smtp.gmail.com with ESMTPSA id s205-v6sm2830684wmf.42.2018.09.05.08.02.41 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 05 Sep 2018 08:02:41 -0700 (PDT) Received: from cow by s46.loc with local (Exim 4.91) (envelope-from ) id 1fxZFa-00008C-Ih; Wed, 05 Sep 2018 14:57:46 +0000 From: Bernhard Reutner-Fischer To: fortran@gcc.gnu.org Cc: Bernhard Reutner-Fischer , gcc-patches@gcc.gnu.org Subject: [PATCH,FORTRAN 20/29] Use stringpool in class et al Date: Wed, 5 Sep 2018 14:57:23 +0000 Message-Id: <20180905145732.404-21-rep.dot.nop@gmail.com> In-Reply-To: References: MIME-Version: 1.0 X-IsSubscribed: yes From: Bernhard Reutner-Fischer gcc/fortran/ChangeLog: 2017-11-24 Bernhard Reutner-Fischer * class.c (finalizer_insert_packed_call): Use stringpool. (generate_finalization_wrapper): Likewise. (gfc_find_derived_vtab): Likewise. (find_intrinsic_vtab): Likewise. * decl.c (gfc_match_null): Likewise. * parse.c (gfc_build_block_ns): Likewise. * resolve.c (resolve_entries): Likewise. * symbol.c (gfc_get_unique_symtree): Likewise. --- gcc/fortran/class.c | 40 ++++++++++++++++++++-------------------- gcc/fortran/decl.c | 2 +- gcc/fortran/parse.c | 6 +++--- gcc/fortran/resolve.c | 5 ++--- gcc/fortran/symbol.c | 4 ++-- 5 files changed, 28 insertions(+), 29 deletions(-) diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index c2dc3411811..20a68da8e9b 100644 --- a/gcc/fortran/class.c +++ b/gcc/fortran/class.c @@ -1373,7 +1373,7 @@ finalizer_insert_packed_call (gfc_code *block, gfc_finalizer *fini, block->ext.block.ns = ns; block->ext.block.assoc = NULL; - gfc_get_symbol ("ptr2", ns, &ptr2); + gfc_get_symbol (gfc_get_string ("%s", "ptr2"), ns, &ptr2); ptr2->ts.type = BT_DERIVED; ptr2->ts.u.derived = array->ts.u.derived; ptr2->attr.flavor = FL_VARIABLE; @@ -1382,7 +1382,7 @@ finalizer_insert_packed_call (gfc_code *block, gfc_finalizer *fini, gfc_set_sym_referenced (ptr2); gfc_commit_symbol (ptr2); - gfc_get_symbol ("tmp_array", ns, &tmp_array); + gfc_get_symbol (gfc_get_string ("%s", "tmp_array"), ns, &tmp_array); tmp_array->ts.type = BT_DERIVED; tmp_array->ts.u.derived = array->ts.u.derived; tmp_array->attr.flavor = FL_VARIABLE; @@ -1625,7 +1625,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, gfc_commit_symbol (final); /* Set up formal argument. */ - gfc_get_symbol ("array", sub_ns, &array); + gfc_get_symbol (gfc_get_string ("%s", "array"), sub_ns, &array); array->ts.type = BT_DERIVED; array->ts.u.derived = derived; array->attr.flavor = FL_VARIABLE; @@ -1643,7 +1643,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, gfc_commit_symbol (array); /* Set up formal argument. */ - gfc_get_symbol ("byte_stride", sub_ns, &byte_stride); + gfc_get_symbol (gfc_get_string ("%s", "byte_stride"), sub_ns, &byte_stride); byte_stride->ts.type = BT_INTEGER; byte_stride->ts.kind = gfc_index_integer_kind; byte_stride->attr.flavor = FL_VARIABLE; @@ -1656,7 +1656,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, gfc_commit_symbol (byte_stride); /* Set up formal argument. */ - gfc_get_symbol ("fini_coarray", sub_ns, &fini_coarray); + gfc_get_symbol (gfc_get_string ("%s", "fini_coarray"), sub_ns, &fini_coarray); fini_coarray->ts.type = BT_LOGICAL; fini_coarray->ts.kind = 1; fini_coarray->attr.flavor = FL_VARIABLE; @@ -1679,7 +1679,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, /* Local variables. */ - gfc_get_symbol ("idx", sub_ns, &idx); + gfc_get_symbol (gfc_get_string ("%s", "idx"), sub_ns, &idx); idx->ts.type = BT_INTEGER; idx->ts.kind = gfc_index_integer_kind; idx->attr.flavor = FL_VARIABLE; @@ -1687,7 +1687,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, gfc_set_sym_referenced (idx); gfc_commit_symbol (idx); - gfc_get_symbol ("idx2", sub_ns, &idx2); + gfc_get_symbol (gfc_get_string ("%s", "idx2"), sub_ns, &idx2); idx2->ts.type = BT_INTEGER; idx2->ts.kind = gfc_index_integer_kind; idx2->attr.flavor = FL_VARIABLE; @@ -1695,7 +1695,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, gfc_set_sym_referenced (idx2); gfc_commit_symbol (idx2); - gfc_get_symbol ("offset", sub_ns, &offset); + gfc_get_symbol (gfc_get_string ("%s", "offset"), sub_ns, &offset); offset->ts.type = BT_INTEGER; offset->ts.kind = gfc_index_integer_kind; offset->attr.flavor = FL_VARIABLE; @@ -1711,7 +1711,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, gfc_convert_type_warn (rank, &idx->ts, 2, 0); /* Create is_contiguous variable. */ - gfc_get_symbol ("is_contiguous", sub_ns, &is_contiguous); + gfc_get_symbol (gfc_get_string ("%s", "is_contiguous"), sub_ns, &is_contiguous); is_contiguous->ts.type = BT_LOGICAL; is_contiguous->ts.kind = gfc_default_logical_kind; is_contiguous->attr.flavor = FL_VARIABLE; @@ -1722,7 +1722,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, /* Create "sizes(0..rank)" variable, which contains the multiplied up extent of the dimensions, i.e. sizes(0) = 1, sizes(1) = extent(dim=1), sizes(2) = sizes(1) * extent(dim=2) etc. */ - gfc_get_symbol ("sizes", sub_ns, &sizes); + gfc_get_symbol (gfc_get_string ("%s", "sizes"), sub_ns, &sizes); sizes->ts.type = BT_INTEGER; sizes->ts.kind = gfc_index_integer_kind; sizes->attr.flavor = FL_VARIABLE; @@ -1739,7 +1739,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, /* Create "strides(1..rank)" variable, which contains the strides per dimension. */ - gfc_get_symbol ("strides", sub_ns, &strides); + gfc_get_symbol (gfc_get_string ("%s", "strides"), sub_ns, &strides); strides->ts.type = BT_INTEGER; strides->ts.kind = gfc_index_integer_kind; strides->attr.flavor = FL_VARIABLE; @@ -1919,7 +1919,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, /* Obtain the size (number of elements) of "array" MINUS ONE, which is used in the scalarization. */ - gfc_get_symbol ("nelem", sub_ns, &nelem); + gfc_get_symbol (gfc_get_string ("%s", "nelem"), sub_ns, &nelem); nelem->ts.type = BT_INTEGER; nelem->ts.kind = gfc_index_integer_kind; nelem->attr.flavor = FL_VARIABLE; @@ -1972,7 +1972,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, { gfc_finalizer *fini, *fini_elem = NULL; - gfc_get_symbol ("ptr1", sub_ns, &ptr); + gfc_get_symbol (gfc_get_string ("%s", "ptr1"), sub_ns, &ptr); ptr->ts.type = BT_DERIVED; ptr->ts.u.derived = derived; ptr->attr.flavor = FL_VARIABLE; @@ -2096,7 +2096,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, if (!ptr) { - gfc_get_symbol ("ptr2", sub_ns, &ptr); + gfc_get_symbol (gfc_get_string ("%s", "ptr2"), sub_ns, &ptr); ptr->ts.type = BT_DERIVED; ptr->ts.u.derived = derived; ptr->attr.flavor = FL_VARIABLE; @@ -2106,7 +2106,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, gfc_commit_symbol (ptr); } - gfc_get_symbol ("ignore", sub_ns, &stat); + gfc_get_symbol (gfc_get_string ("%s", "ignore"), sub_ns, &stat); stat->attr.flavor = FL_VARIABLE; stat->attr.artificial = 1; stat->ts.type = BT_INTEGER; @@ -2422,7 +2422,7 @@ gfc_find_derived_vtab (gfc_symbol *derived) copy->module = ns->proc_name->name; gfc_set_sym_referenced (copy); /* Set up formal arguments. */ - gfc_get_symbol ("src", sub_ns, &src); + gfc_get_symbol (gfc_get_string ("%s", "src"), sub_ns, &src); src->ts.type = BT_DERIVED; src->ts.u.derived = derived; src->attr.flavor = FL_VARIABLE; @@ -2432,7 +2432,7 @@ gfc_find_derived_vtab (gfc_symbol *derived) gfc_set_sym_referenced (src); copy->formal = gfc_get_formal_arglist (); copy->formal->sym = src; - gfc_get_symbol ("dst", sub_ns, &dst); + gfc_get_symbol (gfc_get_string ("%s", "dst"), sub_ns, &dst); dst->ts.type = BT_DERIVED; dst->ts.u.derived = derived; dst->attr.flavor = FL_VARIABLE; @@ -2497,7 +2497,7 @@ gfc_find_derived_vtab (gfc_symbol *derived) dealloc->module = ns->proc_name->name; gfc_set_sym_referenced (dealloc); /* Set up formal argument. */ - gfc_get_symbol ("arg", sub_ns, &arg); + gfc_get_symbol (gfc_get_string ("%s", "arg"), sub_ns, &arg); arg->ts.type = BT_DERIVED; arg->ts.u.derived = derived; arg->attr.flavor = FL_VARIABLE; @@ -2759,7 +2759,7 @@ find_intrinsic_vtab (gfc_typespec *ts) copy->module = ns->proc_name->name; gfc_set_sym_referenced (copy); /* Set up formal arguments. */ - gfc_get_symbol ("src", sub_ns, &src); + gfc_get_symbol (gfc_get_string ("%s", "src"), sub_ns, &src); src->ts.type = ts->type; src->ts.kind = ts->kind; src->attr.flavor = FL_VARIABLE; @@ -2768,7 +2768,7 @@ find_intrinsic_vtab (gfc_typespec *ts) gfc_set_sym_referenced (src); copy->formal = gfc_get_formal_arglist (); copy->formal->sym = src; - gfc_get_symbol ("dst", sub_ns, &dst); + gfc_get_symbol (gfc_get_string ("%s", "dst"), sub_ns, &dst); dst->ts.type = ts->type; dst->ts.kind = ts->kind; dst->attr.flavor = FL_VARIABLE; diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 55a59008f66..d6a6538f769 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -2183,7 +2183,7 @@ gfc_match_null (gfc_expr **result) } /* The NULL symbol now has to be/become an intrinsic function. */ - if (gfc_get_symbol ("null", NULL, &sym)) + if (gfc_get_symbol (gfc_get_string ("%s", "null"), NULL, &sym)) { gfc_error ("NULL() initialization at %C is ambiguous"); return MATCH_ERROR; diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 389eead0691..755bff56e24 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -4442,10 +4442,10 @@ gfc_build_block_ns (gfc_namespace *parent_ns) else { bool t; - char buffer[20]; /* Enough to hold "block@2147483648\n". */ + const char *block_name; - snprintf(buffer, sizeof(buffer), "block@%d", numblock++); - gfc_get_symbol (buffer, my_ns, &my_ns->proc_name); + block_name = gfc_get_string ("block@%d", numblock++); + gfc_get_symbol (block_name, my_ns, &my_ns->proc_name); t = gfc_add_flavor (&my_ns->proc_name->attr, FL_LABEL, my_ns->proc_name->name, NULL); gcc_assert (t); diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index e98e6a6d53e..88c16d462bd 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -699,7 +699,7 @@ resolve_entries (gfc_namespace *ns) gfc_code *c; gfc_symbol *proc; gfc_entry_list *el; - char name[GFC_MAX_SYMBOL_LEN + 1]; + const char *name; static int master_count = 0; if (ns->proc_name == NULL) @@ -758,8 +758,7 @@ resolve_entries (gfc_namespace *ns) /* Give the internal function a unique name (within this file). Also include the function name so the user has some hope of figuring out what is going on. */ - snprintf (name, GFC_MAX_SYMBOL_LEN, "master.%d.%s", - master_count++, ns->proc_name->name); + name = gfc_get_string ("master.%d.%s", master_count++, ns->proc_name->name); gfc_get_ha_symbol (name, &proc); gcc_assert (proc != NULL); diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index ce134d2b441..53c760a6c38 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -2975,10 +2975,10 @@ gfc_find_symtree (gfc_symtree *st, const char *name) gfc_symtree * gfc_get_unique_symtree (gfc_namespace *ns) { - char name[GFC_MAX_SYMBOL_LEN + 1]; static int serial = 0; + const char *name; - sprintf (name, "@%d", serial++); + name = gfc_get_string ("@%d", serial++); return gfc_new_symtree (&ns->sym_root, name); } From patchwork Wed Sep 5 14:57:24 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Bernhard Reutner-Fischer X-Patchwork-Id: 966434 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-485232-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="Qbp/YI/G"; dkim=pass (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="HY4GSFut"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4256P732dyz9sCn for ; Thu, 6 Sep 2018 01:02:03 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; q=dns; s=default; b=CpK IuxQ+HWIBxP/MqBrhuMfnMceHdE7W6FS6UOQqvzfQxxgQfmkt9Cgr9DQ9de3V310 xRIAxjyARlGxhfh6PXWUYqXlZcciF1yfCTNOZ3gpuSQxeEUU7cllf8SbH0t6xGdK wpgJqw+/c7VAU/u8w5fK6S46nGbIA/upeIHFKBFU= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; s=default; bh=46fFTVH3w BUyDbl/yEwlbpe4GVE=; b=Qbp/YI/G8utCvftUlv/t3GZRK9yONHlKM+FZZZfVK y3kLiksZTdtcvclvcAPcu8K+NRT1qsPateys8lRpptS0r81evnfAEVuXr1pd/yC9 QpSv7MbQOkGkSWHPtTTnjK5TaZ+MUQTIc+WWYAwS6AgkS/xILlxnfKAEqv1g8WRN uE= Received: (qmail 69739 invoked by alias); 5 Sep 2018 14:58:05 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 68929 invoked by uid 89); 5 Sep 2018 14:57:57 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.8 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=star X-HELO: mail-wr1-f42.google.com Received: from mail-wr1-f42.google.com (HELO mail-wr1-f42.google.com) (209.85.221.42) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 05 Sep 2018 14:57:55 +0000 Received: by mail-wr1-f42.google.com with SMTP id o37-v6so8009812wrf.6; Wed, 05 Sep 2018 07:57:55 -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=/aLFPn5KD8JucvCqSOw26NqxKUgzk45rr5RRPlM+vm0=; b=HY4GSFutB5/8y+I4IRsksknBjk8VW3shH5LXskYHQ5gk8evNGwd5OP69sljiAfdSRO y2bWyULJnxLFXT8RljEJtKUswU8RgEoOaXpDhjEKHDf7mN2GmE1SlxvVeIP3mAMM8YCj 4ncaepIhW5QkIC3lUb5Vn2dskvhwJaEBBvSFSJIiad5Y7wi6nVXLsaH0SqECY4IaDhOd nACzRO1ko/Xf6O1wF8IZcZOZbUHy9r1xAlDvNyl3c1IGU+IGLwZch/qn258H+oIUBKbR jlCwa2Yqw1Ro+FqsGLesG1tEHCoff+CJqGzOwvUqhh/dF8Pq6L9corvKcKUnLXdC28oH NJeg== Received: from s46.loc (91-119-125-11.dsl.dynamic.surfer.at. [91.119.125.11]) by smtp.gmail.com with ESMTPSA id n14-v6sm1625279wmc.14.2018.09.05.07.57.47 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 05 Sep 2018 07:57:51 -0700 (PDT) Received: from cow by s46.loc with local (Exim 4.91) (envelope-from ) id 1fxZFa-00008F-Ns; Wed, 05 Sep 2018 14:57:46 +0000 From: Bernhard Reutner-Fischer To: fortran@gcc.gnu.org Cc: Bernhard Reutner-Fischer , gcc-patches@gcc.gnu.org Subject: [PATCH,FORTRAN 21/29] Use stringpool for module tbp Date: Wed, 5 Sep 2018 14:57:24 +0000 Message-Id: <20180905145732.404-22-rep.dot.nop@gmail.com> In-Reply-To: References: MIME-Version: 1.0 X-IsSubscribed: yes From: Bernhard Reutner-Fischer Switch type bound procedures to use the stringpool. gcc/fortran/ChangeLog: 2017-11-24 Bernhard Reutner-Fischer * decl.c (gfc_match_decl_type_spec): Use stringpool. * module.c (mio_expr): Likewise. (mio_typebound_proc): Likewise. (mio_full_typebound_tree): Likewise. (mio_omp_udr_expr): Likewise. --- gcc/fortran/decl.c | 9 +++++---- gcc/fortran/module.c | 24 ++++++++++++------------ 2 files changed, 17 insertions(+), 16 deletions(-) diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index d6a6538f769..cc14a871dfd 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -4049,12 +4049,13 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag) { gfc_symbol *upe; gfc_symtree *st; + const char *star_name = gfc_get_string ("%s", "STAR"); ts->type = BT_CLASS; - gfc_find_symbol ("STAR", gfc_current_ns, 1, &upe); + gfc_find_symbol (star_name, gfc_current_ns, 1, &upe); if (upe == NULL) { - upe = gfc_new_symbol ("STAR", gfc_current_ns); - st = gfc_new_symtree (&gfc_current_ns->sym_root, "STAR"); + upe = gfc_new_symbol (star_name, gfc_current_ns); + st = gfc_new_symtree (&gfc_current_ns->sym_root, star_name); st->n.sym = upe; gfc_set_sym_referenced (upe); upe->refs++; @@ -4069,7 +4070,7 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag) } else { - st = gfc_get_tbp_symtree (&gfc_current_ns->sym_root, "STAR"); + st = gfc_get_tbp_symtree (&gfc_current_ns->sym_root, star_name); st->n.sym = upe; upe->refs++; } diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 3b644234921..24e48c94c76 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -3585,9 +3585,9 @@ mio_expr (gfc_expr **ep) case 3: break; default: - require_atom (ATOM_STRING); - e->value.function.isym = gfc_find_function (atom_string); - free (atom_string); + const char *name; + mio_pool_string (&name); + e->value.function.isym = gfc_find_function (name); } } @@ -3872,6 +3872,7 @@ mio_typebound_proc (gfc_typebound_proc** proc) while (peek_atom () != ATOM_RPAREN) { gfc_symtree** sym_root; + const char *name; g = gfc_get_tbp_generic (); g->specific = NULL; @@ -3879,10 +3880,9 @@ mio_typebound_proc (gfc_typebound_proc** proc) mio_integer (&iop); g->is_operator = (bool) iop; - require_atom (ATOM_STRING); + mio_pool_string (&name); sym_root = ¤t_f2k_derived->tb_sym_root; - g->specific_st = gfc_get_tbp_symtree (sym_root, atom_string); - free (atom_string); + g->specific_st = gfc_get_tbp_symtree (sym_root, name); g->next = (*proc)->u.generic; (*proc)->u.generic = g; @@ -3928,12 +3928,12 @@ mio_full_typebound_tree (gfc_symtree** root) while (peek_atom () == ATOM_LPAREN) { gfc_symtree* st; + const char *name; mio_lparen (); - require_atom (ATOM_STRING); - st = gfc_get_tbp_symtree (root, atom_string); - free (atom_string); + mio_pool_string (&name); + st = gfc_get_tbp_symtree (root, name); mio_typebound_symtree (st); } @@ -4267,9 +4267,9 @@ mio_omp_udr_expr (gfc_omp_udr *udr, gfc_symbol **sym1, gfc_symbol **sym2, mio_integer (&flag); if (flag) { - require_atom (ATOM_STRING); - ns->code->resolved_isym = gfc_find_subroutine (atom_string); - free (atom_string); + const char *name; + mio_pool_string (&name); + ns->code->resolved_isym = gfc_find_subroutine (name); } else mio_symbol_ref (&ns->code->resolved_sym); From patchwork Wed Sep 5 14:57:25 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Bernhard Reutner-Fischer X-Patchwork-Id: 966440 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-485237-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="dKD6+Gex"; dkim=pass (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="nYjSbdqx"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4256RB2h64z9sD2 for ; Thu, 6 Sep 2018 01:03:50 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; q=dns; s=default; b=eKp Z6JQ4p6+0m4Mp8HKs1H+Av0iXFdmny07Prl0+XzOn5Kc6SKyQ3zpyK4Xrw+zwPFF xHrfB/+NKSIcsK5Ze0x4sDZjuBZaVbBwfMcg6xQUVyOkcR46W9rdumr1bKTeANGa Poi7k+YXedrrq7wvfhMxVw4nuDoOhjYd0OpYueiQ= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; s=default; bh=tJvJCmITw ZzeN126qPwncn//qqc=; b=dKD6+GexiNPa2W7Ijc2FgBERs4W6MuAiXStWS54Nz FJQPF9OOmAhusFoj4FFBkiqxOrgOlx1i0jCMwlCl3meCmlK7jmGQocKCyKDpeInf ShY6miBcPBBSsF/QbCbGAU2YCaVqQ+cp49i4Ln56oNYbrN7DQipsTTtB2qpc5llp Os= Received: (qmail 70172 invoked by alias); 5 Sep 2018 14:58:08 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 69071 invoked by uid 89); 5 Sep 2018 14:57:58 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-25.4 required=5.0 tests=AWL, BAYES_00, FREEMAIL_FROM, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, KAM_STOCKGEN, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy= X-HELO: mail-wm0-f44.google.com Received: from mail-wm0-f44.google.com (HELO mail-wm0-f44.google.com) (74.125.82.44) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 05 Sep 2018 14:57:56 +0000 Received: by mail-wm0-f44.google.com with SMTP id s12-v6so8356724wmc.0; Wed, 05 Sep 2018 07:57:55 -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=KZtW+ooMVJ3y6QdWn4tv0QWur29qycvVeIRDg0icSPc=; b=nYjSbdqx8l4ZyWQFlZLb3ykbNdrgvaw37VCNihdVN84VVCYuQBEMxoerksLGpn3js4 Y0oWrEBmOF9YdWEQ7LmEDHma/xV3/yr+PhgvtOCIRQBa4slfR5mMr4ZCGr7HnFEb4AVJ v5+0dTWEPJLJX4kxf6D5Rm5fIYujBNqyOMY8IeZKPo/3QqKz2biDp+3iTqq1CEAGeMwx JrXwkkDl2MEF/yBslHieElKIN2OGg1SrkviieX05HEpWyvGERMEdVfH38Yfp/cbOUrV1 gZMRchc8e+wB/T34xGo8dOOAFJ/fBgq/poWYpy5NHOgObFtVBfklqd4dNttgIls4plSB JQVA== Received: from s46.loc (91-119-125-11.dsl.dynamic.surfer.at. [91.119.125.11]) by smtp.gmail.com with ESMTPSA id z101-v6sm2435720wrb.55.2018.09.05.07.57.49 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 05 Sep 2018 07:57:51 -0700 (PDT) Received: from cow by s46.loc with local (Exim 4.91) (envelope-from ) id 1fxZFa-00008I-S7; Wed, 05 Sep 2018 14:57:46 +0000 From: Bernhard Reutner-Fischer To: fortran@gcc.gnu.org Cc: Bernhard Reutner-Fischer , gcc-patches@gcc.gnu.org Subject: [PATCH, FORTRAN 22/29] Use stringpool in class and procedure-pointer result Date: Wed, 5 Sep 2018 14:57:25 +0000 Message-Id: <20180905145732.404-23-rep.dot.nop@gmail.com> In-Reply-To: References: MIME-Version: 1.0 X-IsSubscribed: yes From: Bernhard Reutner-Fischer gcc/fortran/ChangeLog: 2017-11-26 Bernhard Reutner-Fischer * class.c (finalize_component): Use stringpool. (finalization_scalarizer): Likewise. * frontend-passes.c (create_var): Likewise. (get_len_trim_call): Likewise. * iresolve.c (gfc_resolve_atomic_def): Likewise. (gfc_resolve_atomic_ref): Likewise. (gfc_resolve_event_query): Likewise. * openmp.c (gfc_match_omp_declare_reduction): Likewise. * parse.c (gfc_parse_file): Likewise. * resolve.c (build_loc_call): Likewise. (resolve_ordinary_assign): Likewise. * decl.c (add_hidden_procptr_result): Likewise and use pointer comparison instead of string comparison. --- gcc/fortran/class.c | 10 +++++++--- gcc/fortran/decl.c | 11 +++++++---- gcc/fortran/frontend-passes.c | 10 ++++++---- gcc/fortran/iresolve.c | 6 +++--- gcc/fortran/openmp.c | 13 +++++++++---- gcc/fortran/parse.c | 2 +- gcc/fortran/resolve.c | 6 ++++-- 7 files changed, 37 insertions(+), 21 deletions(-) diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index 20a68da8e9b..33c772c6eba 100644 --- a/gcc/fortran/class.c +++ b/gcc/fortran/class.c @@ -959,12 +959,13 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp, dealloc->ext.alloc.list->expr = e; dealloc->expr1 = gfc_lval_expr_from_sym (stat); + const char *sname = gfc_get_string ("%s", "associated"); gfc_code *cond = gfc_get_code (EXEC_IF); cond->block = gfc_get_code (EXEC_IF); cond->block->expr1 = gfc_get_expr (); cond->block->expr1->expr_type = EXPR_FUNCTION; cond->block->expr1->where = gfc_current_locus; - gfc_get_sym_tree ("associated", sub_ns, &cond->block->expr1->symtree, false); + gfc_get_sym_tree (sname, sub_ns, &cond->block->expr1->symtree, false); cond->block->expr1->symtree->n.sym->attr.flavor = FL_PROCEDURE; cond->block->expr1->symtree->n.sym->attr.intrinsic = 1; cond->block->expr1->symtree->n.sym->result = cond->block->expr1->symtree->n.sym; @@ -1038,10 +1039,12 @@ finalization_scalarizer (gfc_symbol *array, gfc_symbol *ptr, { gfc_code *block; gfc_expr *expr, *expr2; + const char *sname; /* C_F_POINTER(). */ block = gfc_get_code (EXEC_CALL); - gfc_get_sym_tree ("c_f_pointer", sub_ns, &block->symtree, true); + sname = gfc_get_string ("%s", "c_f_pointer"); + gfc_get_sym_tree (sname, sub_ns, &block->symtree, true); block->resolved_sym = block->symtree->n.sym; block->resolved_sym->attr.flavor = FL_PROCEDURE; block->resolved_sym->attr.intrinsic = 1; @@ -1063,7 +1066,8 @@ finalization_scalarizer (gfc_symbol *array, gfc_symbol *ptr, /* TRANSFER's first argument: C_LOC (array). */ expr = gfc_get_expr (); expr->expr_type = EXPR_FUNCTION; - gfc_get_sym_tree ("c_loc", sub_ns, &expr->symtree, false); + sname = gfc_get_string ("%s", "c_loc"); + gfc_get_sym_tree (sname, sub_ns, &expr->symtree, false); expr->symtree->n.sym->attr.flavor = FL_PROCEDURE; expr->symtree->n.sym->intmod_sym_id = ISOCBINDING_LOC; expr->symtree->n.sym->attr.intrinsic = 1; diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index cc14a871dfd..1f148c88eb8 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -6441,6 +6441,7 @@ static bool add_hidden_procptr_result (gfc_symbol *sym) { bool case1,case2; + const char *ppr_name; if (gfc_notification_std (GFC_STD_F2003) == ERROR) return false; @@ -6454,16 +6455,18 @@ add_hidden_procptr_result (gfc_symbol *sym) && gfc_state_stack->previous->state == COMP_FUNCTION && gfc_state_stack->previous->sym->name == sym->name; + ppr_name = gfc_get_string ("%s", "ppr@"); if (case1 || case2) { + gfc_symtree *stree; if (case1) - gfc_get_sym_tree ("ppr@", gfc_current_ns, &stree, false); + gfc_get_sym_tree (ppr_name, gfc_current_ns, &stree, false); else if (case2) { gfc_symtree *st2; - gfc_get_sym_tree ("ppr@", gfc_current_ns->parent, &stree, false); - st2 = gfc_new_symtree (&gfc_current_ns->sym_root, "ppr@"); + gfc_get_sym_tree (ppr_name, gfc_current_ns->parent, &stree, false); + st2 = gfc_new_symtree (&gfc_current_ns->sym_root, ppr_name); st2->n.sym = stree->n.sym; stree->n.sym->refs++; } @@ -6490,7 +6493,7 @@ add_hidden_procptr_result (gfc_symbol *sym) && sym->result && sym->result != sym && sym->result->attr.external && sym == gfc_current_ns->proc_name && sym == sym->result->ns->proc_name - && strcmp ("ppr@", sym->result->name) == 0) + && sym->result->name == ppr_name) { sym->result->attr.proc_pointer = 1; sym->attr.pointer = 0; diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index d549d8b6ffd..ccbc25acf97 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -713,7 +713,7 @@ insert_block () static gfc_expr* create_var (gfc_expr * e, const char *vname) { - char name[GFC_MAX_SYMBOL_LEN +1]; + const char *name; gfc_symtree *symtree; gfc_symbol *symbol; gfc_expr *result; @@ -733,9 +733,9 @@ create_var (gfc_expr * e, const char *vname) ns = insert_block (); if (vname) - snprintf (name, GFC_MAX_SYMBOL_LEN, "__var_%d_%s", var_num++, vname); + name = gfc_get_string ("__var_%d_%s", var_num++, vname); else - snprintf (name, GFC_MAX_SYMBOL_LEN, "__var_%d", var_num++); + name = gfc_get_string ("__var_%d", var_num++); if (gfc_get_sym_tree (name, ns, &symtree, false) != 0) gcc_unreachable (); @@ -1985,6 +1985,7 @@ get_len_trim_call (gfc_expr *str, int kind) { gfc_expr *fcn; gfc_actual_arglist *actual_arglist, *next; + const char *sname; fcn = gfc_get_expr (); fcn->expr_type = EXPR_FUNCTION; @@ -2000,7 +2001,8 @@ get_len_trim_call (gfc_expr *str, int kind) fcn->ts.type = BT_INTEGER; fcn->ts.kind = gfc_charlen_int_kind; - gfc_get_sym_tree ("__internal_len_trim", current_ns, &fcn->symtree, false); + sname = gfc_get_string ("%s", "__internal_len_trim"); + gfc_get_sym_tree (sname, current_ns, &fcn->symtree, false); fcn->symtree->n.sym->ts = fcn->ts; fcn->symtree->n.sym->attr.flavor = FL_PROCEDURE; fcn->symtree->n.sym->attr.function = 1; diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index 2eb8f7c9113..f22e0da54c9 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -3351,7 +3351,7 @@ create_formal_for_intents (gfc_actual_arglist* actual, const sym_intent* ints) void gfc_resolve_atomic_def (gfc_code *c) { - const char *name = "atomic_define"; + const char *name = gfc_get_string ("%s", "atomic_define"); c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); } @@ -3359,14 +3359,14 @@ gfc_resolve_atomic_def (gfc_code *c) void gfc_resolve_atomic_ref (gfc_code *c) { - const char *name = "atomic_ref"; + const char *name = gfc_get_string ("%s", "atomic_ref"); c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); } void gfc_resolve_event_query (gfc_code *c) { - const char *name = "event_query"; + const char *name = gfc_get_string ("%s", "event_query"); c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); } diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index a868e34193f..fcfe671be8b 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -2860,6 +2860,7 @@ gfc_match_omp_declare_reduction (void) gfc_namespace *combiner_ns, *initializer_ns = NULL; gfc_omp_udr *prev_udr, *omp_udr; const char *predef_name = NULL; + const char *sname; omp_udr = gfc_get_omp_udr (); omp_udr->name = name; @@ -2870,8 +2871,10 @@ gfc_match_omp_declare_reduction (void) gfc_current_ns = combiner_ns = gfc_get_namespace (gfc_current_ns, 1); combiner_ns->proc_name = combiner_ns->parent->proc_name; - gfc_get_sym_tree ("omp_out", combiner_ns, &omp_out, false); - gfc_get_sym_tree ("omp_in", combiner_ns, &omp_in, false); + sname = gfc_get_string ("%s", "omp_out"); + gfc_get_sym_tree (sname, combiner_ns, &omp_out, false); + sname = gfc_get_string ("%s", "omp_in"); + gfc_get_sym_tree (sname, combiner_ns, &omp_in, false); combiner_ns->omp_udr_ns = 1; omp_out->n.sym->ts = tss[i]; omp_in->n.sym->ts = tss[i]; @@ -2903,8 +2906,10 @@ gfc_match_omp_declare_reduction (void) gfc_current_ns = initializer_ns; initializer_ns->proc_name = initializer_ns->parent->proc_name; - gfc_get_sym_tree ("omp_priv", initializer_ns, &omp_priv, false); - gfc_get_sym_tree ("omp_orig", initializer_ns, &omp_orig, false); + sname = gfc_get_string ("%s", "omp_priv"); + gfc_get_sym_tree (sname, initializer_ns, &omp_priv, false); + sname = gfc_get_string ("%s", "omp_orig"); + gfc_get_sym_tree (sname, initializer_ns, &omp_orig, false); initializer_ns->omp_udr_ns = 1; omp_priv->n.sym->ts = tss[i]; omp_orig->n.sym->ts = tss[i]; diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 755bff56e24..b7265c42f58 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -6252,7 +6252,7 @@ loop: prog_locus = gfc_current_locus; push_state (&s, COMP_PROGRAM, gfc_new_block); - main_program_symbol (gfc_current_ns, "MAIN__"); + main_program_symbol (gfc_current_ns, gfc_get_string ("MAIN__")); parse_progunit (st); goto prog_units; } diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 88c16d462bd..8072bd20435 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -8814,10 +8814,11 @@ fixup_array_ref (gfc_expr **expr1, gfc_expr *expr2, static gfc_expr * build_loc_call (gfc_expr *sym_expr) { + const char *loc = gfc_get_string ("%s", "_loc"); gfc_expr *loc_call; loc_call = gfc_get_expr (); loc_call->expr_type = EXPR_FUNCTION; - gfc_get_sym_tree ("_loc", gfc_current_ns, &loc_call->symtree, false); + gfc_get_sym_tree (loc, gfc_current_ns, &loc_call->symtree, false); loc_call->symtree->n.sym->attr.flavor = FL_PROCEDURE; loc_call->symtree->n.sym->attr.intrinsic = 1; loc_call->symtree->n.sym->result = loc_call->symtree->n.sym; @@ -10487,12 +10488,13 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns) path. */ if (caf_convert_to_send) { + const char *sname = gfc_get_string ("%s", GFC_PREFIX ("caf_send")); if (code->expr2->expr_type == EXPR_FUNCTION && code->expr2->value.function.isym && code->expr2->value.function.isym->id == GFC_ISYM_CAF_GET) remove_caf_get_intrinsic (code->expr2); code->op = EXEC_CALL; - gfc_get_sym_tree (GFC_PREFIX ("caf_send"), ns, &code->symtree, true); + gfc_get_sym_tree (sname, ns, &code->symtree, true); code->resolved_sym = code->symtree->n.sym; code->resolved_sym->attr.flavor = FL_PROCEDURE; code->resolved_sym->attr.intrinsic = 1; From patchwork Wed Sep 5 14:57:26 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Bernhard Reutner-Fischer X-Patchwork-Id: 966439 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-485236-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="ECe7KNXr"; dkim=pass (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="rqLtWAuk"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4256Qx3VK5z9s5c for ; Thu, 6 Sep 2018 01:03:37 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; q=dns; s=default; b=gf/ AeZcLJHf/v/lISLEyzfJdvA0juepQyUEbpHZxB3k95YNzK2m3gY+lg0Taii2JAqZ snqSLZR4PgtHM8ryh8j8dnSLkGszEEDw3+xZZ3z/JYNN7kcyPTPlcrnHfDpxdn7Q K+gSrprFf6RnGK3jVG6qqSnWeD/6PF5qbO4+brKs= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; s=default; bh=9dLQmxXEc sAKAZvzA5kVIMB//aM=; b=ECe7KNXrH5gEpWz9HiImh3q3e3Ew7HBpiSH5VtvLE WvHBrNDlQLm+MAGx3Kg8+uA09Zcl7yYqISpbtZzi0QILIRXQEAtNXbfyJ0DUW5ct buRX41l0Kj7WbiDZUJImpMIqS3dXWQ64qUBGSgB0gfFHTuhRVzxofwMqXbJsQ0dv Yc= Received: (qmail 70050 invoked by alias); 5 Sep 2018 14:58:07 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 69094 invoked by uid 89); 5 Sep 2018 14:57:59 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.8 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= X-HELO: mail-wm0-f47.google.com Received: from mail-wm0-f47.google.com (HELO mail-wm0-f47.google.com) (74.125.82.47) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 05 Sep 2018 14:57:57 +0000 Received: by mail-wm0-f47.google.com with SMTP id n11-v6so8058312wmc.2; Wed, 05 Sep 2018 07:57:57 -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=Km9qYutJZlw4WSf7dRyyqcwsqJwwWx0VwSC1XKIZAHI=; b=rqLtWAukHdAFnKxo5jKaUg4HmrJT3h4N0W4yIl3/JMs+Lp5fZ4LH8Deo06zrlTwE0P NkHsyCZ13WBZPFM3Q3Cv4wPfWYe8ZG2rvr2xU1P5oy+r9dCNRO/Jx8AJeJbiWuqeb3S3 dCLZYBATYgBiX33E6vbcuJZ/zp/dZ+vX2SJcA6lvZopEBfVzCzQTEJFyH0RYiu0+WXee kSNSjiD/FgR/1V+hdcZE67dmVdbV/WjZzZoXRZyNF/wbbhiBhoUuSqD/BewluCQLS4VI zRLNCbfacY3EgqlemHq+vJCt8gpJX/vkVSuqwNFzaVvIGoqpgzL8A7dgbJakC3lXvGKj gPEA== Received: from s46.loc (91-119-125-11.dsl.dynamic.surfer.at. [91.119.125.11]) by smtp.gmail.com with ESMTPSA id b74-v6sm3706029wma.8.2018.09.05.07.57.49 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 05 Sep 2018 07:57:51 -0700 (PDT) Received: from cow by s46.loc with local (Exim 4.91) (envelope-from ) id 1fxZFb-00008L-1u; Wed, 05 Sep 2018 14:57:47 +0000 From: Bernhard Reutner-Fischer To: fortran@gcc.gnu.org Cc: Bernhard Reutner-Fischer , gcc-patches@gcc.gnu.org Subject: [PATCH,FORTRAN 23/29] Use stringpool for module binding_label Date: Wed, 5 Sep 2018 14:57:26 +0000 Message-Id: <20180905145732.404-24-rep.dot.nop@gmail.com> In-Reply-To: References: MIME-Version: 1.0 X-IsSubscribed: yes From: Bernhard Reutner-Fischer gcc/fortran/ChangeLog: 2017-11-28 Bernhard Reutner-Fischer * module.c (struct pointer_info): Change binding_label to const pointer. (free_pi_tree): Do not free binding_label. (load_commons): Use stringpool for binding_label. (load_needed): Likewise. (read_module): Likewise. --- gcc/fortran/module.c | 31 ++++++++++++------------------- 1 file changed, 12 insertions(+), 19 deletions(-) diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 24e48c94c76..8f6dc9f2864 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -158,7 +158,8 @@ typedef struct pointer_info struct { gfc_symbol *sym; - char *true_name, *module, *binding_label; + const char *binding_label; + char *true_name, *module; fixup_t *stfixup; gfc_symtree *symtree; enum gfc_rsym_state state; @@ -242,7 +243,6 @@ free_pi_tree (pointer_info *p) { XDELETEVEC (p->u.rsym.true_name); XDELETEVEC (p->u.rsym.module); - XDELETEVEC (p->u.rsym.binding_label); } free (p); @@ -4646,7 +4646,7 @@ load_commons (void) while (peek_atom () != ATOM_RPAREN) { int flags; - char* label; + const char* bind_label; mio_lparen (); mio_pool_string (&name); @@ -4663,10 +4663,9 @@ load_commons (void) /* Get whether this was a bind(c) common or not. */ mio_integer (&p->is_bind_c); /* Get the binding label. */ - label = read_string (); - if (strlen (label)) - p->binding_label = IDENTIFIER_POINTER (get_identifier (label)); - XDELETEVEC (label); + mio_pool_string (&bind_label); + if (bind_label) + p->binding_label = bind_label; mio_rparen (); } @@ -4899,8 +4898,7 @@ load_needed (pointer_info *p) sym->name = gfc_dt_lower_string (p->u.rsym.true_name); sym->module = gfc_get_string ("%s", p->u.rsym.module); if (p->u.rsym.binding_label) - sym->binding_label = IDENTIFIER_POINTER (get_identifier - (p->u.rsym.binding_label)); + sym->binding_label = p->u.rsym.binding_label; associate_integer_pointer (p, sym); } @@ -5052,7 +5050,7 @@ read_module (void) pointer_info *info, *q; gfc_use_rename *u = NULL; gfc_symtree *st; - gfc_symbol *sym; + gfc_symbol *sym = NULL; get_module_locus (&operator_interfaces); /* Skip these for now. */ skip_list (); @@ -5075,7 +5073,7 @@ read_module (void) while (peek_atom () != ATOM_RPAREN) { - char* bind_label; + const char* bind_label; require_atom (ATOM_INTEGER); info = get_integer (atom_int); @@ -5084,11 +5082,9 @@ read_module (void) info->u.rsym.true_name = read_string (); info->u.rsym.module = read_string (); - bind_label = read_string (); - if (strlen (bind_label)) + mio_pool_string (&bind_label); + if (bind_label) info->u.rsym.binding_label = bind_label; - else - XDELETEVEC (bind_label); require_atom (ATOM_INTEGER); info->u.rsym.ns = atom_int; @@ -5265,10 +5261,7 @@ read_module (void) sym->module = gfc_get_string ("%s", info->u.rsym.module); if (info->u.rsym.binding_label) - { - tree id = get_identifier (info->u.rsym.binding_label); - sym->binding_label = IDENTIFIER_POINTER (id); - } + sym->binding_label = info->u.rsym.binding_label; } st->n.sym = sym; From patchwork Wed Sep 5 14:57:27 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Bernhard Reutner-Fischer X-Patchwork-Id: 966437 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-485234-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="JQvrzsiV"; dkim=pass (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="ghoMJ/Df"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4256Q41dkHz9s5c for ; Thu, 6 Sep 2018 01:02:52 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; q=dns; s=default; b=AoK Cca+GeE2WG1m8p8eCcj8JyS9C8jjygCyOVRjnz6bhf61EE/3nF0fJPEdHR3yKdnW Jw61frRtkLAWp74Nb0iJVGm7mXoCiJmHbM5m2aGAJlU8uFB7A3XADqzqiA3kOkEi ywAcVip3QvWtENWWc2OgAABEuTwKf7PRTxXBZamo= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; s=default; bh=ZuWUf5hJu Z6Hwy0rdKhDJ8MSiu4=; b=JQvrzsiV/avnwMZnq3gssWd2buKsxMpjItQTUfi2t HqGn8+2/OeqLGVMUCt2hAFnsc76KbFSnPDq1TPyFurh4N8O+r6qmK+hT7VRMHPiA GKhB4PQNLJNP5jTv74Mupis/JhhwqfrIfGjXDz95kBORD3wUZEHeWKzHJF8liOW6 do= Received: (qmail 69838 invoked by alias); 5 Sep 2018 14:58:06 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 68920 invoked by uid 89); 5 Sep 2018 14:57:56 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.8 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=UD:cl, 37876, HContent-Transfer-Encoding:8bit X-HELO: mail-wm0-f51.google.com Received: from mail-wm0-f51.google.com (HELO mail-wm0-f51.google.com) (74.125.82.51) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 05 Sep 2018 14:57:55 +0000 Received: by mail-wm0-f51.google.com with SMTP id j25-v6so14208540wmc.1; Wed, 05 Sep 2018 07:57:54 -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=WGLkYYRVunmlr4LdFxBvq1dqL24CGCTPADXyhoKRcbw=; b=ghoMJ/DfoPJcVlsCG3GinXLsvQMtoLMQwaWW5vVyNYfUnlpMCYgWDwyY81FNFCKR0N 51gg+UtaS7TjROUHrwibDJxWC4MWrt/8O+wFoC92z2WOsiGfV5BS89DnyoTAEl2WRGT+ V/6Y0/owGaxKFqq8/MBVxWDPz/Iz7PnZ5dV+Np4JV2zo2XlLfe+AsD1jNglWgO7wyEsF qPs46e1daFhT1Ja0ehv/4Z9HKIxWvGDF5ITJi6g+66cW+Qd7ZdofKeSTT5zvkjYlDyZe VCYf2jSV70CZjeUW1Iy3luYbbfZe+IVC5d73OHn+lmyd6mcvr2Ytnzqj2d/nbnj/SJl0 vtCQ== Received: from s46.loc (91-119-125-11.dsl.dynamic.surfer.at. [91.119.125.11]) by smtp.gmail.com with ESMTPSA id u7-v6sm3274539wmd.46.2018.09.05.07.57.48 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 05 Sep 2018 07:57:51 -0700 (PDT) Received: from cow by s46.loc with local (Exim 4.91) (envelope-from ) id 1fxZFb-00008O-6M; Wed, 05 Sep 2018 14:57:47 +0000 From: Bernhard Reutner-Fischer To: fortran@gcc.gnu.org Cc: Bernhard Reutner-Fischer , gcc-patches@gcc.gnu.org Subject: [PATCH,FORTRAN 24/29] Use stringpool for intrinsic functions Date: Wed, 5 Sep 2018 14:57:27 +0000 Message-Id: <20180905145732.404-25-rep.dot.nop@gmail.com> In-Reply-To: References: MIME-Version: 1.0 X-IsSubscribed: yes From: Bernhard Reutner-Fischer gcc/fortran/ChangeLog: 2017-11-29 Bernhard Reutner-Fischer * iresolve.c (gfc_resolve_ctime_sub): Use stringpool for intrinsic subroutine name. (gfc_resolve_fdate_sub): Likewise. (gfc_resolve_gerror): Likewise. (gfc_resolve_getlog): Likewise. (gfc_resolve_perror): Likewise. (gfc_resolve_fseek_sub): Likewise. (gfc_resolve_ttynam_sub): Likewise. --- gcc/fortran/iresolve.c | 24 ++++++++++++++++-------- 1 file changed, 16 insertions(+), 8 deletions(-) diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index f22e0da54c9..61663fec7e5 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -3787,6 +3787,7 @@ gfc_resolve_flush (gfc_code *c) void gfc_resolve_ctime_sub (gfc_code *c) { + const char *name; gfc_typespec ts; gfc_clear_ts (&ts); @@ -3800,28 +3801,32 @@ gfc_resolve_ctime_sub (gfc_code *c) gfc_convert_type (c->ext.actual->expr, &ts, 2); } - c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("ctime_sub")); + name = gfc_get_string (PREFIX ("ctime_sub")); + c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); } void gfc_resolve_fdate_sub (gfc_code *c) { - c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("fdate_sub")); + const char *name = gfc_get_string (PREFIX ("fdate_sub")); + c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); } void gfc_resolve_gerror (gfc_code *c) { - c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("gerror")); + const char *name = gfc_get_string (PREFIX ("gerror")); + c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); } void gfc_resolve_getlog (gfc_code *c) { - c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("getlog")); + const char *name = gfc_get_string (PREFIX ("getlog")); + c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); } @@ -3844,7 +3849,8 @@ gfc_resolve_hostnm_sub (gfc_code *c) void gfc_resolve_perror (gfc_code *c) { - c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("perror_sub")); + const char *name = gfc_get_string (PREFIX ("perror_sub")); + c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); } /* Resolve the STAT and FSTAT intrinsic subroutines. */ @@ -3976,6 +3982,7 @@ gfc_resolve_fput_sub (gfc_code *c) void gfc_resolve_fseek_sub (gfc_code *c) { + const char *name; gfc_expr *unit; gfc_expr *offset; gfc_expr *whence; @@ -4012,8 +4019,8 @@ gfc_resolve_fseek_sub (gfc_code *c) ts.u.cl = NULL; gfc_convert_type (whence, &ts, 2); } - - c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("fseek_sub")); + name = gfc_get_string (PREFIX ("fseek_sub")); + c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); } void @@ -4045,6 +4052,7 @@ gfc_resolve_ftell_sub (gfc_code *c) void gfc_resolve_ttynam_sub (gfc_code *c) { + const char *name = gfc_get_string (PREFIX ("ttynam_sub")); gfc_typespec ts; gfc_clear_ts (&ts); @@ -4057,7 +4065,7 @@ gfc_resolve_ttynam_sub (gfc_code *c) gfc_convert_type (c->ext.actual->expr, &ts, 2); } - c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("ttynam_sub")); + c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); } From patchwork Wed Sep 5 14:57:28 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Bernhard Reutner-Fischer X-Patchwork-Id: 966442 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-485239-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="aDTdmwy0"; dkim=pass (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="jOTwlOhh"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4256S81hfLz9sCw for ; Thu, 6 Sep 2018 01:04:40 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; q=dns; s=default; b=uJZ UbUVvf6iKVnn/+lhkVAbAVXCBVlcv6KteaevP2blqbvBw70sMygSdtZW2bSsszZ8 umYGszGRbFcmFAPygbYGZ2fXo43Qe3DoY22oNh/cuZxKj4Fut9EFQJWts1NQIc1k VXBfTJBFQYLdEai1DZTjmuNmWZ1zlu+vrIe1LkIg= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; s=default; bh=LJgYpG9k5 pCxBq7idS5Yv1YmtQE=; b=aDTdmwy07ocX3Bh/9AY8KcZvu3jHqKVls0RiKcQzV bb8UPBUA0QS45e2Eaq4QvSZ0mk3QmXR++HrffcW7FEsavwAn+HLit1jxc5+Ec2ky BLc65USboKmvKw1B4PgkbOKESwTQ+xvQbO4yfZqzISV3pvpd+SkUWMhFK4Xnn2uO Y4= Received: (qmail 70262 invoked by alias); 5 Sep 2018 14:58:09 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 69073 invoked by uid 89); 5 Sep 2018 14:57:58 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.8 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=ns, HContent-Transfer-Encoding:8bit X-HELO: mail-wr1-f42.google.com Received: from mail-wr1-f42.google.com (HELO mail-wr1-f42.google.com) (209.85.221.42) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 05 Sep 2018 14:57:57 +0000 Received: by mail-wr1-f42.google.com with SMTP id v16-v6so7975290wro.11; Wed, 05 Sep 2018 07:57:57 -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=UA6TKyPdpvGAd8q6+7guKUT9PMMFzhPiYspOw5g6uC0=; b=jOTwlOhhYAL6pdHOlcgmozyWtYz/zeYC1aKbeMeFkjIrktovRMF5XUcAvNuMAwL9ZV bevGk5xKtxN5sAaQ5Z0/s3B65PTdncfsyqZQp1/nX8HYBUPDiGD3VD4UxmCEu6SOdSvA ePUutWWGttUhzCAe3w8kh6ETR72ut4cYf+wjh9pTHTGjTZ1A1o6kQ9uHM2zy8o1hSvy+ Z6c0+XbPKU9EqTG2wd257m5A8h2ja0UwqkkNRpze4Co6iUDwrKpJICRuCDUKGyhC4D0C Wy3ftqC7qgl/Zd/ig2AR6+dehtw2kE9bPettP3XBz2FuqQMIUqBuQ2lOiCCbDs6zEeXn xs3A== Received: from s46.loc (91-119-125-11.dsl.dynamic.surfer.at. [91.119.125.11]) by smtp.gmail.com with ESMTPSA id k5-v6sm5162657wrm.96.2018.09.05.07.57.48 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 05 Sep 2018 07:57:51 -0700 (PDT) Received: from cow by s46.loc with local (Exim 4.91) (envelope-from ) id 1fxZFb-00008R-B8; Wed, 05 Sep 2018 14:57:47 +0000 From: Bernhard Reutner-Fischer To: fortran@gcc.gnu.org Cc: Bernhard Reutner-Fischer , gcc-patches@gcc.gnu.org Subject: [PATCH,FORTRAN 25/29] Use stringpool on loading module symbols Date: Wed, 5 Sep 2018 14:57:28 +0000 Message-Id: <20180905145732.404-26-rep.dot.nop@gmail.com> In-Reply-To: References: MIME-Version: 1.0 X-IsSubscribed: yes From: Bernhard Reutner-Fischer gcc/fortran/ChangeLog: 2017-11-29 Bernhard Reutner-Fischer * module.c (load_needed): Use stringpool when generating symbols and module names. --- gcc/fortran/module.c | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 8f6dc9f2864..ebfcd62801d 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -4857,6 +4857,7 @@ load_needed (pointer_info *p) pointer_info *q; gfc_symbol *sym; int rv; + const char *true_name, *module; rv = 0; if (p == NULL) @@ -4888,15 +4889,21 @@ load_needed (pointer_info *p) associate_integer_pointer (q, ns); } + true_name = p->u.rsym.true_name; + if (true_name[0] != '\0') + true_name = gfc_get_string ("%s", true_name); + module = p->u.rsym.module; + if (module[0] != '\0') + module = gfc_get_string ("%s", module); + /* Use the module sym as 'proc_name' so that gfc_get_symbol_decl doesn't go pear-shaped if the symbol is used. */ if (!ns->proc_name) - gfc_find_symbol (p->u.rsym.module, gfc_current_ns, - 1, &ns->proc_name); + gfc_find_symbol (module, gfc_current_ns, 1, &ns->proc_name); - sym = gfc_new_symbol (p->u.rsym.true_name, ns); - sym->name = gfc_dt_lower_string (p->u.rsym.true_name); - sym->module = gfc_get_string ("%s", p->u.rsym.module); + sym = gfc_new_symbol (true_name, ns); + sym->name = gfc_dt_lower_string (true_name); + sym->module = module; if (p->u.rsym.binding_label) sym->binding_label = p->u.rsym.binding_label; From patchwork Wed Sep 5 14:57:29 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Bernhard Reutner-Fischer X-Patchwork-Id: 966432 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-485230-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="C56Bakzs"; dkim=pass (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="YMac8CAE"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4256NW60JCz9sCn for ; Thu, 6 Sep 2018 01:01:31 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; q=dns; s=default; b=JKO DW0hoqDSkO1f57gNWjsI1V3R0p8M6sor9jkWPXDJQhLlIlTjcMLD3/Zu1kCLPbes RVaj3SLM0JQmCnM9mipf+eAidRiqrUZXP7e4+ksZBf0hfduW5tUsHdJDQG/tOKJo 2ZNrJlFUSgga69nXLvWr6TMBdUCvZxZgBpdZ8w74= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; s=default; bh=TTZwi/akZ BCamJ8F3exWP11jTy0=; b=C56BakzsECDC/n8su5ZrpW1g494WThCbjGQBAlYzd VZEgA0QCKrjosA5PcLQ0fEJLnMnM4MowsVuRJTaTU8mDGGe0Nl2Jp3u8CHs/Cdyz OZWP8RYYoGRKvlDXTPSOlAVRjGgehaxt9XNq068cSxeCf+yo2tNFpYmTwbW2iL3Z d4= Received: (qmail 69456 invoked by alias); 5 Sep 2018 14:58:01 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 68748 invoked by uid 89); 5 Sep 2018 14:57:56 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.7 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=Hx-languages-length:1015, HContent-Transfer-Encoding:8bit X-HELO: mail-wm0-f45.google.com Received: from mail-wm0-f45.google.com (HELO mail-wm0-f45.google.com) (74.125.82.45) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 05 Sep 2018 14:57:54 +0000 Received: by mail-wm0-f45.google.com with SMTP id y2-v6so8334699wma.1; Wed, 05 Sep 2018 07:57:54 -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=Qqhcz3+bnygvA7YCAIXM1AgYjXQkfcjt8wshDOLl9jY=; b=YMac8CAEl+VHF24EJYHFn9f7aRmZO+9HtCetJFe85yQtZOrPGf5ehaM4y4eatugxFO BNC4iVbuNzyA15Sel2vgRWCTaJ1lB8ria8QFzE3YBqUnVnQY+6n520DY/H0giLlUTd5x XyVCpss2ScXBKBWJMoqg0orNSWAHYaJ04I5XwMwvBKWPuD3lBTQDaK6Ldm+nRHVCKrk8 GoMoFV2lw8cjL3eT43XfaPZNNs5Md/y+13W7PzYrCRK4N1n6+TNf0DnMah26mI6SIVPE 5gb0dXolfMKVObYLXN/FHSHPZ1d9tsDCcO0luAgwCOsgy6bKEc+XbIyB+ByDT3fVJAGb 7tgQ== Received: from s46.loc (91-119-125-11.dsl.dynamic.surfer.at. [91.119.125.11]) by smtp.gmail.com with ESMTPSA id v2-v6sm1637423wme.36.2018.09.05.07.57.48 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 05 Sep 2018 07:57:51 -0700 (PDT) Received: from cow by s46.loc with local (Exim 4.91) (envelope-from ) id 1fxZFb-00008U-Fc; Wed, 05 Sep 2018 14:57:47 +0000 From: Bernhard Reutner-Fischer To: fortran@gcc.gnu.org Cc: Bernhard Reutner-Fischer , gcc-patches@gcc.gnu.org Subject: [PATCH,FORTRAN 26/29] Use stringpool for mangled common names Date: Wed, 5 Sep 2018 14:57:29 +0000 Message-Id: <20180905145732.404-27-rep.dot.nop@gmail.com> In-Reply-To: References: MIME-Version: 1.0 X-IsSubscribed: yes From: Bernhard Reutner-Fischer gcc/fortran/ChangeLog: 2017-11-29 Bernhard Reutner-Fischer * match.c (gfc_get_common): Use stringpool for mangled name. --- gcc/fortran/match.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index fd91e280b93..8d073f28f67 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -5008,13 +5008,13 @@ gfc_get_common (const char *name, int from_module) { gfc_symtree *st; static int serial = 0; - char mangled_name[GFC_MAX_SYMBOL_LEN + 1]; + const char *mangled_name; if (from_module) { /* A use associated common block is only needed to correctly layout the variables it contains. */ - snprintf (mangled_name, GFC_MAX_SYMBOL_LEN, "_%d_%s", serial++, name); + mangled_name = gfc_get_string ("_%d_%s", serial++, name); st = gfc_new_symtree (&gfc_current_ns->common_root, mangled_name); } else From patchwork Wed Sep 5 14:57:30 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Bernhard Reutner-Fischer X-Patchwork-Id: 966443 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-485240-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="rn428SYB"; dkim=pass (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="b15s1vSH"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4256SP0PNsz9sDT for ; Thu, 6 Sep 2018 01:04:52 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; q=dns; s=default; b=M4V HjXf6rjkuMxVrjLIvhJpb7sLf/Ar9i0mBAAXP/RG0TEMCj90BgWPZ2NYO4FbUspY 2bMgsk8lzV5rbi6NuIg1NFyobsB0lMUaMA/wvVeVH35KuDWUn+ng6Rm07Z3KKjgd SBYqYf9D+ClRUoEwA+nPEb1KQBOc4OEPmcsDnp2g= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; s=default; bh=9JedvE2T8 8Bh8pnabI9yIr+VWAI=; b=rn428SYBqHiT8BPG35rlIpxvF1UINAKtyGjdmrMpL +GCOXdjhf1J8L//fKGhypM0O4JH/oVh6QSniq+sR9jg8JERpyamsHiHqPuIaCihA Qsi2KI2tCjB1HZNLPp7Qc7H4FW4nZYjigRMV/dKocrdqSMb+EG/3kqMEcStanYqm SE= Received: (qmail 70316 invoked by alias); 5 Sep 2018 14:58:09 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 69243 invoked by uid 89); 5 Sep 2018 14:58:00 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.8 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=HContent-Transfer-Encoding:8bit X-HELO: mail-wr1-f42.google.com Received: from mail-wr1-f42.google.com (HELO mail-wr1-f42.google.com) (209.85.221.42) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 05 Sep 2018 14:57:59 +0000 Received: by mail-wr1-f42.google.com with SMTP id k5-v6so7996928wre.10; Wed, 05 Sep 2018 07:57:58 -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=L3JUMGP73k16cfHInCnmTb3lkLWjjItZmLlteP9O4VY=; b=b15s1vSHDmJD55ccLAIHCqyHYlTR6iwpQal6Nsrvy/ZVQIwoGG2hU+LLfoInpzt22t ZHWD+niRE6ReDMyvlTi+fax5MhU2td3GHnXlGq0EZWAG4WIIwhvmRhwFmBu9e4+GArst sqWMoQMBpGqC317goEHM2Xw33xpfZ1Pl72piJE3tKPnRuToPA1d6nYiQdNof+BPVe0it krgEh54JJnfIGe8TA6frF4DkpmjIANrKrzAcVkVFg96tD0qGyAb/TVDhatGtVrCZizLI WJb+ygCKBTJdqnzLuS28uRg24NfYERziegg/ypxBCeEzWAaOYhyejyFEcgqXc77KYZ8U txOw== Received: from s46.loc (91-119-125-11.dsl.dynamic.surfer.at. [91.119.125.11]) by smtp.gmail.com with ESMTPSA id 14-v6sm3440406wmp.32.2018.09.05.07.57.50 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 05 Sep 2018 07:57:56 -0700 (PDT) Received: from cow by s46.loc with local (Exim 4.91) (envelope-from ) id 1fxZFb-00008X-Jt; Wed, 05 Sep 2018 14:57:47 +0000 From: Bernhard Reutner-Fischer To: fortran@gcc.gnu.org Cc: Bernhard Reutner-Fischer , gcc-patches@gcc.gnu.org Subject: [PATCH,FORTRAN 27/29] Use stringpool for OMP clause reduction code Date: Wed, 5 Sep 2018 14:57:30 +0000 Message-Id: <20180905145732.404-28-rep.dot.nop@gmail.com> In-Reply-To: References: MIME-Version: 1.0 X-IsSubscribed: yes From: Bernhard Reutner-Fischer gcc/fortran/ChangeLog: 2017-12-12 Bernhard Reutner-Fischer * trans-openmp.c (gfc_trans_omp_array_reduction_or_udr): Use stringpool for clause reduction code. --- gcc/fortran/trans-openmp.c | 1 + 1 file changed, 1 insertion(+) diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index f038f4c5bf8..c8d7e0a409d 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -1616,6 +1616,7 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where) } if (iname != NULL) { + iname = gfc_get_string ("%s", iname); memset (&intrinsic_sym, 0, sizeof (intrinsic_sym)); intrinsic_sym.ns = sym->ns; intrinsic_sym.name = iname; From patchwork Wed Sep 5 14:57:31 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Bernhard Reutner-Fischer X-Patchwork-Id: 966445 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-485242-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="iU6Uzpm+"; dkim=pass (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="GfwX8Ox4"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4256T05yqGz9s5c for ; Thu, 6 Sep 2018 01:05:24 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; q=dns; s=default; b=mWk H+IIVI/wxN1X3aCheTiG5tK5EGDrWQt1T4EFPAqyuGWyau8oiuctLLvD8j3Vv6Xi jrdvvx3IzEsVjTO2yvIjiePgOE5OHPNxhKHVfqyG/2xysi1g80oauf6Lr08JF6sN 4oDw9FCclTzTOu7O7SNwt73dADPpciC2UCQvo+uk= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; s=default; bh=8moits+wy WaXGwQAwO7wyHtZBiA=; b=iU6Uzpm+ayyftIt+c7M9rNhH8CgFcHHueRltbyouK OvhHliqDdwM75/1ewOcMaK7mH6SB0pfOj0f755RFqAFuZFVb8Vk0IDKuTKWdR+hm VjOP72gnokFp0EhOiW0NuSwg0l1suX0aENCtV6cXqiu835Wj7NyUuUaFKndNvQ/r 9g= Received: (qmail 101200 invoked by alias); 5 Sep 2018 15:02:43 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 101083 invoked by uid 89); 5 Sep 2018 15:02:42 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.8 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=4945 X-HELO: mail-wm0-f45.google.com Received: from mail-wm0-f45.google.com (HELO mail-wm0-f45.google.com) (74.125.82.45) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 05 Sep 2018 15:02:41 +0000 Received: by mail-wm0-f45.google.com with SMTP id o18-v6so8139221wmc.0; Wed, 05 Sep 2018 08:02:40 -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=5BrOu6aEd+Eui57atZN//8LFnSqYuh0+77Fj+dJfQbE=; b=GfwX8Ox4ZUaDWXcMM+LXayB8eIKFqq6TSTD3+quIwozSo0n7zd+3+6b2qtNBEW8ypo ooNzpVLZjmpL74hqSJVuzD0bMiJCVllf7n5osd4NL49/OWtRBmbNKWCCeUVqTqBjzS3t orpZLGwuJGK/RHWL41NuLPeQBonZ8l9ylVpzHRj1rJziCVrTG1btGKZfC5G7euXoproF PmBHpQ4bHDWbZnowfZF8BddD/qpVgm25KjvimCbARBIqeX2y+XQdLDCUHCtbrcjzN/NL S3Izv1HthBlTRi9omYxWl9D+Vosv3tcNCknRSgOZpJts5eYxMFCaUUspKcJpNYYmejge TY4Q== Received: from s46.loc (91-119-125-11.dsl.dynamic.surfer.at. [91.119.125.11]) by smtp.gmail.com with ESMTPSA id j2-v6sm3264281wmj.5.2018.09.05.08.02.38 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 05 Sep 2018 08:02:38 -0700 (PDT) Received: from cow by s46.loc with local (Exim 4.91) (envelope-from ) id 1fxZFb-00008b-Uz; Wed, 05 Sep 2018 14:57:47 +0000 From: Bernhard Reutner-Fischer To: fortran@gcc.gnu.org Cc: Bernhard Reutner-Fischer , gcc-patches@gcc.gnu.org Subject: [PATCH,FORTRAN 28/29] Free type-bound procedure structs Date: Wed, 5 Sep 2018 14:57:31 +0000 Message-Id: <20180905145732.404-29-rep.dot.nop@gmail.com> In-Reply-To: References: MIME-Version: 1.0 X-IsSubscribed: yes From: Bernhard Reutner-Fischer compiling gfortran.dg/typebound_proc_31.f90 leaked the type-bound structs: 56 bytes in 1 blocks are definitely lost. at 0x4C2CC05: calloc (vg_replace_malloc.c:711) by 0x151EA90: xcalloc (xmalloc.c:162) by 0x8E3E4F: gfc_get_typebound_proc(gfc_typebound_proc*) (symbol.c:4945) by 0x84C095: match_procedure_in_type (decl.c:10486) by 0x84C095: gfc_match_procedure() (decl.c:6696) ... gcc/fortran/ChangeLog: 2017-12-06 Bernhard Reutner-Fischer * symbol.c (free_tb_tree): Free type-bound procedure struct. (gfc_get_typebound_proc): Use explicit memcpy for clarity. --- gcc/fortran/symbol.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 53c760a6c38..cde34c67482 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -3845,7 +3845,7 @@ free_tb_tree (gfc_symtree *t) /* TODO: Free type-bound procedure structs themselves; probably needs some sort of ref-counting mechanism. */ - + free (t->n.tb); free (t); } @@ -5052,7 +5052,7 @@ gfc_get_typebound_proc (gfc_typebound_proc *tb0) result = XCNEW (gfc_typebound_proc); if (tb0) - *result = *tb0; + memcpy (result, tb0, sizeof (gfc_typebound_proc));; result->error = 1; latest_undo_chgset->tbps.safe_push (result); From patchwork Wed Sep 5 14:57:32 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Bernhard Reutner-Fischer X-Patchwork-Id: 966441 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-485238-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="WjHxsIbv"; dkim=pass (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="iaCLZ/wg"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4256Rj47yzz9s5c for ; Thu, 6 Sep 2018 01:04:17 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; q=dns; s=default; b=mxr GIwIyBEAgIzY20Ex03FzI9wRx4Kwr3F4MS6iezt3SngWesWSZNe37O/J1nrIyCrt M3eCVRADRW1PFoS+JQx7TzKcYpTroIKebv7G0YTP1cX6nXNUKpBLrJOulv7mCEzS 3SW7vzJ1RV6kX5hGpGgjtsrQQtC8sSlYJ9a5yamU= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; s=default; bh=3iBdEAwsB 0uiLEQDC1ir/s+OsYs=; b=WjHxsIbvcXnCYuxQYSfzYCamvaKc4F7/swgJX+XBu 32riglT+4X81ElVXUCb6aMkPWHRD3EmAjn8171iHCXF/EGwsCe1WyhhgoIqoCbCT Qw5vvkK4Ay2Lg9uJ7KpaQOqImpdefNiYuA6fuSurCV4A8/s3oAC7sWFcgDkBwTub lI= Received: (qmail 70219 invoked by alias); 5 Sep 2018 14:58:08 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 69066 invoked by uid 89); 5 Sep 2018 14:57:58 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-26.8 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*r:sk:l130-v6 X-HELO: mail-wm0-f51.google.com Received: from mail-wm0-f51.google.com (HELO mail-wm0-f51.google.com) (74.125.82.51) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 05 Sep 2018 14:57:56 +0000 Received: by mail-wm0-f51.google.com with SMTP id b19-v6so8340665wme.3; Wed, 05 Sep 2018 07:57:56 -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=AUM8DI/ruSfmT4xZmxeo/IQP+gy6oAkG54GnFm3j3+E=; b=iaCLZ/wgoHD8RspipGPvVjcTXv/42Kp7FhOtix3uCbaUFHJeoMxrlp5hz5yVsTfsi+ UixUoIkgWrcZNPM4YgZ6868pJoflNqSpPuQ3vFNCqB6Ou/27vePwYnbKJqxD3yIfeL13 VA4uyEkYvcdSDLLWslBUMGoYFURYKx+jP85ZN8uPChI1pu5CksHSzfQMYPHq1H1mkXFf 8p1i50Xoh0z+PZheOES+ZMKdxzwV1F8wG84QeL5Xf3XQct7n7oKZ7r1e+IVQRvFNELI1 T2STV+E3VUWL2ciPt6Ri35o/PgtfL/3OxAZwYODezwg5sjFJVJ7Bf7FGtsUEilC67m0R wBlA== Received: from s46.loc (91-119-125-11.dsl.dynamic.surfer.at. [91.119.125.11]) by smtp.gmail.com with ESMTPSA id l130-v6sm3392795wmd.16.2018.09.05.07.57.49 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 05 Sep 2018 07:57:51 -0700 (PDT) Received: from cow by s46.loc with local (Exim 4.91) (envelope-from ) id 1fxZFc-00008e-3m; Wed, 05 Sep 2018 14:57:48 +0000 From: Bernhard Reutner-Fischer To: fortran@gcc.gnu.org Cc: Bernhard Reutner-Fischer , gcc-patches@gcc.gnu.org Subject: [PATCH, FORTRAN 29/29] PR87103: Remove max symbol length check from gfc_new_symbol Date: Wed, 5 Sep 2018 14:57:32 +0000 Message-Id: <20180905145732.404-30-rep.dot.nop@gmail.com> In-Reply-To: References: MIME-Version: 1.0 X-IsSubscribed: yes From: Bernhard Reutner-Fischer gfc_match_name does check for too long names already. Since gfc_new_symbol is also called for symbols with internal names containing compiler-generated prefixes, these internal names can easily exceed the max_identifier_length mandated by the standard. gcc/fortran/ChangeLog 2018-09-04 Bernhard Reutner-Fischer PR fortran/87103 * expr.c (gfc_check_conformance): Check vsnprintf for truncation. * iresolve.c (gfc_get_string): Likewise. * symbol.c (gfc_new_symbol): Remove check for maximum symbol name length. Remove redundant 0 setting of new calloc()ed gfc_symbol. --- gcc/fortran/expr.c | 4 +++- gcc/fortran/iresolve.c | 5 ++++- gcc/fortran/symbol.c | 16 ---------------- 3 files changed, 7 insertions(+), 18 deletions(-) diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index c5bf822cd24..6b5671390ec 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -3225,8 +3225,10 @@ gfc_check_conformance (gfc_expr *op1, gfc_expr *op2, const char *optype_msgid, . return true; va_start (argp, optype_msgid); - vsnprintf (buffer, 240, optype_msgid, argp); + d = vsnprintf (buffer, sizeof (buffer), optype_msgid, argp); va_end (argp); + if (d < 1 || d >= (int) sizeof (buffer)) /* Reject truncation. */ + gfc_internal_error ("optype_msgid overflow: %d", d); if (op1->rank != op2->rank) { diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index 61663fec7e5..d7bd0545173 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -60,9 +60,12 @@ gfc_get_string (const char *format, ...) } else { + int ret; va_start (ap, format); - vsnprintf (temp_name, sizeof (temp_name), format, ap); + ret = vsnprintf (temp_name, sizeof (temp_name), format, ap); va_end (ap); + if (ret < 1 || ret >= (int) sizeof (temp_name)) /* Reject truncation. */ + gfc_internal_error ("identifier overflow: %d", ret); temp_name[sizeof (temp_name) - 1] = 0; str = temp_name; } diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index cde34c67482..fc3354f0457 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -3142,25 +3142,9 @@ gfc_new_symbol (const char *name, gfc_namespace *ns) gfc_clear_ts (&p->ts); gfc_clear_attr (&p->attr); p->ns = ns; - p->declared_at = gfc_current_locus; - - if (strlen (name) > GFC_MAX_SYMBOL_LEN) - gfc_internal_error ("new_symbol(): Symbol name too long"); - p->name = gfc_get_string ("%s", name); - /* Make sure flags for symbol being C bound are clear initially. */ - p->attr.is_bind_c = 0; - p->attr.is_iso_c = 0; - - /* Clear the ptrs we may need. */ - p->common_block = NULL; - p->f2k_derived = NULL; - p->assoc = NULL; - p->dt_next = NULL; - p->fn_result_spec = 0; - return p; }