From patchwork Wed Mar 27 20:42:07 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 1917012 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; dkim=pass (2048-bit key; secure) header.d=gmx.de header.i=anlauf@gmx.de header.a=rsa-sha256 header.s=s31663417 header.b=IoFsGO0o; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=server2.sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=patchwork.ozlabs.org) Received: from server2.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 ECDSA (secp384r1) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4V4ds94sjcz1yWr for ; Thu, 28 Mar 2024 07:42:37 +1100 (AEDT) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id BFBBD3858012 for ; Wed, 27 Mar 2024 20:42:35 +0000 (GMT) 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.17.22]) by sourceware.org (Postfix) with ESMTPS id B958E3858C98; Wed, 27 Mar 2024 20:42:08 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org B958E3858C98 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 B958E3858C98 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=212.227.17.22 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1711572130; cv=none; b=Ud8xsjXooA8ulGMiBXe59CCcWBYHYfdg5IFcITcfAemLtuhXr84QwG0SfO8QTxG63+sbOKI2WTuTVBDhfgP5HYZlU3pxQWC4cHi5128X+SIN3kzJJ90+gLXblIOeCCkWK7JWT5lB8ldBRil/OKEEzXo0l03Vg1gX5ZuTXZboHP8= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1711572130; c=relaxed/simple; bh=c/K8ZDvmBgU9R+szYZVtDK+zeajrLHAxF4nNXy+la/0=; h=DKIM-Signature:MIME-Version:Message-ID:From:To:Subject:Date; b=fnw1qzLZXkN9vYa5kW2JgXjglarYG/3KcfM+kvq5LZJhg/grGI5iXPy+dwPYFooQMwMyUezH+37orkLUCZB6HNoS7IdEZYL/iFEApLWL/bNKHymUgAl3V4yLs567NjV/Q1v0dFOe3uAbe63azaO8mrgzrkyFQ1j0pl+pEoxfP4w= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmx.de; s=s31663417; t=1711572127; x=1712176927; i=anlauf@gmx.de; bh=VtCdzZj1VVUKdoVe4YGIeBTK9CZoBObzvqJsYaLCqBA=; h=X-UI-Sender-Class:From:To:Subject:Date; b=IoFsGO0oMdCxxJB9QFz7Qh8gSdzV/ekCdAmf/1UwiDjKbVdRh0ZdGtohLgIGo1EI jhpAyJSb+aNNyRTEBZ9TOr+5kU9FXW03o8V9o2K/SqwfFGrNl2ZHKdm5Uh46vSyTv RmS2eUu8xskSvJVZm3BGgapPcjZkpPhNTVIqodFZaXBkWa/hLbLh8qQJme+OU7Uoa f4Z/oxo0nqxlGY97cIlC4g2S1D5wGIin7kh+wi8p91TpgS7Y1yXxnhAwQqJuFfah8 Llq9aO1xW7kjL4GwFqK6ywpa2WmfqkG3L4kN1GSgC5VkazZjDT5fZKOOczwXbmr9/ V41n2Vg3reJFVu9MqA== X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Received: from [79.232.157.59] ([79.232.157.59]) by web-mail.gmx.net (3c-app-gmx-bap43.server.lan [172.19.172.113]) (via HTTP); Wed, 27 Mar 2024 21:42:07 +0100 MIME-Version: 1.0 Message-ID: From: Harald Anlauf To: fortran , gcc-patches Subject: [PATCH] Fortran: fix DATA and derived types with pointer components [PR114474] Date: Wed, 27 Mar 2024 21:42:07 +0100 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:OeZSZ4/2EH1GekyrQFZFfCeNFDD3f2MCGu8lfRmSKZlJZMylswTWc3NwdjkxGImx7CLYH HpYILcTnNW6ezb4qJ6ZPOcRIdtN/UikUz5NveZS3J+JGT0Mnu1EKrmuUW0SQLMT4w6xidmlccjo9 dSvH35yhNJ1wFQFO14lTdkKLWLq/uxy/CuJgm+RpQktue3egIlpk3kZJyApXf8baZha1t7XWZz7N SLDY9///MDmiI1JQHbCcTd9fWnpXrVkVp+QgGCcwbhpAO01ego1RwKEmvY4Scoi47STQVd5SCRDR bs= UI-OutboundReport: notjunk:1;M01:P0:3x5kVMFEQFw=;dBi+VGxHcjTtEpEBCQJTQIiYBzg AuBEURl6oRydXcck34TEg5HCaOnyDjUa6md+uGirxCko7PmyPTX6odifCNLhKbvlYKyX3y/pV 2ODLAJAjRrA8N1Vue6ON6GZj9EWq3V0IWgFQNPi+H5G8HOg+kYyIEppr2Sgs4lNuLzK6l3Urg Ctpy1SGHA3Ur9P2VAZe7M0ZYxxjZpnUluNo5yajIdOJoo8V+MLWG5a1n6pfFQOJWxa0CAGtlT bkoPFURaP3/QM0H331+cLZJMXM6d/pXoksJWqaSVOcaBsPAmE1trh4/8dQmm0EjgV2GTaixOV ax+62uUe+xYRNX1P2XTo4tNQugxRvZQUctADvY4RbPueouzfy/9+euY1hQapmvxPCrXDKijtz lm7HHNaLeJC1P1LumunlmOCRjJR4OUTpCXM/xU2UkT4lqaPefRY1k9TxklufNra10NWoO25gl ahdp4WXcpR96ZCLNfUnqE1uuEh/4ks0T8r601dgqlD8qoO/BStJ49QOk6E9csoucr0IAYKpDC EZxLmfOaEAehPyUe8T0ZfP2ATsAoEYl5rMdRlGp20pASoIaiEjFVWUy+qotm0ayrabJ6bK8Tr u07XObH7qLwdrQaFYb3FMeHVLhgJU/nxqZ1CuEP8bVuZ1LQTb/UIV5Phjumzh3ZiTemeB44KQ h9KDxvFvzGp32iT55N1nzGMA0jEfeQ8HvBB44t/O6MB038k2oWD6R2LGG7JH4yQ= X-Spam-Status: No, score=-12.5 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, 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 X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org Dear all, the attached patch fixes a 10+ regression for cases where a derived type with a pointer component is used in a DATA statement. The failure looked obscure, see testcase comments, and pointed to a possible issue in the resolution (order). For the failing test, the target variable was seen with ts.type == BT_PROCEDURE instead of its actual type. For this reason, I restricted the fixup as much as possible. For details, please see the commit message. Testcase cross-checked with NAG. Regtested on x86_64-pc-linux-gnu. OK for mainline? If this fix survives broader testing, I would like to backport. Thanks, Harald P.S.: while trying to extend coverage of conforming code, I had much fun also with other compilers (e.g. NAG panicking...) From d5fda38243a22e1aef4367653d92521e53f2000d Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Wed, 27 Mar 2024 21:18:04 +0100 Subject: [PATCH] Fortran: fix DATA and derived types with pointer components [PR114474] When matching actual arguments in match_actual_arg, these are initially treated as a possible dummy procedure, assuming that the correct type is determined later. This resolution could fail when the procedure is a derived type constructor with a pointer component and appears in a DATA statement, where the pointer shall be associated with an initial data target. Check for those cases where the type obviously has not been resolved yet, and which were missed because there was no component reference. gcc/fortran/ChangeLog: PR fortran/114474 * primary.cc (gfc_variable_attr): Catch variables used in structure constructors within DATA statements that are still tagged with a temporary type BT_PROCEDURE from match_actual_arg and which have the target attribute, and fix their typespec. gcc/testsuite/ChangeLog: PR fortran/114474 * gfortran.dg/data_pointer_3.f90: New test. --- gcc/fortran/primary.cc | 12 +++ gcc/testsuite/gfortran.dg/data_pointer_3.f90 | 77 ++++++++++++++++++++ 2 files changed, 89 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/data_pointer_3.f90 diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc index 0ab69bb9dce..5dd6875a4a6 100644 --- a/gcc/fortran/primary.cc +++ b/gcc/fortran/primary.cc @@ -2804,6 +2804,18 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts) if (ts != NULL && expr->ts.type == BT_UNKNOWN) *ts = sym->ts; + /* Catch left-overs from match_actual_arg, where an actual argument of a + procedure is given a temporary ts.type == BT_PROCEDURE. The fixup is + needed for structure constructors in DATA statements, where a pointer + is associated with a data target, and the argument has not been fully + resolved yet. Components references are dealt with further below. */ + if (ts != NULL + && expr->ts.type == BT_PROCEDURE + && expr->ref == NULL + && attr.flavor != FL_PROCEDURE + && attr.target) + *ts = sym->ts; + has_inquiry_part = false; for (ref = expr->ref; ref; ref = ref->next) if (ref->type == REF_INQUIRY) diff --git a/gcc/testsuite/gfortran.dg/data_pointer_3.f90 b/gcc/testsuite/gfortran.dg/data_pointer_3.f90 new file mode 100644 index 00000000000..f0325cd5bcb --- /dev/null +++ b/gcc/testsuite/gfortran.dg/data_pointer_3.f90 @@ -0,0 +1,77 @@ +! { dg-do compile } +! PR fortran/114474 - DATA and derived types with pointer components + +program pr114474 + implicit none + integer, target :: ii = 42 ! initial data target + + integer, target :: jj = 24 + integer, pointer :: qq => jj + ! ii and jj resolve slightly differently when the data statement below + ! is reached, as jj is resolved outside the structure constructor first + + type t + integer, pointer :: h + end type t + + integer, target :: kk(7) = 23 + integer, pointer :: ll(:) => kk + + type t1 + integer :: m(7) + end type t1 + + type(t) :: x1, x2, x3, x4, x5 + type(t), parameter :: z1 = t(null()) + + type(t1), target :: tt = t1([1,2,3,4,5,6,7]) + type(t1), parameter :: vv = t1(22) + type(t1) :: w1, w2 + integer, pointer :: p1(:) => tt% m + + data x1 / t(null()) / + data x2 / t(ii) / ! ii is initial data target + data x3 / t(jj) / ! jj is resolved differently... + data x4 / t(tt%m(3)) / ! pointer association with 3rd element + + data w1 / t1(12) / + data w2 / t1(vv%m) / + + if ( associated (x1% h)) stop 1 + if (.not. associated (x2% h)) stop 2 + if (.not. associated (x3% h)) stop 3 + if (.not. associated (x4% h)) stop 4 + if (x2% h /= 42) stop 5 + if (x3% h /= 24) stop 6 + if (x4% h /= 3) stop 7 + + if (any (w1%m /= 12 )) stop 8 + if (any (w2%m /= vv%m)) stop 9 +end + + +subroutine sub + implicit none + + interface + real function myfun (x) + real, intent(in) :: x + end function myfun + end interface + + type u + procedure(myfun), pointer, nopass :: p + end type u + + type(u) :: u3 = u(null()) + type(u), parameter :: u4 = u(null()) + type(u) :: u1, u2 + + data u1 / u(null()) / + data u2 / u(myfun) / +end + +real function myfun (x) + real, intent(in) :: x + myfun = x +end function myfun -- 2.35.3