From patchwork Thu Mar 28 15:39:30 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Paul Richard Thomas X-Patchwork-Id: 1917388 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; dkim=fail reason="signature verification failed" (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.a=rsa-sha256 header.s=20230601 header.b=m9IgC3ev; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; 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 [8.43.85.97]) (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 4V576L4kZyz1yYR for ; Fri, 29 Mar 2024 02:40:42 +1100 (AEDT) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id D5CA13860C37 for ; Thu, 28 Mar 2024 15:40:40 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-pj1-x1035.google.com (mail-pj1-x1035.google.com [IPv6:2607:f8b0:4864:20::1035]) by sourceware.org (Postfix) with ESMTPS id 99A75386183D; Thu, 28 Mar 2024 15:39:42 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 99A75386183D Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=gmail.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 99A75386183D Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2607:f8b0:4864:20::1035 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1711640385; cv=none; b=ufmQ+8s3uweD2TQvVGWj19VykREIu0oUZjC+FwsJRmLlHIU6dsqwRFGxV0bdXCiX0OGGnDKGtt1cz+xJhUq4YJT143HWEhYBOR5fiYuUG8JMofzGlLInqP5pEKc5HyBkxR1bjicw75+3l+Ps9ZYm7oZFtCPiWH99+xBCdR3H1Y4= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1711640385; c=relaxed/simple; bh=Xi6f5W/NwLrkYkf5Fug2R9DUDQTWyEv409nMBAutWU8=; h=DKIM-Signature:MIME-Version:From:Date:Message-ID:Subject:To; b=AnKRdScT0Y5QfncbXTYhv7mFA4sF2CNq+s3QQr9YfQa7iZkkzAbmg1Es3JwSR2RqtEvFPfJ4Ocyjvcumxc/Z/sbNgSwJ2G21O6cXEhlxbkqgaBbpUcRE8gV2aSD76Cd+VzxEplbVZRRcAgqihAmasK5wtbthMpfdnOM3hC/i82Y= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-pj1-x1035.google.com with SMTP id 98e67ed59e1d1-29ddfd859eeso966592a91.1; Thu, 28 Mar 2024 08:39:42 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20230601; t=1711640381; x=1712245181; darn=gcc.gnu.org; h=cc:to:subject:message-id:date:from:mime-version:from:to:cc:subject :date:message-id:reply-to; bh=a4CB4qJdHLJ8awE7W2d1QcLHBlz62jxKORfqioTohNg=; b=m9IgC3evxOLhvati+WiWUj6XMH64twd/S6IM/GGhuZ/vCE471WJUwR9JB/LsTVoMmv R72z7QEAOYvyzCQ08CabGlFQoYuDtwLl2D12kp0+k8epwvH8HOlYe166BNlb8tueIlXf HXbc9OI26G/XCQIXqUAW6oFrm8ivvimAbJWDpO3wM2MXbDOX4v3QB4RLixfyJjS2O0zo KwVVlIO7o5oaV1zMKYBDCCksa8HpOaMM9BERX7EdGUZaAeWkb7SuLdr+8dFoTC3DMQ+Q ERRR17wc0Xe5pWDoYQd4TkOq3NNadwWavVD1s2QiurBYOvC/hGBVoIxYAvKnmxRLHqhR /6rw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1711640381; x=1712245181; h=cc:to:subject:message-id:date:from:mime-version:x-gm-message-state :from:to:cc:subject:date:message-id:reply-to; bh=a4CB4qJdHLJ8awE7W2d1QcLHBlz62jxKORfqioTohNg=; b=S34HstjUKOIIbRqP11Jhyn4Lzpn3MucOyYeRTwT4SYxZkjIVgTxO3anfaF+56SPXp4 myRrlnA+zpbmtoa8q6MW22MA3xWdrQl4xyIkx6rm7oP0Ty1Bi++xjueNoi7xUTy5b+F+ 3R0XLp7MQ3WvYX+45AntnhTs/I+yOJGWGYMt99P3cvHa+hXr+B+qWh7Kv/ABcmNGATK/ OfohXgYChKlqrtUCHEDZzH3vR8oEfLZ6bpQRcIkasFqwksLLlSDpiNN8LYOzRKajaLAB XuFtizD0zTLQKdi+F9jIIPal+a6dkSa6xfknUdBNkI+vtZIEPn3hqVmVQyt8To8GuK52 DzGQ== X-Forwarded-Encrypted: i=1; AJvYcCWoHELcjvwuiEJTanRJk++PsxYezHJx0AGTREMGQB/tXIyVCzoK7rIR1l4Y6ha0DL7b7p6FCD0WbSdZF3PI1EGxiKr2c5GurA== X-Gm-Message-State: AOJu0YyCnQmjI0lQZPotaBKM4CKMimDFcw3LNyDgmoeeoeQJYT+LDLMn ZwIh2XsGDGvwNs6XpZ9Qp2w7kxFywuOAvkrWyaeiekhaK9VeAj2XNGaxWng5dRbuH2mDvcDt75F d96LRLvF3LusLGMOXgmtxC964drzio1wS1jU= X-Google-Smtp-Source: AGHT+IG1cFVJ/dFPjIJ0CDviquZ51MCajSDN9buEqxfytm8I1hFFGsqRwwrD95DCIk2XyT9GS0DQ/QSzmFNFog1ZZMQ= X-Received: by 2002:a17:90a:398c:b0:29b:6e9d:5897 with SMTP id z12-20020a17090a398c00b0029b6e9d5897mr3607215pjb.23.1711640381196; Thu, 28 Mar 2024 08:39:41 -0700 (PDT) MIME-Version: 1.0 From: Paul Richard Thomas Date: Thu, 28 Mar 2024 15:39:30 +0000 Message-ID: Subject: [Patch, fortran] PR110987 and PR113885 - gimplifier ICEs and wrong results in finalization To: "fortran@gcc.gnu.org" , gcc-patches Cc: chilikin.k@gmail.com X-Spam-Status: No, score=-7.7 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_FROM, GIT_PATCH_0, HTML_MESSAGE, RCVD_IN_DNSWL_NONE, 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 Hi All, The attached patch has two elements: (i) A fix for gimplifier ICEs with derived type having no components. The reporter himself suggested (thanks Kirill!): - if (derived && derived->attr.zero_comp) + if (derived && (derived->components == NULL)) As far as I can tell, this is the correct fix. I tried setting attr.zero_comp in resolve.cc for all the OK types without components but this caused all sorts of fallout. (ii) Final calls were occurring in the wrong place for finalizable elemental function calls within scalarizer loops. This caused incorrect results even for derived types with components. This is also fixed. It should be noted that finalizer calls from the rhs of an assignment are occurring at the wrong time, since F2018/24-7.5.6.3 requires: "If an executable construct references a nonpointer function, the result is finalized after execution of the innermost executable construct containing the reference.", while in the present implementation, this happening just before assignment to the lhs temporary. Fixing this is going to be really tough and invasive, so I decided that getting the right results and the correct number of finalization should be sufficient for the 14-branch release. As it happens, I had been mulling over how to do this for finalizations hidden in constructors and other contexts than assignment (eg. write statements or allocation with source). It's a few months away and will be appropriate for stage 1. Regtests on x86_64 - OK for mainline and then, after a bit, for backporting to 13-branch? Regards to all Paul Fortran: Fix a gimplifier ICE/wrong result with finalization [PR104555] 2024-03-28 Paul Thomas gcc/fortran PR fortran/36337 PR fortran/110987 PR fortran/113885 * trans-expr.cc (gfc_trans_assignment_1): Place finalization block before rhs post block for elemental rhs. * trans.cc (gfc_finalize_tree_expr): Check directly if a type has no components, rather than the zero components attribute. Treat elemental zero component expressions in the same way as scalars. gcc/testsuite/ PR fortran/113885 * gfortran.dg/finalize_54.f90: New test. * gfortran.dg/finalize_55.f90: New test. gcc/testsuite/ PR fortran/110987 * gfortran.dg/finalize_56.f90: New test. diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 76bed9830c4..079ac93aa8a 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -12511,11 +12511,14 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, gfc_add_block_to_block (&body, &lse.pre); gfc_add_expr_to_block (&body, tmp); - /* Add the post blocks to the body. */ - if (!l_is_temp) + /* Add the post blocks to the body. Scalar finalization must appear before + the post block in case any dellocations are done. */ + if (rse.finalblock.head + && (!l_is_temp || (expr2->expr_type == EXPR_FUNCTION + && gfc_expr_attr (expr2).elemental))) { - gfc_add_block_to_block (&rse.finalblock, &rse.post); gfc_add_block_to_block (&body, &rse.finalblock); + gfc_add_block_to_block (&body, &rse.post); } else gfc_add_block_to_block (&body, &rse.post); diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc index 7f50b16aee9..badad6ae892 100644 --- a/gcc/fortran/trans.cc +++ b/gcc/fortran/trans.cc @@ -1624,7 +1624,7 @@ gfc_finalize_tree_expr (gfc_se *se, gfc_symbol *derived, } else if (derived && gfc_is_finalizable (derived, NULL)) { - if (derived->attr.zero_comp && !rank) + if (!derived->components && (!rank || attr.elemental)) { /* Any attempt to assign zero length entities, causes the gimplifier all manner of problems. Instead, a variable is created to act as @@ -1675,7 +1675,7 @@ gfc_finalize_tree_expr (gfc_se *se, gfc_symbol *derived, final_fndecl); if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc))) { - if (is_class) + if (is_class || attr.elemental) desc = gfc_conv_scalar_to_descriptor (se, desc, attr); else { @@ -1685,7 +1685,7 @@ gfc_finalize_tree_expr (gfc_se *se, gfc_symbol *derived, } } - if (derived && derived->attr.zero_comp) + if (derived && !derived->components) { /* All the conditions below break down for zero length derived types. */ tmp = build_call_expr_loc (input_location, final_fndecl, 3, diff --git a/gcc/testsuite/gfortran.dg/finalize_54.f90 b/gcc/testsuite/gfortran.dg/finalize_54.f90 new file mode 100644 index 00000000000..73d32b1b333 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/finalize_54.f90 @@ -0,0 +1,47 @@ +! { dg-do compile } +! Test the fix for PR113885, where not only was there a gimplifier ICE +! for a derived type 't' with no components but, with a component, gfortran +! gave wrong results. +! Contributed by David Binderman +! +module types + type t + contains + final :: finalize + end type t +contains + pure subroutine finalize(x) + type(t), intent(inout) :: x + end subroutine finalize +end module types + +subroutine test1(x) + use types + interface + elemental function elem(x) + use types + type(t), intent(in) :: x + type(t) :: elem + end function elem + end interface + type(t) :: x(:) + x = elem(x) +end subroutine test1 + +subroutine test2(x) + use types + interface + elemental function elem(x) + use types + type(t), intent(in) :: x + type(t) :: elem + end function elem + elemental function elem2(x, y) + use types + type(t), intent(in) :: x, y + type(t) :: elem2 + end function elem2 + end interface + type(t) :: x(:) + x = elem2(elem(x), elem(x)) +end subroutine test2 diff --git a/gcc/testsuite/gfortran.dg/finalize_55.f90 b/gcc/testsuite/gfortran.dg/finalize_55.f90 new file mode 100644 index 00000000000..fa7e552eea5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/finalize_55.f90 @@ -0,0 +1,89 @@ +! { dg-do run } +! Test the fix for PR113885, where not only was there a gimplifier ICE +! for a derived type 't' with no components but this version gave wrong +! results. +! Contributed by David Binderman +! +module types + type t + integer :: i + contains + final :: finalize + end type t + integer :: ctr = 0 +contains + impure elemental subroutine finalize(x) + type(t), intent(inout) :: x + ctr = ctr + 1 + end subroutine finalize +end module types + +impure elemental function elem(x) + use types + type(t), intent(in) :: x + type(t) :: elem + elem%i = x%i + 1 +end function elem + +impure elemental function elem2(x, y) + use types + type(t), intent(in) :: x, y + type(t) :: elem2 + elem2%i = x%i + y%i +end function elem2 + +subroutine test1(x) + use types + interface + impure elemental function elem(x) + use types + type(t), intent(in) :: x + type(t) :: elem + end function elem + end interface + type(t) :: x(:) + type(t), allocatable :: y(:) + y = x + x = elem(y) +end subroutine test1 + +subroutine test2(x) + use types + interface + impure elemental function elem(x) + use types + type(t), intent(in) :: x + type(t) :: elem + end function elem + impure elemental function elem2(x, y) + use types + type(t), intent(in) :: x, y + type(t) :: elem2 + end function elem2 + end interface + type(t) :: x(:) + type(t), allocatable :: y(:) + y = x + x = elem2(elem(y), elem(y)) +end subroutine test2 + +program test113885 + use types + interface + subroutine test1(x) + use types + type(t) :: x(:) + end subroutine + subroutine test2(x) + use types + type(t) :: x(:) + end subroutine + end interface + type(t) :: x(2) = [t(1),t(2)] + call test1 (x) + if (any (x%i .ne. [2,3])) stop 1 + if (ctr .ne. 6) stop 2 + call test2 (x) + if (any (x%i .ne. [6,8])) stop 3 + if (ctr .ne. 16) stop 4 +end diff --git a/gcc/testsuite/gfortran.dg/finalize_56.f90 b/gcc/testsuite/gfortran.dg/finalize_56.f90 new file mode 100644 index 00000000000..bd350a3bc1c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/finalize_56.f90 @@ -0,0 +1,168 @@ +! { dg-do run } +! Test the fix for PR110987 +! Segfaulted in runtime, as shown below. +! Contributed by Kirill Chankin +! and John Haiducek (comment 5) +! +MODULE original_mod + IMPLICIT NONE + + TYPE T1_POINTER + CLASS(T1), POINTER :: T1 + END TYPE + + TYPE T1 + INTEGER N_NEXT + CLASS(T1_POINTER), ALLOCATABLE :: NEXT(:) + CONTAINS + FINAL :: T1_DESTRUCTOR + PROCEDURE :: SET_N_NEXT => T1_SET_N_NEXT + PROCEDURE :: GET_NEXT => T1_GET_NEXT + END TYPE + + INTERFACE T1 + PROCEDURE T1_CONSTRUCTOR + END INTERFACE + + TYPE, EXTENDS(T1) :: T2 + REAL X + CONTAINS + END TYPE + + INTERFACE T2 + PROCEDURE T2_CONSTRUCTOR + END INTERFACE + + TYPE, EXTENDS(T1) :: T3 + CONTAINS + FINAL :: T3_DESTRUCTOR + END TYPE + + INTERFACE T3 + PROCEDURE T3_CONSTRUCTOR + END INTERFACE + + INTEGER :: COUNTS = 0 + +CONTAINS + + TYPE(T1) FUNCTION T1_CONSTRUCTOR() RESULT(L) + IMPLICIT NONE + L%N_NEXT = 0 + END FUNCTION + + SUBROUTINE T1_DESTRUCTOR(SELF) + IMPLICIT NONE + TYPE(T1), INTENT(INOUT) :: SELF + IF (ALLOCATED(SELF%NEXT)) THEN + DEALLOCATE(SELF%NEXT) + ENDIF + END SUBROUTINE + + SUBROUTINE T3_DESTRUCTOR(SELF) + IMPLICIT NONE + TYPE(T3), INTENT(IN) :: SELF + if (.NOT.ALLOCATED (SELF%NEXT)) COUNTS = COUNTS + 1 + END SUBROUTINE + + SUBROUTINE T1_SET_N_NEXT(SELF, N_NEXT) + IMPLICIT NONE + CLASS(T1), INTENT(INOUT) :: SELF + INTEGER, INTENT(IN) :: N_NEXT + INTEGER I + SELF%N_NEXT = N_NEXT + ALLOCATE(SELF%NEXT(N_NEXT)) + DO I = 1, N_NEXT + NULLIFY(SELF%NEXT(I)%T1) + ENDDO + END SUBROUTINE + + FUNCTION T1_GET_NEXT(SELF) RESULT(NEXT) + IMPLICIT NONE + CLASS(T1), TARGET, INTENT(IN) :: SELF + CLASS(T1), POINTER :: NEXT + CLASS(T1), POINTER :: L + INTEGER I + IF (SELF%N_NEXT .GE. 1) THEN + NEXT => SELF%NEXT(1)%T1 + RETURN + ENDIF + NULLIFY(NEXT) + END FUNCTION + + TYPE(T2) FUNCTION T2_CONSTRUCTOR() RESULT(L) + IMPLICIT NONE + L%T1 = T1() + CALL L%T1%SET_N_NEXT(1) + END FUNCTION + + TYPE(T3) FUNCTION T3_CONSTRUCTOR() RESULT(L) + IMPLICIT NONE + L%T1 = T1() + END FUNCTION + +END MODULE original_mod + +module comment5_mod + type::parent + character(:), allocatable::name + end type parent + type, extends(parent)::child + contains + final::child_finalize + end type child + interface child + module procedure new_child + end interface child + integer :: counts = 0 + +contains + + type(child) function new_child(name) + character(*)::name + new_child%name=name + end function new_child + + subroutine child_finalize(this) + type(child), intent(in)::this + counts = counts + 1 + end subroutine child_finalize +end module comment5_mod + +PROGRAM TEST_PROGRAM + call original + call comment5 +contains + subroutine original + USE original_mod + IMPLICIT NONE + TYPE(T1), TARGET :: X1 + TYPE(T2), TARGET :: X2 + TYPE(T3), TARGET :: X3 + CLASS(T1), POINTER :: L + X1 = T1() + X2 = T2() + X2%NEXT(1)%T1 => X1 + X3 = T3() + CALL X3%SET_N_NEXT(1) + X3%NEXT(1)%T1 => X2 + L => X3 + DO WHILE (.TRUE.) + L => L%GET_NEXT() ! Used to segfault here in runtime + IF (.NOT. ASSOCIATED(L)) EXIT + COUNTS = COUNTS + 1 + ENDDO +! Two for T3 finalization and two for associated 'L's + IF (COUNTS .NE. 4) STOP 1 + end subroutine original + + subroutine comment5 + use comment5_mod, only: child, counts + implicit none + type(child)::kid + kid = child("Name") + if (.not.allocated (kid%name)) stop 2 + if (kid%name .ne. "Name") stop 3 + if (counts .ne. 2) stop 4 + end subroutine comment5 +END PROGRAM