From patchwork Mon Jul 10 15:48:26 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Andre Vehreschild X-Patchwork-Id: 117955 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a59:9f45:0:b0:3ea:f831:8777 with SMTP id v5csp5116878vqx; Mon, 10 Jul 2023 08:49:16 -0700 (PDT) X-Google-Smtp-Source: APBJJlHsLac/klpMusJSFahQAhs7I/5ahN+VqXPEAvnov3kpOdF2A+3lXO9TcmBpZ/vsU4Eeu+tw X-Received: by 2002:a2e:b0c6:0:b0:2b6:fa3f:9230 with SMTP id g6-20020a2eb0c6000000b002b6fa3f9230mr9327791ljl.46.1689004156076; Mon, 10 Jul 2023 08:49:16 -0700 (PDT) ARC-Seal: i=1; a=rsa-sha256; t=1689004156; cv=none; d=google.com; s=arc-20160816; b=dZ5E1p16NBERidf31cHAZg7wvnvVWGRAsHkZxKg6e2x1al15mJdua5LVYb4FgA9BSd 9lWxPkVMvgOLJ5cIzoDiWpBLZqUZL7p1SHeusAv9BGHRRZm0SaEhicaUQVP4QGUN+G9F 0a3si0nP/BzMT6WW4zjJeGldP8aWonSh3TZNSkJDkI+rEvSxrvmLXwvbuntRbTWjtzju sRYluSUsIY9XbHpRzxDuVHLjP/7/9jRTWqB38q94zq/D9HN6MP/Lj9gDw+gzIihn2bN7 4tqvsqMxZZcSbhq3fP6dCwmNPqNFt5BgkoMnx2pAxYmFh6ymJOs+uUK1d4hk6J0USQTY WOiQ== ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=google.com; s=arc-20160816; h=sender:errors-to:reply-to:from:list-subscribe:list-help:list-post :list-archive:list-unsubscribe:list-id:precedence:ui-outboundreport :mime-version:message-id:subject:to:date:dmarc-filter:delivered-to :dkim-signature:dkim-filter; bh=J+Gt8MYSrIsPFWkU2fz9qetB4SU2RKo1qTbCdc2qXrA=; fh=tfM0hzZUnpkLMrcXhJ+Bnawvlw9b5UjZ8hMEzVdm45M=; b=bM0YIRKMb/t/3K5BgLIvwJS8k+Rj5qApYPp+f0mQ1CI8oy79+PyRQjDX7YwgqxBhts J0HBNe0Z1OfYJYCwAF1un91Yk/JRRwCpg/MGzo77JM+2b8X+Jg2TrwX39wtz01rlUgw3 uNzm1mnFHMCkBtOFzcnFxvb/2IW0EjVJwiVxT12kSKGuGM5C4tcAYKz34qBRU+kndBTA XRWl6iNDT1itFDyZYGZXcx/m4WoFfdBJrk0QIjl+ZcisBi8M9h9WZClTDO7cAbzIzoS4 WJ1bpaLorGHoWiuV9Dv2+ZtvVkYi7CNLmYw701kjtqy1xr+pgOJxS4+ooUTlfA456BbP UZ1A== ARC-Authentication-Results: i=1; mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=t2D0KCIi; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=NONE dis=NONE) header.from=gnu.org Received: from server2.sourceware.org (server2.sourceware.org. [2620:52:3:1:0:246e:9693:128c]) by mx.google.com with ESMTPS id lh19-20020a170906f8d300b009888e599645si9244480ejb.771.2023.07.10.08.49.15 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 10 Jul 2023 08:49:16 -0700 (PDT) Received-SPF: pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c as permitted sender) client-ip=2620:52:3:1:0:246e:9693:128c; Authentication-Results: mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=t2D0KCIi; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=NONE dis=NONE) header.from=gnu.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id BBDC43857714 for ; Mon, 10 Jul 2023 15:49:14 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org BBDC43857714 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1689004154; bh=J+Gt8MYSrIsPFWkU2fz9qetB4SU2RKo1qTbCdc2qXrA=; h=Date:To:Subject:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=t2D0KCIipGL/yGgaRc0clsQ5zZTKtgcDzFcRS8R1UyuOyvaQz2xQaszpLGv+WsFRk SuCPFQEZAF7aekzC9TB6GbBoJ7OwTO2cfXSE9ynkT4w96UXu/s69lPvzq3UpPlKBIO znQ3+uU75Zybsa3K2t2+5waXuKSenuRhAYzxrjhk= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org 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 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 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 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 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: Andre Vehreschild via Gcc-patches From: Andre Vehreschild Reply-To: Andre Vehreschild Errors-To: gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org Sender: "Gcc-patches" X-getmail-retrieved-from-mailbox: INBOX X-GMAIL-THRID: 1771049222105474888 X-GMAIL-MSGID: 1771049222105474888 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 generating 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 symbol (not from the type, because there the default value is stored). Regtested ok on x86_64-linux-gnu/Fedora 37. Regards, Andre --- Andre Vehreschild * Email: vehre ad gmx dot de 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. diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc index e418f1f3301..fb6eb76cda7 100644 --- 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 != EXPR_FUNCTION && gfc_derived_parameter_expr (expr)) { *result = expr; gfc_init_expr_flag = false; diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc index 81680117f70..8fb453d0a54 100644 --- 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 == EXPR_VARIABLE && e->ts.type == BT_CHARACTER - && e->symtree->n.sym - && e->symtree->n.sym->ts.type != BT_DERIVED - && e->symtree->n.sym->assoc && e->symtree->n.sym->assoc->target - && e->symtree->n.sym->assoc->target->ts.type == 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 - return NULL; + && e->symtree->n.sym) + { + if (e->symtree->n.sym->ts.type != BT_DERIVED + && e->symtree->n.sym->assoc && e->symtree->n.sym->assoc->target + && e->symtree->n.sym->assoc->target->ts.type == 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 == BT_DERIVED + && e->ref && e->ref->type == REF_COMPONENT + && e->ref->u.c.component->attr.pdt_string + && e->ref->u.c.component->ts.type == 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 = e->symtree->n.sym->ts.u.derived + ->components; comp != NULL; comp = 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 = gfc_copy_expr (e); + gfc_free_ref_list (len_expr->ref); + len_expr->ref = 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 = 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 --- /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 constants. +! +! Contributed by Harald Anlauf +! +program pr102003 + type pdt(n) + integer, len :: n = 8 + character(len=n) :: c + end type pdt + type(pdt(42)) :: p + integer, parameter :: m = len (p% c) + + if (m /= 42) stop 1 + if (len (p% c) /= 42) stop 2 +end +