From patchwork Sun Jul 19 15:38:11 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Thomas Koenig X-Patchwork-Id: 1331826 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; helo=sourceware.org; envelope-from=gcc-patches-bounces@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=gcc.gnu.org Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.a=rsa-sha256 header.s=default header.b=VPW3/LxB; dkim-atps=neutral Received: from sourceware.org (server2.sourceware.org [8.43.85.97]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4B8psy5bcgz9sTC for ; Mon, 20 Jul 2020 01:38:28 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 10D4A3851C13; Sun, 19 Jul 2020 15:38:21 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 10D4A3851C13 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1595173101; bh=TtEsRM3/Fv+DYv8+rYsTUSiWEbCxqOesUUwspJRqtOM=; h=To:Subject:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=VPW3/LxBI3/Iu7CvqhV3UjxhkdupuXsWl7asb6bO6LDJf3T+cDHuOqSMuAJkdux4a qME+e9F05lywSlyfTf1mQlwPI/eEkHJGVxTxUqtDdaY39AF1McqEi3yCXVKoEvSEZF VcQcG+g+Zh5nBk+cTG1WD6qKtUiSOCp9+A16q4Hc= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from cc-smtpout3.netcologne.de (cc-smtpout3.netcologne.de [IPv6:2001:4dd0:100:1062:25:2:0:3]) by sourceware.org (Postfix) with ESMTPS id 49A303858D34; Sun, 19 Jul 2020 15:38:17 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 49A303858D34 Received: from cc-smtpin1.netcologne.de (cc-smtpin1.netcologne.de [89.1.8.201]) by cc-smtpout3.netcologne.de (Postfix) with ESMTP id 0A53F128A4; Sun, 19 Jul 2020 17:38:14 +0200 (CEST) Received: from localhost (localhost [127.0.0.1]) by cc-smtpin1.netcologne.de (Postfix) with ESMTP id EDDB711EF5; Sun, 19 Jul 2020 17:38:13 +0200 (CEST) Received: from [2001:4dd4:dbec:0:d5de:3e32:96e:de6f] (helo=cc-smtpin1.netcologne.de) by localhost with ESMTP (eXpurgate 4.11.6) (envelope-from ) id 5f1468e5-5ba6-7f0000012729-7f000001d9f8-1 for ; Sun, 19 Jul 2020 17:38:13 +0200 Received: from linux-p51k.fritz.box (2001-4dd4-dbec-0-d5de-3e32-96e-de6f.ipv6dyn.netcologne.de [IPv6:2001:4dd4:dbec:0:d5de:3e32:96e:de6f]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by cc-smtpin1.netcologne.de (Postfix) with ESMTPSA; Sun, 19 Jul 2020 17:38:11 +0200 (CEST) To: "fortran@gcc.gnu.org" , gcc-patches Subject: [patch, fortran, committed] Fix PR 96220, error with -fc-prototypes Message-ID: Date: Sun, 19 Jul 2020 17:38:11 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:68.0) Gecko/20100101 Thunderbird/68.10.0 MIME-Version: 1.0 Content-Language: de-DE X-Spam-Status: No, score=-9.3 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_LOW, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Thomas Koenig via Gcc-patches From: Thomas Koenig Reply-To: Thomas Koenig Errors-To: gcc-patches-bounces@gcc.gnu.org Sender: "Gcc-patches" Hello world, I have just committed the attached patch as simple and obvoius. The problem was that, for a test case like module f_global_vars_m use, intrinsic :: iso_c_binding, sp => c_float, dp => c_double implicit none real(dp), bind(c) :: one= 1.0_dp, four= 4.0_dp end module f_global_vars_m the code tried to look up the name of the C type in "dp", not in "c_double". I removed the code which did the wrong thing, and let the code that was already there do the work. I will also backport to gcc 10 and 9 as soon as gcc 10 reopens. No test case because we can not really test for this (but maybe we should dump to files instead of standard output for several of the things that we do dump). Regards Thomas Always use name from c_interop_kinds_table for -fc-prototypes. When a user specified a KIND that was a parameter taking the value of an iso_c_binding KIND, the code used the name of that parameter to look up the type name. Corrected by always looking it up in the table of C interop kinds (which was previously done for non-C-interop types, anyway). gcc/fortran/ChangeLog: PR fortran/96220 * dump-parse-tree.c (get_c_type_name): Always use the entries from c_interop_kinds_table to find the correct C type. diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index f44648879f5..f9a6bf4f1f8 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -3257,45 +3257,28 @@ get_c_type_name (gfc_typespec *ts, gfc_array_spec *as, const char **pre, if (ts->type == BT_REAL || ts->type == BT_INTEGER || ts->type == BT_COMPLEX) { if (ts->is_c_interop && ts->interop_kind) - { - *type_name = ts->interop_kind->name + 2; - if (strcmp (*type_name, "signed_char") == 0) - *type_name = "signed char"; - else if (strcmp (*type_name, "size_t") == 0) - *type_name = "ssize_t"; - else if (strcmp (*type_name, "float_complex") == 0) - *type_name = "__GFORTRAN_FLOAT_COMPLEX"; - else if (strcmp (*type_name, "double_complex") == 0) - *type_name = "__GFORTRAN_DOUBLE_COMPLEX"; - else if (strcmp (*type_name, "long_double_complex") == 0) - *type_name = "__GFORTRAN_LONG_DOUBLE_COMPLEX"; - - ret = T_OK; - } + ret = T_OK; else + ret = T_WARN; + + for (int i = 0; i < ISOCBINDING_NUMBER; i++) { - /* The user did not specify a C interop type. Let's look through - the available table and use the first one, but warn. */ - for (int i = 0; i < ISOCBINDING_NUMBER; i++) + if (c_interop_kinds_table[i].f90_type == ts->type + && c_interop_kinds_table[i].value == ts->kind) { - if (c_interop_kinds_table[i].f90_type == ts->type - && c_interop_kinds_table[i].value == ts->kind) - { - *type_name = c_interop_kinds_table[i].name + 2; - if (strcmp (*type_name, "signed_char") == 0) - *type_name = "signed char"; - else if (strcmp (*type_name, "size_t") == 0) - *type_name = "ssize_t"; - else if (strcmp (*type_name, "float_complex") == 0) - *type_name = "__GFORTRAN_FLOAT_COMPLEX"; - else if (strcmp (*type_name, "double_complex") == 0) - *type_name = "__GFORTRAN_DOUBLE_COMPLEX"; - else if (strcmp (*type_name, "long_double_complex") == 0) - *type_name = "__GFORTRAN_LONG_DOUBLE_COMPLEX"; - - ret = T_WARN; - break; - } + *type_name = c_interop_kinds_table[i].name + 2; + if (strcmp (*type_name, "signed_char") == 0) + *type_name = "signed char"; + else if (strcmp (*type_name, "size_t") == 0) + *type_name = "ssize_t"; + else if (strcmp (*type_name, "float_complex") == 0) + *type_name = "__GFORTRAN_FLOAT_COMPLEX"; + else if (strcmp (*type_name, "double_complex") == 0) + *type_name = "__GFORTRAN_DOUBLE_COMPLEX"; + else if (strcmp (*type_name, "long_double_complex") == 0) + *type_name = "__GFORTRAN_LONG_DOUBLE_COMPLEX"; + + break; } } }