From patchwork Tue Dec 13 16:29:26 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 61874 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 4B0C13839D24 for ; Tue, 13 Dec 2022 16:30:11 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa2.mentor.iphmx.com (esa2.mentor.iphmx.com [68.232.141.98]) by sourceware.org (Postfix) with ESMTPS id 7113E383F08B; Tue, 13 Dec 2022 16:29:42 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 7113E383F08B Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=mentor.com X-IronPort-AV: E=Sophos;i="5.96,241,1665475200"; d="diff'?scan'208";a="90074237" Received: from orw-gwy-02-in.mentorg.com ([192.94.38.167]) by esa2.mentor.iphmx.com with ESMTP; 13 Dec 2022 08:29:40 -0800 IronPort-SDR: jxpFZLIWcjBKMVGacJHRPQZDyWjyujyxprqvaEM/Ay2avR05DVyAlrr1E+o1dhdwabNtomo7i7 qKq2sa8dcPbCKHhtsMkYoHWDHsVYiadCSx6hL6HkK822xJShV+sg57d9QRfYupySEr2iR0uX2D zilWpW5obcO5UfqTjX8tX0xjbH00rBLSLGW43WigJt7atPZaI1o7G7WgvH+v1hvRuTxPzczmrn gd04f05CL2gu/j19GAUPq/aquUaZ9tzz3KHo86GFa46ejCOuUMmk8d4ImlO4bb2N9ckf4DbDW5 dy8= Message-ID: Date: Tue, 13 Dec 2022 17:29:26 +0100 MIME-Version: 1.0 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:102.0) Gecko/20100101 Thunderbird/102.5.1 Content-Language: en-US To: gcc-patches , fortran From: Tobias Burnus Subject: [Patch, Fortran] libgfortran's ISO_Fortran_binding.c: Use GCC11 version for backward-only code [PR108056] X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-09.mgc.mentorg.com (139.181.222.9) To svr-ies-mbx-12.mgc.mentorg.com (139.181.222.12) X-Spam-Status: No, score=-11.4 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, KAM_SHORT, RCVD_IN_MSPIKE_H2, SPF_HELO_PASS, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) 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: , Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" This is a 12/13 regression as come changes to fix the GFC/CFI descriptor that went into GCC 12 fail with the (bogus) descriptor passed via by a GCC-11-compiled program. As later GCC 12 changes moved the descriptor to the front end, those functions are only in libgomp.so to cater for old program. Richard suggested in the PR that the best way is to move to the GCC 11 version, such that libgfortran.so won't regress. I now did so - except for three fixes (cf. changelog). See also PR: https://gcc.gnu.org/PR108056 There is no testcase as it needs to be compiled by GCC <= 11 and then run with linking (dynamically) to a GCC 12 or 13 libgfortran. OK for mainline and GCC 12? * * * Note: It is strongly recommended to use GCC 12 (or 13) with array-descriptor C interop as many issues were fixed. Like for the testcase in the PR; in GCC 11 the type arriving in libgomp is BT_ASSUME ('type(*)'). But as the effective argument is passed as array descriptor through out, the 'float' (real(4)) type info is actually preservable (as GCC 12 cf. testcase of comment 0 and my comment in the PR for the C part of the testcase).(*) Tobias ((*) This is not possible if using a scalar 'type(*)' or a non-array-descriptor array in between. I think GCC 12 uses 'CFI_other' in the information-is-lost case.) ----------------- Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955 libgfortran's ISO_Fortran_binding.c: Use GCC11 version for backward-only code [PR108056] Since GCC 12, the conversion between the array descriptors formats - the internal (GFC) and the C binding one (CFI) moved to the compiler itself such that the cfi_desc_to_gfc_desc/gfc_desc_to_cfi_desc functions are only used with older code (GCC 9 to 11). The newly added checks caused asserts as older code did not pass the proper values (e.g. real(4) as effective argument arrived as BT_ASSUME type as the effective type got lost inbetween). As proposed in the PR, revert to the GCC 11 version - known bugs is better than some fixes and new issues. Still, GCC 12 is much better in terms of TS29113 support and should really be used. This patch uses the current libgomp version of the GCC 11 branch, except it fixes the GFC version number (which is 0), uses calloc instead of malloc, and sets the lower bound to 1 instead of keeping it as is for CFI_attribute_other. libgfortran/ChangeLog: PR libfortran/108056 * runtime/ISO_Fortran_binding.c (cfi_desc_to_gfc_desc, gfc_desc_to_cfi_desc): Mostly revert to GCC 11 version for those backward-compatiblity-only functions. diff --git a/libgfortran/runtime/ISO_Fortran_binding.c b/libgfortran/runtime/ISO_Fortran_binding.c index 342df4275b9..e63a717a69b 100644 --- a/libgfortran/runtime/ISO_Fortran_binding.c +++ b/libgfortran/runtime/ISO_Fortran_binding.c @@ -39,60 +39,31 @@ export_proto(cfi_desc_to_gfc_desc); void cfi_desc_to_gfc_desc (gfc_array_void *d, CFI_cdesc_t **s_ptr) { - signed char type; - size_t size; int n; + index_type kind; CFI_cdesc_t *s = *s_ptr; if (!s) return; - /* Verify descriptor. */ - switch (s->attribute) - { - case CFI_attribute_pointer: - case CFI_attribute_allocatable: - break; - case CFI_attribute_other: - if (s->base_addr) - break; - runtime_error ("Nonallocatable, nonpointer actual argument to BIND(C) " - "dummy argument where the effective argument is either " - "not allocated or not associated"); - break; - default: - runtime_error ("Invalid attribute type %d in CFI_cdesc_t descriptor", - (int) s->attribute); - break; - } GFC_DESCRIPTOR_DATA (d) = s->base_addr; + GFC_DESCRIPTOR_TYPE (d) = (signed char)(s->type & CFI_type_mask); + kind = (index_type)((s->type - (s->type & CFI_type_mask)) >> CFI_type_kind_shift); /* Correct the unfortunate difference in order with types. */ - type = (signed char)(s->type & CFI_type_mask); - switch (type) - { - case CFI_type_Character: - type = BT_CHARACTER; - break; - case CFI_type_struct: - type = BT_DERIVED; - break; - case CFI_type_cptr: - /* FIXME: PR 100915. GFC descriptors do not distinguish between - CFI_type_cptr and CFI_type_cfunptr. */ - type = BT_VOID; - break; - default: - break; - } - - GFC_DESCRIPTOR_TYPE (d) = type; - GFC_DESCRIPTOR_SIZE (d) = s->elem_len; + if (GFC_DESCRIPTOR_TYPE (d) == BT_CHARACTER) + GFC_DESCRIPTOR_TYPE (d) = BT_DERIVED; + else if (GFC_DESCRIPTOR_TYPE (d) == BT_DERIVED) + GFC_DESCRIPTOR_TYPE (d) = BT_CHARACTER; + + if (!s->rank || s->dim[0].sm == (CFI_index_t)s->elem_len) + GFC_DESCRIPTOR_SIZE (d) = s->elem_len; + else if (GFC_DESCRIPTOR_TYPE (d) != BT_DERIVED) + GFC_DESCRIPTOR_SIZE (d) = kind; + else + GFC_DESCRIPTOR_SIZE (d) = s->elem_len; d->dtype.version = 0; - - if (s->rank < 0 || s->rank > CFI_MAX_RANK) - internal_error (NULL, "Invalid rank in descriptor"); GFC_DESCRIPTOR_RANK (d) = (signed char)s->rank; d->dtype.attribute = (signed short)s->attribute; @@ -131,7 +102,6 @@ gfc_desc_to_cfi_desc (CFI_cdesc_t **d_ptr, const gfc_array_void *s) { int n; CFI_cdesc_t *d; - signed char type, kind; /* Play it safe with allocation of the flexible array member 'dim' by setting the length to CFI_MAX_RANK. This should not be necessary @@ -142,99 +112,22 @@ gfc_desc_to_cfi_desc (CFI_cdesc_t **d_ptr, const gfc_array_void *s) else d = *d_ptr; - /* Verify descriptor. */ - switch (s->dtype.attribute) - { - case CFI_attribute_pointer: - case CFI_attribute_allocatable: - break; - case CFI_attribute_other: - if (s->base_addr) - break; - runtime_error ("Nonallocatable, nonpointer actual argument to BIND(C) " - "dummy argument where the effective argument is either " - "not allocated or not associated"); - break; - default: - internal_error (NULL, "Invalid attribute in gfc_array descriptor"); - break; - } d->base_addr = GFC_DESCRIPTOR_DATA (s); d->elem_len = GFC_DESCRIPTOR_SIZE (s); - if (d->elem_len <= 0) - internal_error (NULL, "Invalid size in descriptor"); - d->version = CFI_VERSION; - d->rank = (CFI_rank_t)GFC_DESCRIPTOR_RANK (s); - if (d->rank < 0 || d->rank > CFI_MAX_RANK) - internal_error (NULL, "Invalid rank in descriptor"); - d->attribute = (CFI_attribute_t)s->dtype.attribute; - type = GFC_DESCRIPTOR_TYPE (s); - switch (type) - { - case BT_CHARACTER: - d->type = CFI_type_Character; - break; - case BT_DERIVED: - d->type = CFI_type_struct; - break; - case BT_VOID: - /* FIXME: PR 100915. GFC descriptors do not distinguish between - CFI_type_cptr and CFI_type_cfunptr. */ - d->type = CFI_type_cptr; - break; - default: - d->type = (CFI_type_t)type; - break; - } - - switch (d->type) - { - case CFI_type_Integer: - case CFI_type_Logical: - case CFI_type_Real: - kind = (signed char)d->elem_len; - break; - case CFI_type_Complex: - kind = (signed char)(d->elem_len >> 1); - break; - case CFI_type_Character: - /* FIXME: we can't distinguish between kind/len because - the GFC descriptor only encodes the elem_len.. - Until PR92482 is fixed, assume elem_len refers to the - character size and not the string length. */ - kind = (signed char)d->elem_len; - break; - case CFI_type_struct: - case CFI_type_cptr: - case CFI_type_other: - /* FIXME: PR 100915. GFC descriptors do not distinguish between - CFI_type_cptr and CFI_type_cfunptr. */ - kind = 0; - break; - default: - internal_error (NULL, "Invalid type in descriptor"); - } - - if (kind < 0) - internal_error (NULL, "Invalid kind in descriptor"); - - /* FIXME: This is PR100917. Because the GFC descriptor encodes only the - elem_len and not the kind, we get into trouble with long double kinds - that do not correspond directly to the elem_len, specifically the - kind 10 80-bit long double on x86 targets. On x86_64, this has size - 16 and cannot be differentiated from true _Float128. Prefer the - standard long double type over the GNU extension in that case. */ - if (d->type == CFI_type_Real && kind == sizeof (long double)) - d->type = CFI_type_long_double; - else if (d->type == CFI_type_Complex && kind == sizeof (long double)) - d->type = CFI_type_long_double_Complex; + if (GFC_DESCRIPTOR_TYPE (s) == BT_CHARACTER) + d->type = CFI_type_Character; + else if (GFC_DESCRIPTOR_TYPE (s) == BT_DERIVED) + d->type = CFI_type_struct; else + d->type = (CFI_type_t)GFC_DESCRIPTOR_TYPE (s); + + if (GFC_DESCRIPTOR_TYPE (s) != BT_DERIVED) d->type = (CFI_type_t)(d->type - + ((CFI_type_t)kind << CFI_type_kind_shift)); + + ((CFI_type_t)d->elem_len << CFI_type_kind_shift)); if (d->base_addr) /* Full pointer or allocatable arrays retain their lower_bounds. */