From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mout.gmx.net (mout.gmx.net [212.227.15.18]) by sourceware.org (Postfix) with ESMTPS id ABA683858C5F; Tue, 11 Jun 2024 12:57:04 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org ABA683858C5F Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=gmx.de Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=gmx.de ARC-Filter: OpenARC Filter v1.0.0 sourceware.org ABA683858C5F Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=212.227.15.18 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1718110628; cv=none; b=liQ2ERAvwNJGyKsFMH1RQQxDft43Yi4iOpNI2BHF2JHjgI9SsLW/wxnwvQCMn9wNHTiAaTmU8n7oKxTDeZaQOI+l8AMFqL7Fv58hAVcZnIIFnzsPN+Zc+GB3gmng/AcAjrpuV+dUmbhK8G1Dez3qfbeGpchLk7isrYBncXHbQCw= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1718110628; c=relaxed/simple; bh=JToNehC8CQ+lVjRY6tjicFFSi7hdO1ngSpuctyZbl5U=; h=DKIM-Signature:Date:From:To:Subject:Message-ID:MIME-Version; b=WZlU7VvO1O8LqxyHVK+/FfMWSFGjLy14I4RImnEjuz77Hx651jDpREO3CaDAw5cKqzERic27vARPK0tfPmGDwQoyTgbtZnRAZLfdoKpLXVPUkVY/YJT0cX4vAY3cQiHgfUoLpDZoEGPIZ8DjfqxeO6Sgng0sRvGNWiqnPgUSczs= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmx.de; s=s31663417; t=1718110623; x=1718715423; i=vehre@gmx.de; bh=Z/HC2KGLmE/FDap9oNT7lckwhvzfGJwHNhQEyqxItdo=; h=X-UI-Sender-Class:Date:From:To:Subject:Message-ID:MIME-Version: Content-Type:cc:content-transfer-encoding:content-type:date:from: message-id:mime-version:reply-to:subject:to; b=lg4ruEL2M7vlmQKcAM6P4zh6+qyEcvnP7ZqHh5SrL8VnkAf34epxOurAVs/1qfTR ShniMMr+D4l4eFBjgiGXfJQo+ntT0vDEED0BgT4DDKW6W6dtLEvZ85j/zRjiSRhnS NzgO92DgCEAFh3bPWBbfr8LFLMxg56/yhhzAQdyvFyEMyHPM2wEULmFDkbjbgsRyx a9uubr5VQKXDaMqQxH/gSyqRc8xwhz/ty4ymJ2GAbTGwSDT2Zd2pl7i9uZEwr604W zBSPo5QsTKMc238O5nsyoLX2HpvLBm7SjM2Q7IfSSW97SLDSN/4KqP63qA+/TrEIg jfmJNMz+siAcg8uYkw== X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Received: from vepi2 ([62.155.205.192]) by mail.gmx.net (mrgmx005 [212.227.17.190]) with ESMTPSA (Nemesis) id 1MZTqW-1rwenB1rJG-00KzOD; Tue, 11 Jun 2024 14:57:03 +0200 Date: Tue, 11 Jun 2024 14:49:57 +0200 From: Andre Vehreschild To: GCC-Patches-ML , GCC-Fortran-ML Subject: [Patch, Fortran] 2/3 Refactor locations where _vptr is (re)set. Message-ID: <20240611144957.36671ecc@vepi2> X-Mailer: Claws Mail 4.2.0 (GTK 3.24.41; x86_64-redhat-linux-gnu) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="MP_/NFAwkYK.d2HwJ.A5r7Laf.H" X-Provags-ID: V03:K1:bpwnsNlw/zmCm0wPwCM8iw1g76hMmmEIIKt1HG5SrQV5JbzIl9W TX777vrBW0hJr1KUl83dkjQW1ZkwHdqH+9yGnxcZCcSvV6zDfEwKpg50RvIiaRlFbWIkJ++ K2AnhMVoJo1Hux7Usx4PU7r+tFrUjIOqU8hVgtdSQoM9nySOO3CG5r64Vdcg1xtDNnpHVz8 IyG78np8XC8TtkdxxhT/w== UI-OutboundReport: notjunk:1;M01:P0:Vpml3y70Oa8=;ckwx7tDiVsSZyF6F+RVmyd+BVwm iIg2w9LCQPUEHg1FoGgvejmgIvTGOGpYJPL3y/7GNTa3jiUr7GIx51Mbbi4gBlL9U3jdJwT+6 AC0wk1t57PGx1w9QafMMiWPivEl6z990N/my+PR3Q03alZxIZDdi+ApP01IQHiCaikY00ySRO cAIrgB5b6ivIO0v0Z6BF8XvElmelAslMvcQ2xfnIi3PvDFIDz7tswdqqraYXozbOIj+Ja6f6Q 9KIwGf46EF5zbo44jXezZQNTUNqMm9y/4HFvzhLu0ytj+lbakJyrAB7B0C9ei5inAmvskr1dR j369BbNtfjkRfrsUmsGLAtItb534CIQI3rwluzLN60tdmOR+w+vT/57SiH1Wb9eZ410xT8wBU Z3bX9PIdEFfWW+uLT9Pa+E7i8RQiBuujNrgU5NO+um1UsrPa3yt6eETX4vv15i54E3EVZCpwa W/7jud3pmbBRXoepEpi5QyZjs+6Z8T+WpOQL+8UTkuESDjLFPg+LLyJO54LsF7YSNBb8ziRVv uS/yk7GOSUdCH6q3NYwdR1UpGRRmqZ9iunTxFjegVnk1k+F7KTsyYLt7d/OkdICtH/UqOAywo cC5AMTrofhDQGN66zrZ+6jT9JFdsbGUQatEuI9LmvYQ9gl3OBbj2LdWWyDuhTIWBDYsHwX/4q 07hr14pQ050PvlOq3VO330IDW47d5Qcr5khbQ7UOlUZNWpV7Pz4wKfvPKG8RMsUfsHfo4MzXz bzPJ3J+cFea7zHGAd6uNL6zRTxCy1B3UhrAmcHCtOqdrP0jAVMehT3bWrbUBKck8epoZqktp4 Y4qIZukIYq4x5Vbg+kH5OZke3s5xnmxyjts1EAlsjH+u0= X-Spam-Status: No, score=-10.2 required=5.0 tests=BAYES_00,DKIM_SIGNED,DKIM_VALID,DKIM_VALID_AU,DKIM_VALID_EF,FREEMAIL_FROM,GIT_PATCH_0,RCVD_IN_DNSWL_LOW,SPF_HELO_NONE,SPF_PASS,TXREP,T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org List-Id: --MP_/NFAwkYK.d2HwJ.A5r7Laf.H Content-Type: text/plain; charset=US-ASCII Content-Transfer-Encoding: quoted-printable Content-Disposition: inline Hi all, this patch refactors most of the locations where the _vptr of a class data= type is reset. The code was inconsistent in most of the locations. The goal of = using only one routine for setting the _vptr is to be able to later modify it mo= re easily. The ultimate goal being that every time one assigns to a class data type a consistent way is used to prevent forgetting the corner cases. So this is = just a small step in this direction. I think it is worth to simplify the code to something consistent to reduce maintenance efforts anyhow. Regtested ok on x86_64 Fedora 39. Ok for mainline? Regards, Andre =2D- Andre Vehreschild * Email: vehre ad gmx dot de --MP_/NFAwkYK.d2HwJ.A5r7Laf.H Content-Type: text/x-patch Content-Transfer-Encoding: quoted-printable Content-Disposition: attachment; filename=use_reset_vptr_consistently_1.patch =46rom f9018fa7d4dc752331e62963c9cf86ab01a1bfc5 Mon Sep 17 00:00:00 2001 From: Andre Vehreschild Date: Fri, 7 Jun 2024 08:57:36 +0200 Subject: [PATCH 2/3] Use gfc_reset_vptr more consistently. The vptr for a class type is set in various ways in different locations. Refactor the use and simplify code. gcc/fortran/ChangeLog: * trans-array.cc (structure_alloc_comps): Use reset_vptr. * trans-decl.cc (gfc_trans_deferred_vars): Same. (gfc_generate_function_code): Same. * trans-expr.cc (gfc_reset_vptr): Allow supplying the class type. (gfc_conv_procedure_call): Use reset_vptr. * trans-intrinsic.cc (gfc_conv_intrinsic_transfer): Same. =2D-- gcc/fortran/trans-array.cc | 34 ++++---------------- gcc/fortran/trans-decl.cc | 19 ++---------- gcc/fortran/trans-expr.cc | 57 +++++++++++++++++----------------- gcc/fortran/trans-intrinsic.cc | 10 +----- 4 files changed, 38 insertions(+), 82 deletions(-) diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index cc50b961a97..b3088a892c8 100644 =2D-- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -9864,15 +9864,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree = decl, tree dest, else { /* Build the vtable address and set the vptr with it. */ - tree vtab; - gfc_symbol *vtable; - vtable =3D gfc_find_derived_vtab (c->ts.u.derived); - vtab =3D vtable->backend_decl; - if (vtab =3D=3D NULL_TREE) - vtab =3D gfc_get_symbol_decl (vtable); - vtab =3D gfc_build_addr_expr (NULL, vtab); - vtab =3D fold_convert (TREE_TYPE (tmp), vtab); - gfc_add_modify (&tmpblock, tmp, vtab); + gfc_reset_vptr (&tmpblock, nullptr, tmp, c->ts.u.derived); } } @@ -9903,15 +9895,13 @@ structure_alloc_comps (gfc_symbol * der_type, tree= decl, tree dest, && (CLASS_DATA (c)->attr.allocatable || CLASS_DATA (c)->attr.class_pointer)) { - tree vptr_decl; + tree class_ref; /* Allocatable CLASS components. */ - comp =3D fold_build3_loc (input_location, COMPONENT_REF, ctype, - decl, cdecl, NULL_TREE); - - vptr_decl =3D gfc_class_vptr_get (comp); + class_ref =3D fold_build3_loc (input_location, COMPONENT_REF, ctyp= e, + decl, cdecl, NULL_TREE); - comp =3D gfc_class_data_get (comp); + comp =3D gfc_class_data_get (class_ref); if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (comp))) gfc_conv_descriptor_data_set (&fnblock, comp, null_pointer_node); @@ -9926,19 +9916,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree = decl, tree dest, /* The dynamic type of a disassociated pointer or unallocated allocatable variable is its declared type. An unlimited polymorphic entity has no declared type. */ - if (!UNLIMITED_POLY (c)) - { - vtab =3D gfc_find_derived_vtab (c->ts.u.derived); - if (!vtab->backend_decl) - gfc_get_symbol_decl (vtab); - tmp =3D gfc_build_addr_expr (NULL_TREE, vtab->backend_decl); - } - else - tmp =3D build_int_cst (TREE_TYPE (vptr_decl), 0); - - tmp =3D fold_build2_loc (input_location, MODIFY_EXPR, - void_type_node, vptr_decl, tmp); - gfc_add_expr_to_block (&fnblock, tmp); + gfc_reset_vptr (&fnblock, nullptr, class_ref, c->ts.u.derived); cmp_has_alloc_comps =3D false; } diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index 88538713a02..1786f80245f 100644 =2D-- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -5070,26 +5070,11 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gf= c_wrapped_block * block) if (sym->ts.type =3D=3D BT_CLASS) { /* Initialize _vptr to declared type. */ - gfc_symbol *vtab; - tree rhs; - gfc_save_backend_locus (&loc); gfc_set_backend_locus (&sym->declared_at); e =3D gfc_lval_expr_from_sym (sym); - gfc_add_vptr_component (e); - gfc_init_se (&se, NULL); - se.want_pointer =3D 1; - gfc_conv_expr (&se, e); + gfc_reset_vptr (&init, e); gfc_free_expr (e); - if (UNLIMITED_POLY (sym)) - rhs =3D build_int_cst (TREE_TYPE (se.expr), 0); - else - { - vtab =3D gfc_find_derived_vtab (sym->ts.u.derived); - rhs =3D gfc_build_addr_expr (TREE_TYPE (se.expr), - gfc_get_symbol_decl (vtab)); - } - gfc_add_modify (&init, se.expr, rhs); gfc_restore_backend_locus (&loc); } @@ -7931,7 +7916,7 @@ gfc_generate_function_code (gfc_namespace * ns) fold_convert (TREE_TYPE (tmp), null_pointer_node)); gfc_reset_vptr (&init, nullptr, result, - CLASS_DATA (sym->result)->ts.u.derived); + sym->result->ts.u.derived); } else if (sym->ts.type =3D=3D BT_DERIVED && !sym->attr.allocatable) diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 558a7380516..454b87581f5 100644 =2D-- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -532,12 +532,12 @@ gfc_find_and_cut_at_last_class_ref (gfc_expr *e, boo= l is_mold, /* Reset the vptr to the declared type, e.g. after deallocation. Use the variable in CLASS_CONTAINER if available. Otherwise, recreate - one with e or derived. At least one of the two has to be set. The ge= nerated - assignment code is added at the end of BLOCK. */ + one with e or class_type. At least one of the two has to be set. The + generated assignment code is added at the end of BLOCK. */ void gfc_reset_vptr (stmtblock_t *block, gfc_expr *e, tree class_container, - gfc_symbol *derived) + gfc_symbol *class_type) { tree vptr =3D NULL_TREE; @@ -564,15 +564,31 @@ gfc_reset_vptr (stmtblock_t *block, gfc_expr *e, tre= e class_container, if (vptr =3D=3D NULL_TREE) return; - if (UNLIMITED_POLY (e)) + if (UNLIMITED_POLY (e) + || UNLIMITED_POLY (class_type) + /* When the class_type's source is not a symbol (e.g. a component's= ts), + then look at the _data-components type. */ + || (class_type !=3D NULL && class_type->ts.type =3D=3D BT_UNKNOWN + && class_type->components && class_type->components->ts.u.derived + && class_type->components->ts.u.derived->attr.unlimited_polymorphic)) gfc_add_modify (block, vptr, build_int_cst (TREE_TYPE (vptr), 0)); else { - gfc_symbol *vtab; + gfc_symbol *vtab, *type =3D nullptr; tree vtable; + if (e) + type =3D e->ts.u.derived; + else if (class_type) + { + if (class_type->ts.type =3D=3D BT_CLASS) + type =3D CLASS_DATA (class_type)->ts.u.derived; + else + type =3D class_type; + } + gcc_assert (type); /* Return the vptr to the address of the declared type. */ - vtab =3D gfc_find_derived_vtab (derived ? derived : e->ts.u.derived= ); + vtab =3D gfc_find_derived_vtab (type); vtable =3D vtab->backend_decl; if (vtable =3D=3D NULL_TREE) vtable =3D gfc_get_symbol_decl (vtab); @@ -6872,29 +6888,14 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol *= sym, NULL_TREE, true, e, e->ts, cls); gfc_add_expr_to_block (&block, tmp); - tmp =3D fold_build2_loc (input_location, MODIFY_EXPR, - void_type_node, ptr, - null_pointer_node); - gfc_add_expr_to_block (&block, tmp); + gfc_add_modify (&block, ptr, + fold_convert (TREE_TYPE (ptr), + null_pointer_node)); - if (fsym->ts.type =3D=3D BT_CLASS && UNLIMITED_POLY (fsym)) - { - gfc_add_modify (&block, ptr, - fold_convert (TREE_TYPE (ptr), - null_pointer_node)); - gfc_add_expr_to_block (&block, tmp); - } - else if (fsym->ts.type =3D=3D BT_CLASS) - { - gfc_symbol *vtab; - vtab =3D gfc_find_derived_vtab (fsym->ts.u.derived); - tmp =3D gfc_get_symbol_decl (vtab); - tmp =3D gfc_build_addr_expr (NULL_TREE, tmp); - ptr =3D gfc_class_vptr_get (parmse.expr); - gfc_add_modify (&block, ptr, - fold_convert (TREE_TYPE (ptr), tmp)); - gfc_add_expr_to_block (&block, tmp); - } + if (fsym->ts.type =3D=3D BT_CLASS) + gfc_reset_vptr (&block, nullptr, + build_fold_indirect_ref (parmse.expr), + fsym->ts.u.derived); if (fsym->attr.optional && e->expr_type =3D=3D EXPR_VARIABLE diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.= cc index 96839705112..ac7fcd250d3 100644 =2D-- a/gcc/fortran/trans-intrinsic.cc +++ b/gcc/fortran/trans-intrinsic.cc @@ -8815,15 +8815,7 @@ scalar_transfer: /* For CLASS results, set the _vptr. */ if (mold_expr->ts.type =3D=3D BT_CLASS) - { - tree vptr; - gfc_symbol *vtab; - vptr =3D gfc_class_vptr_get (tmpdecl); - vtab =3D gfc_find_derived_vtab (source_expr->ts.u.derived); - gcc_assert (vtab); - tmp =3D gfc_build_addr_expr (NULL_TREE, gfc_get_symbol_decl (vtab)); - gfc_add_modify (&se->pre, vptr, fold_convert (TREE_TYPE (vptr), tmp)); - } + gfc_reset_vptr (&se->pre, nullptr, tmpdecl, source_expr->ts.u.derived); se->expr =3D tmpdecl; } =2D- 2.45.1 --MP_/NFAwkYK.d2HwJ.A5r7Laf.H--