From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mout.gmx.net (mout.gmx.net [212.227.17.22]) by sourceware.org (Postfix) with ESMTPS id 6CB9D3858CDA; Sun, 25 Sep 2022 21:04:38 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 6CB9D3858CDA Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=gmx.de Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=gmx.de DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=gmx.net; s=badeba3b8450; t=1664139876; bh=SryvbPuDoLRdWXdDFAyE4h9cc5S30wrSEn9u1lbClz4=; h=X-UI-Sender-Class:From:To:Subject:Date; b=Erdm34el3vqtDwijWDymkWFl90Fniq+4d7cxW/7qFlZ+Ofe7JXDkzpgl6I9bCM7F9 iULNCBZJa0FhRO2D8sG0Z4l9s005yoEqyq9uoi2nqwo2+6uBlKT9T2sm1rk67i8nQz rc6v9A246E21fc72XSgwKa5pyv3di/MX8H7LmqzM= X-UI-Sender-Class: 01bb95c1-4bf8-414a-932a-4f6e2808ef9c Received: from [79.251.15.147] ([79.251.15.147]) by web-mail.gmx.net (3c-app-gmx-bap15.server.lan [172.19.172.85]) (via HTTP); Sun, 25 Sep 2022 23:04:36 +0200 MIME-Version: 1.0 Message-ID: From: Harald Anlauf To: fortran , gcc-patches Subject: Proxy ping [PATCH] Fortran: Fix ICE and wrong code for assumed-rank arrays [PR100029, PR100040] Content-Type: multipart/mixed; boundary=kenitram-e4800547-ff9d-48eb-a856-80ff6d909b76 Date: Sun, 25 Sep 2022 23:04:36 +0200 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:LngXsKwfop5yCd0DpV81mFygjF0fN6HklECJ/MxRaUNW+pWzlUJxgTp5+/g4ZvhApkHq4 l/1VrWmaIxgnp3r3JmPWT4BZaXwZmisruueYcRXgTfwYaMK8CHDlZDR6702Sqnju1u92UD7IP/Fu W+g65wKs+0qv6aihlIwLXRzv/xSCDUoK4xsCshBYVAzdODnCVM42qEpZr/GlhDXeUXSHdBbBGCu2 NJF50OCA8fGN2eyAwNPmTIT72F0ex9Kh1MaDdCriikMzavOgD4U3RenDdQoiU8HpGWt90FofJOJA FU= X-UI-Out-Filterresults: notjunk:1;V03:K0:lJDyRhNZLbM=:mGc+46xBr+WZtP83cgTdtr 8vqzPLGQ3y1MwDPnSBLJ9yhe1TyfCLEIHTmHG+nJHsszVyoc7iLEDnfuKjbxW3oULS5zHJwr4 FiCYgzkHYgwwhkZH5yxmsM9XrjpiHKAvu+Z2KzcGoPS8dERvttF1zyScGrD2UBMf3VZomta3W gzfh1mvWZG8RAMpmt4ftOmq6M6QXPmuKm6ptXDuC7DcwtizuJxnus7gMGJuW+MUMhMijAeyBY obF3b48w2ZptEzCzD0DOeIpO4DWfdN0nhaNeF1FgiyqWnW/uYuO8yLUyhZhKwo3yfqYIlQoMF S0jBz1niNOLTj6AxIbnevJws0WXFBl+59V1U4VGYNj4YUuVjNXPvOn3gmTw+wMqIRbIX6Ln6m 9HZpcxeP//c4YLYN6ZwPDyAlVBOUmrO6whpkCSKYsBLuaU0CoFi5nNTEpZwVp+1iyR5CYhyIF gHO/0FN82kCZDiqo+k5bhko186XjjXLGecAF+GfctcSwSaCao3X6Nk9Jbxt3SLDsLskfAWBa2 GL2wGMMcPXWNFE0nEYRkhfbrE2djqYPHy4S0zLy6+dKUZwoNVLu6cIRc3AaSiUMSJwXlfjGyO wYssm8ojZ+AgmEBQWSTYT7v9c6eZckaAGYPBvWY0Ffu3Ic3BXVC3SwmdOc8pgZFYnfZvpEpyW 3ohmGmlbTneuFKpkxJTm2gfdZDFtsmJOdMWhIN2oQhGQzvLewBe8EsajHiiHnpVkBfGwzPr2i pZrc5xPNwNnCFhzd2gz5sonZDksyClg2u6LEEDS1t+gUpl1ILH/T1oF5msI5D+AgmevlT6bsV 5jcj20q X-Spam-Status: No, score=-12.4 required=5.0 tests=BAYES_00,DKIM_SIGNED,DKIM_VALID,FREEMAIL_FROM,GIT_PATCH_0,KAM_SHORT,RCVD_IN_DNSWL_LOW,RCVD_IN_MSPIKE_H2,SPF_HELO_NONE,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 List-Id: --kenitram-e4800547-ff9d-48eb-a856-80ff6d909b76 Content-Type: text/plain; charset=UTF-8 Dear all, the patch for these PRs was submitted for review by Jose here: https://gcc.gnu.org/pipermail/fortran/2021-April/055924.html but unfortunately was never reviewed. I verified that the rebased patch still works on mainline and x86_64-pc-linux-gnu, and I think that it is fine. It is also very simple and clear, but I repost it here to give others a chance to provide comments. The commit message needed a small correction to make it acceptable to "git gcc-verify", but besides some whitespace-like changes and clarifications this is Jose's patch. OK for mainline? Thanks, Harald --kenitram-e4800547-ff9d-48eb-a856-80ff6d909b76 Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Fortran-Fix-ICE-and-wrong-code-for-assumed-rank-arra.patch Content-Transfer-Encoding: quoted-printable =46rom b3279399bbdd04f48eab82dcc3f2b2aba5a9b0a3 Mon Sep 17 00:00:00 2001 From: =3D?UTF-8?q?Jos=3DC3=3DA9=3D20Rui=3D20Faustino=3D20de=3D20Sousa?=3D Date: Sun, 25 Sep 2022 22:48:55 +0200 Subject: [PATCH] Fortran: Fix ICE and wrong code for assumed-rank arrays [PR100029, PR100040] gcc/fortran/ChangeLog: PR fortran/100040 PR fortran/100029 * trans-expr.cc (gfc_conv_class_to_class): Add code to have assumed-rank arrays recognized as full arrays and fix the type of the array assignment. (gfc_conv_procedure_call): Change order of code blocks such that the free of ALLOCATABLE dummy arguments with INTENT(OUT) occurs first. gcc/testsuite/ChangeLog: PR fortran/100029 * gfortran.dg/PR100029.f90: New test. PR fortran/100040 * gfortran.dg/PR100040.f90: New test. =2D-- gcc/fortran/trans-expr.cc | 48 +++++++++++++++----------- gcc/testsuite/gfortran.dg/PR100029.f90 | 22 ++++++++++++ gcc/testsuite/gfortran.dg/PR100040.f90 | 36 +++++++++++++++++++ 3 files changed, 85 insertions(+), 21 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/PR100029.f90 create mode 100644 gcc/testsuite/gfortran.dg/PR100040.f90 diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 4f3ae82d39c..1551a2e4df4 100644 =2D-- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -1178,8 +1178,10 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *= e, gfc_typespec class_ts, return; /* Test for FULL_ARRAY. */ - if (e->rank =3D=3D 0 && gfc_expr_attr (e).codimension - && gfc_expr_attr (e).dimension) + if (e->rank =3D=3D 0 + && ((gfc_expr_attr (e).codimension && gfc_expr_attr (e).dimension) + || (class_ts.u.derived->components->as + && class_ts.u.derived->components->as->type =3D=3D AS_ASSUMED_RANK= ))) full_array =3D true; else gfc_is_class_array_ref (e, &full_array); @@ -1227,8 +1229,12 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *= e, gfc_typespec class_ts, && e->rank !=3D class_ts.u.derived->components->as->rank) { if (e->rank =3D=3D 0) - gfc_add_modify (&parmse->post, gfc_class_data_get (parmse->expr), - gfc_conv_descriptor_data_get (ctree)); + { + tmp =3D gfc_class_data_get (parmse->expr); + gfc_add_modify (&parmse->post, tmp, + fold_convert (TREE_TYPE (tmp), + gfc_conv_descriptor_data_get (ctree))); + } else class_array_data_assign (&parmse->post, parmse->expr, ctree, true); } @@ -6560,23 +6566,6 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * = sym, base_object =3D build_fold_indirect_ref_loc (input_location, parmse.expr); - /* A class array element needs converting back to be a - class object, if the formal argument is a class object. */ - if (fsym && fsym->ts.type =3D=3D BT_CLASS - && e->ts.type =3D=3D BT_CLASS - && ((CLASS_DATA (fsym)->as - && CLASS_DATA (fsym)->as->type =3D=3D AS_ASSUMED_RANK) - || CLASS_DATA (e)->attr.dimension)) - gfc_conv_class_to_class (&parmse, e, fsym->ts, false, - fsym->attr.intent !=3D INTENT_IN - && (CLASS_DATA (fsym)->attr.class_pointer - || CLASS_DATA (fsym)->attr.allocatable), - fsym->attr.optional - && e->expr_type =3D=3D EXPR_VARIABLE - && e->symtree->n.sym->attr.optional, - CLASS_DATA (fsym)->attr.class_pointer - || CLASS_DATA (fsym)->attr.allocatable); - /* If an ALLOCATABLE dummy argument has INTENT(OUT) and is allocated on entry, it must be deallocated. */ if (fsym && fsym->attr.intent =3D=3D INTENT_OUT @@ -6637,6 +6626,23 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * = sym, gfc_add_expr_to_block (&se->pre, tmp); } + /* A class array element needs converting back to be a + class object, if the formal argument is a class object. */ + if (fsym && fsym->ts.type =3D=3D BT_CLASS + && e->ts.type =3D=3D BT_CLASS + && ((CLASS_DATA (fsym)->as + && CLASS_DATA (fsym)->as->type =3D=3D AS_ASSUMED_RANK) + || CLASS_DATA (e)->attr.dimension)) + gfc_conv_class_to_class (&parmse, e, fsym->ts, false, + fsym->attr.intent !=3D INTENT_IN + && (CLASS_DATA (fsym)->attr.class_pointer + || CLASS_DATA (fsym)->attr.allocatable), + fsym->attr.optional + && e->expr_type =3D=3D EXPR_VARIABLE + && e->symtree->n.sym->attr.optional, + CLASS_DATA (fsym)->attr.class_pointer + || CLASS_DATA (fsym)->attr.allocatable); + if (fsym && (fsym->ts.type =3D=3D BT_DERIVED || fsym->ts.type =3D=3D BT_ASSUMED) && e->ts.type =3D=3D BT_CLASS diff --git a/gcc/testsuite/gfortran.dg/PR100029.f90 b/gcc/testsuite/gfortr= an.dg/PR100029.f90 new file mode 100644 index 00000000000..fd7e4c46032 =2D-- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR100029.f90 @@ -0,0 +1,22 @@ +! { dg-do run } +! +! Test the fix for PR100029 +! + +program foo_p + implicit none + + type :: foo_t + end type foo_t + + class(foo_t), allocatable :: pout + + call foo_s(pout) + +contains + + subroutine foo_s(that) + class(foo_t), allocatable, intent(out) :: that(..) + end subroutine foo_s + +end program foo_p diff --git a/gcc/testsuite/gfortran.dg/PR100040.f90 b/gcc/testsuite/gfortr= an.dg/PR100040.f90 new file mode 100644 index 00000000000..0a135ff30a3 =2D-- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR100040.f90 @@ -0,0 +1,36 @@ +! { dg-do run } +! +! Test the fix for PR100040 +! + +program foo_p + implicit none + + integer, parameter :: n =3D 11 + + type :: foo_t + integer :: i + end type foo_t + + type(foo_t), parameter :: a =3D foo_t(n) + + class(foo_t), allocatable :: pout + + call foo_s(pout) + if(.not.allocated(pout)) stop 1 + if(pout%i/=3Dn) stop 2 + +contains + + subroutine foo_s(that) + class(foo_t), allocatable, intent(out) :: that(..) + + select rank(that) + rank(0) + that =3D a + rank default + stop 3 + end select + end subroutine foo_s + +end program foo_p =2D- 2.35.3 --kenitram-e4800547-ff9d-48eb-a856-80ff6d909b76--