From patchwork Thu Mar 23 13:41:15 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 66805 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 2F6CA387102D for ; Thu, 23 Mar 2023 13:41:38 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa3.mentor.iphmx.com (esa3.mentor.iphmx.com [68.232.137.180]) by sourceware.org (Postfix) with ESMTPS id 594E93858C31; Thu, 23 Mar 2023 13:41:21 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 594E93858C31 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.98,285,1673942400"; d="diff'?scan'208";a="116025" Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa3.mentor.iphmx.com with ESMTP; 23 Mar 2023 05:41:18 -0800 IronPort-SDR: iESkmJM3twAN2bHAn7hK+nAuR2WJ+P6qzAEZr+xkstJ2uS3XIWS2EIkmKxngEHavJ1UziHu22P NrPfJL5eXqqnOZ8DETtKhuEZwucjeDUr6V0FCtgWlK/0c8ip9012HUU1oWA2i5ZcXpA6zjbNq9 3AwkaXnCgvukYpxRmtkBp5cGDup8praD6fT2yCOD5PHTu/DIhZBfdryg5KJguTH7ULgMdfSOJa 8GgCNy89yOpYJCpMKp9aIFrkbmF0xzosoeN6vqe3rmqrZo5BZ5th0PwlaKiTLCIo4QRH0yfZYx 0Fg= Message-ID: <8611cf64-f6c0-9821-eb83-246476288bb8@codesourcery.com> Date: Thu, 23 Mar 2023 14:41:15 +0100 MIME-Version: 1.0 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:102.0) Gecko/20100101 Thunderbird/102.9.0 Content-Language: en-US To: gcc-patches , fortran From: Tobias Burnus Subject: [OG12][committed] Fortran: Add attr.class_ok check for generate_callback_wrapper X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-15.mgc.mentorg.com (139.181.222.15) To svr-ies-mbx-12.mgc.mentorg.com (139.181.222.12) X-Spam-Status: No, score=-11.3 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, KAM_SHORT, 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" On OG12, the OpenMP deep-mapping support added a callback procedure to the vtable. That one did not handle error recovery well (ICE when a CLASS component as not (class_)ok. The attached patch has been committed as https://gcc.gnu.org/g:9c18db65914a751e4a1d9330ccc1659fe5ef270d and applies only to OG12 (= git branch devel/omp/gcc-12) as mainline does not have this code (yet). * * * The plan is to upstream the deep-mapping support, i.e. mapping of allocatable components. The current OG12 implementation handles both mapping the declared type and the dynamic type, the latter requires the wrapper, generated by generate_callback_wrapper. I plan to upstream first the static part - and only then think about the wrapper. I think the wrapper could be useful for coarrays as well - namely, for the user-defined reduction, but I have not fully thought about it. It would break the ABI as the vtable gets another entry before the type-bound procedures, which is why I am a bit hesitant; it it gets merged, we it would be the opportunity to change some other things as well - like: generating the CLASS functions/vtable only when used. (→ weak symbols to permit it in multiple translation units; storing the fact that it has been generated in the module.) But that's offtopic. Tobias ----------------- 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 commit 9c18db65914a751e4a1d9330ccc1659fe5ef270d Author: Tobias Burnus Date: Thu Mar 23 14:29:00 2023 +0100 Fortran: Add attr.class_ok check for generate_callback_wrapper Proper variables/components of type BT_CLASS have 'class_ok' set; check for that to avoid an ICE on invalid code for gfortran.dg/pr108434.f90. gcc/fortran/ * class.cc (generate_callback_wrapper): Add attr.class_ok check. * resolve.cc (resolve_fl_derived): Likewise. diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp index 663102d9329..f7d1f91f178 100644 --- a/gcc/fortran/ChangeLog.omp +++ b/gcc/fortran/ChangeLog.omp @@ -1,3 +1,8 @@ +2023-03-23 Tobias Burnus + + * class.cc (generate_callback_wrapper): Add attr.class_ok check. + * resolve.cc (resolve_fl_derived): Likewise. + 2023-03-23 Tobias Burnus * trans-openmp.cc (gfc_trans_omp_clauses): Fix unmapping of diff --git a/gcc/fortran/class.cc b/gcc/fortran/class.cc index 35dc35d2ee6..7ab6923523f 100644 --- a/gcc/fortran/class.cc +++ b/gcc/fortran/class.cc @@ -2550,6 +2550,9 @@ generate_callback_wrapper (gfc_symbol *vtab, gfc_symbol *derived, cb (token, comp->var(.data), size, 0, var's cb fn); */ for (gfc_component *comp = derived->components; comp; comp = comp->next) { + if (__builtin_expect (comp->ts.type == BT_CLASS + && !comp->attr.class_ok, 0)) + continue; bool pointer = (comp->ts.type == BT_CLASS ? CLASS_DATA (comp)->attr.pointer : comp->attr.pointer); bool proc_ptr = comp->attr.proc_pointer; @@ -2590,7 +2593,7 @@ generate_callback_wrapper (gfc_symbol *vtab, gfc_symbol *derived, size->where = gfc_current_locus; } - if (!proc_ptr && comp->ts.type == BT_CLASS) + if (!proc_ptr && comp->ts.type == BT_CLASS && comp->attr.class_ok) { gfc_add_data_component (expr); if (comp->attr.dimension) diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index aaeaf396b91..15db1252366 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -15173,7 +15173,8 @@ resolve_fl_derived (gfc_symbol *sym) gfc_component *c = (sym->attr.is_class ? CLASS_DATA (sym->components) : sym->components); for ( ; c; c = c->next) - if ((c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS) + if ((c->ts.type == BT_DERIVED + || (c->ts.type == BT_CLASS && c->attr.class_ok)) && !c->ts.u.derived->resolve_symbol_called) { if (c->ts.u.derived->components == NULL