From patchwork Thu May 6 06:57:05 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Paul Richard Thomas X-Patchwork-Id: 1474824 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=2620:52:3:1:0:246e:9693:128c; helo=sourceware.org; envelope-from=gcc-patches-bounces@gcc.gnu.org; receiver=) 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=JJnCuLjo; dkim-atps=neutral Received: from sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (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 4FbPXX32qRz9sT6 for ; Thu, 6 May 2021 16:57:30 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id C73253938398; Thu, 6 May 2021 06:57:21 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org C73253938398 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1620284241; bh=NL43+ohLaiyp4fLZ+VjPT1U/DsN3hzuIkI4EnffrrAM=; h=Date:Subject:To:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=JJnCuLjoy2oMBQ1Crx4B+DrerQwvkcByMgTT4xE43cllPqnZIyAFq+vreVvDNzG4U 82D1soIb3qmUfaY9EB++9DE6efl31LzooteXjYNn8WW2+OIq5fwm43Yg6mxspEw+9A THOSRELawB+YlLOS4jSk/iftJ1ZMUSUBx0BVzzLI= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-lf1-x133.google.com (mail-lf1-x133.google.com [IPv6:2a00:1450:4864:20::133]) by sourceware.org (Postfix) with ESMTPS id 921353860C3B; Thu, 6 May 2021 06:57:18 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 921353860C3B Received: by mail-lf1-x133.google.com with SMTP id z13so6304472lft.1; Wed, 05 May 2021 23:57:18 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:mime-version:from:date:message-id:subject:to; bh=V/sY3GahOfMsb4Y4erxMmdbhJIgfMF+vKlgbatnqPjI=; b=FnqKzwST46rd4aSrTI8z00D6T/kQT/lTwoSGPpThiblCKkpnGsn8/d33iNEPui8zCO x5PWAE9xdic1a3e/PX/tQKxu2isT5+wuoVtnoZkNyk0ehJlePA85RhHhu2oHNEMtO2tL PYpQklbMCEFLf5l0SvfJHEQhMy+w54m2hKKItvTp33GHb4/fm3+SZmwDo0DZB8/cbBJq WgMvSFp9enz5my0BUb5u+dNIUFpGRutejYDfvGFDyKc80K6T4ywg4QUYGaMCz5dRNz6p b7hPBpFG51DimZHtEOIrg+e795JbEhoq8gAqKn8pTyObtLv03rjU3HaFAayJXPHhagD/ kDhg== X-Gm-Message-State: AOAM533Cus/JsJ+dLiQ/86GSLoWPEvvvLrz3H7QcHY9kSGcBx0v7Ab9b b6rK/Qj2I9fWNL7XHWFgxDyFHk4qFg1jJ+IT9o+8RsnspAA= X-Google-Smtp-Source: ABdhPJzsowXKRN0Gy/KFOoRkeY58mzU5h+Ygz51LD9fl/LXkdfdr0nIQhuFk/3jolIayoSl6iog3wRJy0pLWAOhcL+k= X-Received: by 2002:a05:6512:70a:: with SMTP id b10mr1956001lfs.44.1620284236587; Wed, 05 May 2021 23:57:16 -0700 (PDT) MIME-Version: 1.0 Date: Thu, 6 May 2021 07:57:05 +0100 Message-ID: Subject: [Patch, fortran] PRs 46691 and 99819: Assumed and explicit size class arrays To: "fortran@gcc.gnu.org" , gcc-patches X-Spam-Status: No, score=-7.9 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_FROM, GIT_PATCH_0, HTML_MESSAGE, RCVD_IN_DNSWL_NONE, 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-Content-Filtered-By: Mailman/MimeDel 2.1.29 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: Paul Richard Thomas via Gcc-patches From: Paul Richard Thomas Reply-To: Paul Richard Thomas Errors-To: gcc-patches-bounces@gcc.gnu.org Sender: "Gcc-patches" Hi All, Although I had undertaken to concentrate on PDTs, PR99819 so intrigued me that I became locked into it :-( After extensive, fruitless rummaging through decl.c and trans-decl.c, I realised that the problem was far simpler than it seemed and that it lay in class.c. After that PR was fixed, PR46691 was a trivial follow up. The comments in the patch explain the fixes. I left a TODO for the extent checking of assumed size class arrays. I will try to fix it before pushing. Regtested on FC33/x86_64 and checked against the 'other brand'. OK for 12-branch and, perhaps, 11-branch? Regards Paul Fortran: Assumed and explicit size class arrays [PR46691/99819]. 2021-05-06 Paul Thomas gcc/fortran/ChangeLog PR fortran/46691 PR fortran/99819 * class.c (gfc_build_class_symbol): Class array types that are not deferred shape or assumed rank are given a unique name and placed in the procedure namespace. * trans-array.c (gfc_trans_g77_array): Obtain the data pointer for class arrays. (gfc_trans_dummy_array_bias): Suppress the runtime error for extent violations in explicit shape class arrays because it always fails. * trans-expr.c (gfc_conv_procedure_call): Handle assumed size class actual arguments passed to non-descriptor formal args by using the data pointer, stored as the symbol's backend decl. gcc/testsuite/ChangeLog PR fortran/46691 PR fortran/99819 * gfortran.dg/class_dummy_6.f90: New test. * gfortran.dg/class_dummy_6.f90: New test. diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index 89353218417..93118ad3455 100644 --- a/gcc/fortran/class.c +++ b/gcc/fortran/class.c @@ -630,6 +630,7 @@ gfc_get_len_component (gfc_expr *e, int k) component '_vptr' which determines the dynamic type. When this CLASS entity is unlimited polymorphic, then also add a component '_len' to store the length of string when that is stored in it. */ +static int ctr = 0; bool gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr, @@ -645,13 +646,6 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr, gcc_assert (as); - if (*as && (*as)->type == AS_ASSUMED_SIZE) - { - gfc_error ("Assumed size polymorphic objects or components, such " - "as that at %C, have not yet been implemented"); - return false; - } - if (attr->class_ok) /* Class container has already been built. */ return true; @@ -693,7 +687,30 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr, else ns = ts->u.derived->ns; - gfc_find_symbol (name, ns, 0, &fclass); + /* Although this might seem to be counterintuitive, we can build separate + class types with different array specs because the TKR interface checks + work on the declared type. All array type other than deferred shape or + assumed rank are added to the function namespace to ensure that they + are properly distinguished. */ + if (attr->dummy && !attr->codimension && (*as) + && !((*as)->type == AS_DEFERRED || (*as)->type == AS_ASSUMED_RANK)) + { + char *sname; + ns = gfc_current_ns; + gfc_find_symbol (name, ns, 0, &fclass); + /* If a local class type with this name already exists, update the + name with an index. */ + if (fclass) + { + fclass = NULL; + sname = xasprintf ("%s_%d", name, ++ctr); + free (name); + name = sname; + } + } + else + gfc_find_symbol (name, ns, 0, &fclass); + if (fclass == NULL) { gfc_symtree *st; diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index e99980fd223..6d38ea78273 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -6524,7 +6524,14 @@ gfc_trans_g77_array (gfc_symbol * sym, gfc_wrapped_block * block) /* Set the pointer itself if we aren't using the parameter directly. */ if (TREE_CODE (parm) != PARM_DECL) { - tmp = convert (TREE_TYPE (parm), GFC_DECL_SAVED_DESCRIPTOR (parm)); + tmp = GFC_DECL_SAVED_DESCRIPTOR (parm); + if (sym->ts.type == BT_CLASS) + { + tmp = build_fold_indirect_ref_loc (input_location, tmp); + tmp = gfc_class_data_get (tmp); + tmp = gfc_conv_descriptor_data_get (tmp); + } + tmp = convert (TREE_TYPE (parm), tmp); gfc_add_modify (&init, parm, tmp); } stmt = gfc_finish_block (&init); @@ -6626,7 +6633,8 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, && VAR_P (sym->ts.u.cl->backend_decl)) gfc_conv_string_length (sym->ts.u.cl, NULL, &init); - checkparm = (as->type == AS_EXPLICIT + /* TODO: Fix the exclusion of class arrays from extent checking. */ + checkparm = (as->type == AS_EXPLICIT && !is_classarray && (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)); no_repack = !(GFC_DECL_PACKED_ARRAY (tmpdesc) diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 213f32b0a67..5f5479561c2 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -6420,6 +6420,15 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, fsym ? fsym->attr.intent : INTENT_INOUT, fsym && fsym->attr.pointer); + else if (e->ts.type == BT_CLASS && CLASS_DATA (e)->as + && CLASS_DATA (e)->as->type == AS_ASSUMED_SIZE + && nodesc_arg && fsym->ts.type == BT_DERIVED) + /* An assumed size class actual argument being passed to + a 'no descriptor' formal argument just requires the + data pointer to be passed. For class dummy arguments + this is stored in the symbol backend decl.. */ + parmse.expr = e->symtree->n.sym->backend_decl; + else if (gfc_is_class_array_ref (e, NULL) && fsym && fsym->ts.type == BT_DERIVED) /* The actual argument is a component reference to an