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 2ABE93858D32; Mon, 10 Jul 2023 15:48:29 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 2ABE93858D32 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.de; s=s31663417; t=1689004107; x=1689608907; i=vehre@gmx.de; bh=ue8xupnW+dizYJYT4I+IOeAzz0MZSHlQ9d9oDPuj+6o=; h=X-UI-Sender-Class:Date:From:To:Subject; b=L57Z1S8vmN8SQz7o0SaPhieTIQtTR16TWL8OyVofvpbO1nK+USE3F680lfHdgYg8O3zF+Go a0JWk1rfPbnuq7wz7VIo5lwGbJCGvu53OO4FoaXvqbBtTVILZVhc6wbqQFcK7HTGfgkZ4qR7e pOF1rEgyhirZf1jrfBBfaZFq+5x2Id9VRRYxDgO+r+yfvwBGLrW3kIy2l/S8OjIzZIgwTZf93 h8YdAgQ916kbVEkjaqGkfjCbGMo8M/PLpmM6nF68ouhsxZQlJDK0HWAkujztqOQiVO0S2JZ2j iAp2ZhB803xpACZrsHbx30FHP0T8AAxTefJsKR3eTW0z257ZfT+Q== X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Received: from vepi2 ([79.194.174.170]) by mail.gmx.net (mrgmx004 [212.227.17.190]) with ESMTPSA (Nemesis) id 1MUowV-1qRzvX3Z7x-00QjHp; Mon, 10 Jul 2023 17:48:26 +0200 Date: Mon, 10 Jul 2023 17:48:26 +0200 From: Andre Vehreschild To: GCC-Patches-ML , GCC-Fortran-ML , Paul Richard Thomas Subject: [Patch, Fortran] Allow ref'ing PDT's len() in parameter-initializer [PR102003] Message-ID: <20230710174826.48f9230c@vepi2> X-Mailer: Claws Mail 4.1.1 (GTK 3.24.38; x86_64-redhat-linux-gnu) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="MP_/+=bli7FTHokdIIQAwv2grP6" X-Provags-ID: V03:K1:LNzLst4M1qbc5oWtTJ8Y5gDyHEJ+UlsDd/oWwrur6xyUKhvD2ER owVEVaVIvLu8OrenA4KRU2rm+pR8u7f9P6EuKq7X+SoUlYahjNb1ZxOV1HoOo8GOfAoSd1K 1gKHV+cdTuTI5Rnsv0lv9lMYqLEUFoBElgRVH1gUqiaJhPcPddomNfb81Q8qLGcoq0Ulg3C NKokgtTM1kBF8US/QszmA== UI-OutboundReport: notjunk:1;M01:P0:NjgVsvfX/qA=;lmKgW6r1hsUR7WaSAU2ZB0f5VxX NeoCGMITSuOiMxcME6h0rjIOTdeDgk6OhyJhjAYNUsGfVS3SBBZzgmW33tx+sCPnQH2SscOfN /VdugDgHtxV/b1PYUciYHX6egAXpftyeMYsfMXkL7xPbPujQrwyf+icytBCX0YEq/jHhGnH/b 1Y0amakxdNQBM/ush+BOgLmAMz95hB6k4agWBW7bSpvKPYPCLL5bd1yXekVnmyQcIuf1q9uUi qI2YpZQuayvMApyYSRtJq1+w+RYSVcjiEU/MI2c8xuz9kf5n7zMEZ1nZVhzGC//4U/KXRnIDO YLnR8qsPZaYsggizDl6DqKXNbuN38fi4stHmxSnFnJkAda4gZM4ZT3VXtXqOBl5Zf2UtSamfJ +gNUWTdtYbvjHtia594lRslrUz56wbi8WBOrKXwc33vb0F0qZxzmyQYYivnchtHXB9JosKHU6 hXSWJqb3WFavP7pgbB9bEhMhW5qpJ7kMmAucfmz/wgfhvtkZzTOX2ZUBwNXI1WsBOQS++jv6j LAxWYr+nWw2y7GWcQIgA2E3PtdM0SnjxRByPyI0iulEhj6oHG1ajpxb8CZSmrin02H04hboHq mp9pvaZPM7APf4n+cxv39o7X7S1jM/W6NTLpHbJ6csXk765q3Xe2mct9hlPDP+UB78PUhFLEy GdNa4INka628TIPpBKZUnCGYwP3kIJG+PjTZiVuuO2CmFnnZajlJpDv0HkSbVmRTHEBogjLCU GXNkF2E82BCy7MKkaBhTDAb5tkbXVbA17DQemkor5yqLq9qzr7JCtyKlTR5fuhmsb436CKaE0 T87OjHRZwcLYAqjgfkzd6p4w+pjA/UPoUHNy8ciSHn73zCbmvt1FQYAWE/i/EZA98JsuVj2A0 c2rxzt4/nED1f70c7Bp8hEJ61dg/9yPsGaWj9pedp7XN7nhu6q2xgY1/R9mMt0u25fBWOJMiC rNFC1RdZ35AEPMKnWJFLtq0WADM= X-Spam-Status: No, score=-9.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_/+=bli7FTHokdIIQAwv2grP6 Content-Type: text/plain; charset=US-ASCII Content-Transfer-Encoding: quoted-printable Content-Disposition: inline Hi all, while browsing the pdt meta-bug I came across 102003 and thought to myself= : Well, that one is easy. How foolish of me... Anyway, the solution attached prevents a pdt_len (or pdt_kind) expression = in a function call (e.g. len() or kind()) to mark the whole expression as a pdt= one. The second part of the patch in simplify.cc then takes care of either gene= rating the correct component ref or when a constant expression (i.e. gfc_init_expr_flag is set) is required to look this up from the actual sym= bol (not from the type, because there the default value is stored). Regtested ok on x86_64-linux-gnu/Fedora 37. Regards, Andre =2D- Andre Vehreschild * Email: vehre ad gmx dot de --MP_/+=bli7FTHokdIIQAwv2grP6 Content-Type: text/plain Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename=pr102003.clog gcc/fortran/ChangeLog: * expr.cc (gfc_match_init_expr): Prevent PDT analysis for function calls. * simplify.cc (gfc_simplify_len): Replace len() of PDT with pdt component ref or constant. gcc/testsuite/ChangeLog: * gfortran.dg/pdt_33.f03: New test. --MP_/+=bli7FTHokdIIQAwv2grP6 Content-Type: text/x-patch Content-Transfer-Encoding: quoted-printable Content-Disposition: attachment; filename=pr102003.patch diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc index e418f1f3301..fb6eb76cda7 100644 =2D-- a/gcc/fortran/expr.cc +++ b/gcc/fortran/expr.cc @@ -3229,7 +3229,7 @@ gfc_match_init_expr (gfc_expr **result) return m; } - if (gfc_derived_parameter_expr (expr)) + if (expr->expr_type !=3D EXPR_FUNCTION && gfc_derived_parameter_expr (e= xpr)) { *result =3D expr; gfc_init_expr_flag =3D false; diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc index 81680117f70..8fb453d0a54 100644 =2D-- a/gcc/fortran/simplify.cc +++ b/gcc/fortran/simplify.cc @@ -4580,19 +4580,54 @@ gfc_simplify_len (gfc_expr *e, gfc_expr *kind) return range_check (result, "LEN"); } else if (e->expr_type =3D=3D EXPR_VARIABLE && e->ts.type =3D=3D BT_CHAR= ACTER - && e->symtree->n.sym - && e->symtree->n.sym->ts.type !=3D BT_DERIVED - && e->symtree->n.sym->assoc && e->symtree->n.sym->assoc->target - && e->symtree->n.sym->assoc->target->ts.type =3D=3D BT_DERIVED - && e->symtree->n.sym->assoc->target->symtree->n.sym - && UNLIMITED_POLY (e->symtree->n.sym->assoc->target->symtree->n.sym)) - - /* The expression in assoc->target points to a ref to the _data compo= nent - of the unlimited polymorphic entity. To get the _len component th= e last - _data ref needs to be stripped and a ref to the _len component add= ed. */ - return gfc_get_len_component (e->symtree->n.sym->assoc->target, k); - else - return NULL; + && e->symtree->n.sym) + { + if (e->symtree->n.sym->ts.type !=3D BT_DERIVED + && e->symtree->n.sym->assoc && e->symtree->n.sym->assoc->target + && e->symtree->n.sym->assoc->target->ts.type =3D=3D BT_DERIVED + && e->symtree->n.sym->assoc->target->symtree->n.sym + && UNLIMITED_POLY (e->symtree->n.sym->assoc->target->symtree + ->n.sym)) + /* The expression in assoc->target points to a ref to the _data + component of the unlimited polymorphic entity. To get the _len + component the last _data ref needs to be stripped and a ref to the + _len component added. */ + return gfc_get_len_component (e->symtree->n.sym->assoc->target, k); + else if (e->symtree->n.sym->ts.type =3D=3D BT_DERIVED + && e->ref && e->ref->type =3D=3D REF_COMPONENT + && e->ref->u.c.component->attr.pdt_string + && e->ref->u.c.component->ts.type =3D=3D BT_CHARACTER + && e->ref->u.c.component->ts.u.cl->length) + { + if (gfc_init_expr_flag) + { + /* The actual length of a pdt is in its components. In the + initializer of the current ref is only the default value. + Therefore traverse the chain of components and pick the correct + one's initializer expressions. */ + for (gfc_component *comp =3D e->symtree->n.sym->ts.u.derived + ->components; comp !=3D NULL; comp =3D comp->next) + { + if (!strcmp (comp->name, e->ref->u.c.component->ts.u.cl + ->length->symtree->name)) + return gfc_copy_expr (comp->initializer); + } + } + else + { + gfc_expr *len_expr =3D gfc_copy_expr (e); + gfc_free_ref_list (len_expr->ref); + len_expr->ref =3D NULL; + gfc_find_component (len_expr->symtree->n.sym->ts.u.derived, e->ref + ->u.c.component->ts.u.cl->length->symtree + ->name, + false, true, &len_expr->ref); + len_expr->ts =3D len_expr->ref->u.c.component->ts; + return len_expr; + } + } + } + return NULL; } diff --git a/gcc/testsuite/gfortran.dg/pdt_33.f03 b/gcc/testsuite/gfortran= .dg/pdt_33.f03 new file mode 100644 index 00000000000..c12bd9b411c =2D-- /dev/null +++ b/gcc/testsuite/gfortran.dg/pdt_33.f03 @@ -0,0 +1,18 @@ +! { dg-do run } +! +! Test the fix for PR102003, where len parameters where not returned as c= onstants. +! +! Contributed by Harald Anlauf +! +program pr102003 + type pdt(n) + integer, len :: n =3D 8 + character(len=3Dn) :: c + end type pdt + type(pdt(42)) :: p + integer, parameter :: m =3D len (p% c) + + if (m /=3D 42) stop 1 + if (len (p% c) /=3D 42) stop 2 +end + --MP_/+=bli7FTHokdIIQAwv2grP6--