From patchwork Thu Sep 11 18:28:33 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 120112 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id A79943858C42 for ; Thu, 11 Sep 2025 18:30:42 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org A79943858C42 Authentication-Results: sourceware.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=UbeSgVet 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.15]) by sourceware.org (Postfix) with ESMTPS id 76BE93858D26; Thu, 11 Sep 2025 18:28:35 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 76BE93858D26 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 76BE93858D26 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=212.227.15.15 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757615315; cv=none; b=O2ZEWmpT8FU5nLXzTDEzWdz6wioRmElu4nZdhT9T6FIAEoHzTqDcsxgumiyFrLaxJR4vXvRFhsd13iMcKo1iILqLIJITOnRGfZYvR5HeQCoH5fmIShEOKKxkGFOFnpnWaKSj3JKWUt0xtHK11wNdXv6x0rpCqJ5ivar6as3mGSs= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1757615315; c=relaxed/simple; bh=3K7iQgSkfx6F+Hx041uRyPfDnAuVOefvKk8gPcYwggM=; h=DKIM-Signature:Message-ID:Date:MIME-Version:From:Subject; b=noT4RzgG9TRIprZ5RMWmHwhFOvd3uVS1qLduBhkTJPwvrOa/7VSkQmqlpkILEQkSy6McUPngT86O/etMR4Wfm1FJM7kEXBVbiFMfnOcJZysBkwKnW4h+5Q2DlHYSxzNi38iYZwbjDRUawIMuin8FAwpv3LVaZE7zSP6NPsF6BLo= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 76BE93858D26 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmx.de; s=s31663417; t=1757615314; x=1758220114; i=anlauf@gmx.de; bh=wHnLLGDy55w8pM5ZD+aFsPacTn1PEmMV29KJH7RvAWU=; h=X-UI-Sender-Class:Content-Type:Message-ID:Date:MIME-Version:Cc: From:Subject:cc:content-transfer-encoding:content-type:date:from: message-id:mime-version:reply-to:subject:to; b=UbeSgVetx/aMcNvSc0UYgeZRe71K/Lu+nowykYot5qgOsyRtQHQGiNCd3DOmgIgq z3/mOSeVkYBITqhEvKPkJRq4Ry1kJb5FVAj0rjnr/T8zX+dguE4EZYnKmmLWPDk4j PybPb5KkhXz+s/gl2MascUnI1eDO7ikkHgnSIqN+jz4cMO0XRSJLlDHtEFg1EPaOn hdgz9UkyQ4OXibYqQ6f7B+u0k173mtkRAjsUiRjB7AoTguQy+jLkuPVz4eowI9P3Q oWSSXO3QrfUUFGL8jM8e91UK8pKib3aQYrGAfsh0zPgPWWUl+hU2FJe4JsgZRhFWh 4pK6HjzUpTOzyd4DaQ== X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Received: from [192.168.178.29] ([93.207.86.103]) by mail.gmx.net (mrgmx004 [212.227.17.190]) with ESMTPSA (Nemesis) id 1M72sP-1v3deg3x1D-00HH2G; Thu, 11 Sep 2025 20:28:34 +0200 Message-ID: <999b82a5-1210-4b0d-b83d-94b987ac4626@gmx.de> Date: Thu, 11 Sep 2025 20:28:33 +0200 MIME-Version: 1.0 User-Agent: Mozilla Thunderbird Newsgroups: gmane.comp.gcc.fortran,gmane.comp.gcc.patches Content-Language: en-US Cc: fortran , gcc-patches From: Harald Anlauf Subject: [PATCH] Fortran: fix assignment to allocatable scalar polymorphic component [PR121616] X-Provags-ID: V03:K1:JkN6wP4kgSMGnSc4BhBtlr+s+xhcBwcQ/Qn1iW1grmqZUMx3P8p tUzESUiF3eqgjT9ay/LTpqoo4PIlnCo7Fuk1StsYBfuCqMLldf8I/XONpUt+YLB6gBI4oUk ojIEryZ+YSGgjWvqTukHgCqY/oxkaffNel68SEsVZaDYAYjnVwTE2RUBjOw8E/sXu+6SQf+ 5lOHFpEATcFvpgR9hdMSg== UI-OutboundReport: notjunk:1;M01:P0:dGvEvSptabk=;K2qozvmYPML9IE7UMTdaXmSgyQN glMrsjrvoCQvSHpNGTNLg5FEWXEZEKwXpd+8cUvvjEA9ETrq7ePKeitPpauxhcgsF8pTaNlvz 1gdgFjO7FPgtogVjYQn9lXklcr79SG1/ZH73l5ldIpoS+rLJjFSWawtf+ufCXhJm+z8YmJdn7 F3YcA8jpdY14GGWtfoXh9XCejhdrTXMlUpcCwQKC1b3kCNZuuargy31yBZWSwgdB9xzCL0fM2 UDVE04HwdcxqXa9QvzwRLKaOw+NQgAeoojdHhbFEAZz4bCcq8ZXx3sdpBOVlTphCUgh0OspKf A9U0knvHejSYqbtvhezwf3W1mEMIIKzkl/CCi3elRie+ermzwnC74VieJrwlQh25DzBsRckE9 3qVTOjrzpidmEdnP4eeXsoB7YL8qDI1wjtm50oRghj+3D7QgUhrCH4Ro0MNllHxnLZbuaAENw hfpPBwu+zWEZJ3Xh5hKjwRs1KJODYUw/AzOX+4lc/3GvfwCrAKy0HiDEZj5MVQxiUOhvHt8ud EZEqJjhXiw1N7zxOgGGxlvs6o2+VZiDyOXkz5usPI13ztxskCMij9J5O6wgpkfUELDYwPFUYc CaZ5S7gqNu98cX2IDdU9YK7XIVhJqiDw3ZiGFwtcOa2KGVhFDIBV2hY6IMnwk6ZGEGbFKULZQ Fg3LyjkDkF2Xfc0rmaKDn3wgYZC8MbcYwWL6a0NQ6twzT2Kq28nRIC54WLWOtIMzYttE2Oy+M q9mXhwSys0lp8E5n3ZWDs0EEp/TCRVQqEmeGXIaHn4Hj/XqUWtd31hejPiNSb+Krd3gmU+SDc Y7ZhmGKKKxBjE203+dLu16yDzT+rzKB0Jm+jS1sBDY2Tg/wvkand59u36JtrV45HpPMwPd0wc TnnO82QsfujqddXDc7hB1/DmVURZ+qbIuuLyB0HZw+zINPLOZQQHcUET7N8/v3IDmZGINpmkr Zxg+8ADra1oBfvhKLeYdAmITVUX0YBmYnzioEiQPgO1YfXpH8tKBsaGVW1WZa7+GUeI2E3F37 2+FD3WBhIblt0bvM/2E09BHRQX05Eymx5PqqLjFa1Loh55UNgRoguGqGJH6t6jIkCAKxlbNv3 309XbNBmwCsyCAyrIIWmYwVaTSQslUI9BO2VrIA4Qm4mA9hMkimk8R7KQVta+tZHJrliiYSKt LIHySrFSVu/KBFaYny4Lk7D7bLvqCzZr9UN3pl9+WugWE3FTuFmFgxi+ohnwux8vSki5rNU+/ 5og0qnfIlrAvt73XNaH9hYeNKnQFo+ErgL2HeT10z0N7j3W8uOcgCAqEDpqKRkKSB7Af5WJWt O0/j2DEOLQl3dfJN7UcF9h1tTLqqUQ+UcPmOAoYNibMNq5WgGddMU9s/nT1ZtV/aJ5X2p+8ck 06Na7uflHjxbf75PTt3HGuILHsCFFiV2fPAeUTEFFdyZ0C3HM+OsXOokRDcCnqCytS4PxNg2M VhKpcvweEmsXuLqejR7uhoI6E3nugtoI5LcKfSFQEMpMzJZlQN28xgB7bvSTAB05bs7aCYUyq It/7m3dhq0ZUe17w/FQ7juCCG0ZjR+9FDp1aHDT7gBSZFpmjo4lew29SxS4Pr+8/ap1WVxxT+ LwZEzReaR1GHrh4w4HbElaWxTsudf1Ktm5vRc3nAjDURFQwVjtz8vSucd7c8tZ5drp2TEuE1/ jZHAs/K6MIrVItsruG/MlYssBbQjYN5HCCI0s7iKJTVMy3KLtZ3JPw6D7xYgdWv4BmNimhiGn gvjVIGBvXZmH627LRiu7nMZkYFmSp6NKrvvg7rBLf6JqigC2g1fggF4lYolXGuYz238mLcllU ghvWFddEmJNPjeBF3y947g93cSDtMwOd/Ghy7V0HQolrg9KCuAKr7TtmfNhjx1rovrFCu3rA6 64mfJrrtvSce09QGC//TRCtrAIJzVhQFybpw34Qw2PU0VNFR7Kwu705yBGB0R4LL3aIvO/UKj kLHRME2unjJmC6Wy6hFuIkYGm+BPeqz3HmMo8JLgxp78WQ+Cl1qYxv6lKjiX/z/t3bC2vcytc yBJ3hQ+zcTySXOcl2vDksA74Y5U8+hfLhgWLUCnbRtD96jEzHyncUS0UX3nKMgWBq9M2Dk33e 4EzDgvJQhtUCxLpwvOkQwRT+6tGoCRZ/5YhReSO5PrQcPCHvkj9mt6DrOXYRD5a8XEjBbXi1X OKu7c7jCf3yjSj5oeECKoBRHAS4hDBJz/gz0g0UkCpkkM+4/uKvWe37UVECp0JTJYXc5qtmb1 EPsOHM61B9gcuV0ZdksYUCsv/ZUYKePeHcK7OdTmAb+7okbCGayj4zBXL7oPddyUAV498wUal I55Qaeib1NcbpZgh7B2cKRUzT1g/Io6lnP+R8f3slS9Pc+2n6rzUB5zdan2uUoJrbe2tPYT4h ebsoImVsVQbZWSgBDbUelJtiVokt/HSSmi1wa0I6QSda2F+NmrxuJxZI0nS6e8YgLYiZSWgge WV4aV76fQMJ7UD/INSl40I3yyJDlxosWocZlscstPJ3hDNx2c6XRc3oTyaS9jYU0f9BiP4Ads Jeqa0ZLiMGi5RHZKvRFJLP2NJvYa7nidRo4+SIR9vwoutSsRbDqwuieeGERv21trPP1YIt0QM B+kbj6j4KPjOcOtAnFiRpyKaNFOzQmJrDhlq2+O3P4QouKKRZn8x/R3CZmmgsqJXS+tvD+0SZ U6buZ+mEPxnE2jGV8szkqAYyWY4Eb2OXY5QqcOdu7+87BSu1Ex6AN3VCkQ7gVX6VKu2TcuzrV 5nnLEYIc700p4jrzCS75InQ11Mk+mikTDGdqR02CHFS9GzQfu4wI/SkScMBX0sdNKxuD6SUSV lB4nfRio9muNKffN0ZCAe1Zk4X4+vzfGU3sCJdI3ruKl0La53QOLDXBDUJHVVjw9U0WfcNDm4 zAhvlXaDlmz9A/iox+5LluXUvM/iti2YBW2raq9HmAm51YdiCW0jaHBx//omF6zYIopJouFHf mO6gHnQ6kmiQ+2oYRLZN1dgrfhmrt+MVgV/TlnU/9HTAWY4NhEpGtnpLoCkvslQ/hLW07KD6k DnUSeENxrwF1C+LCILWcLgvEM1VHWAMtDH9b5GRL91FdaIM5ZJPKC+LOlENbYz03VkFJPYfin 3swIbL+Ts2e23nMz5RaJ9CTrhSXEH5/m20OhKK1y8GSsmCa69cWh7WtuoPywxioeIEgJJCCHK LNt6RhjefaPKCni9PAJ32s0wOxo3byla2zDsRP943EhWHa0BeWPIWYHGLzaV/W1dnxT1hNbsI 3LBswzd5hD4qIbwLgE9GKIaFyYlM0huDkNGSIgvqZlZtvrdJqGRSWNDTjF0XgjqOd99i1x6oR rOST3g0zo1Txz0+w5oDBnQH6yX/Nvk2pqc1zyark8uyvAUnYta05JG13WBew56wX0c5tAAHgq XM7+dIsi12K1Ipl7DVLCm70wUajQ1ddF95NLoMuEPSG8pEjxRIs6icE9GP4HrEiyaG+f3K4VV 08cLOiP/KLOSRhzdRE58g3ir66gOjwLuQc7dchRxcJ7ubo6OPRacF3W+lK583xRQKQqe7Um/h ICWrmE30HQaP513nxcdY7PmU4DZyjwI+22jSPOQWJGiyN3GmZfUhdf9q/XQrl0Q+ZTHqcIQlQ xgsoR9wPC8EEPYTOZzLtcvKzWKkdQizJ1WVZwkum2Xpv3mVmgvjpdkrcMi5B4yPyTpI2RBZK9 maczCwIthC6J9NRUmt1+wXarVD+ahgZiNdPaGPM0nYboDqAM9JZHGME2uwOFRAB7v3zMmJA4F 5Ozul0u93c17NSeqBK9U+U5cGiBHmqapyigbU/nnPy2iWRfGsv08++Z6eHscAocJZEpBm+36W pXJUiu6+eui+yrGBEWpoUPF1QSHSokERwOKFu3ceJYWV6lzDXS4hxk6jNfE5rKhPhqgcZxWT3 IL+IOHVpuPR45iQsuVzlVtONrN7dyw6A/TyjOvVK2z9BJBQnfq4+Zx9otS7nO0fx/f8NCUZZz ZSPMf6srTG4LQfklCDSzxR+d8RuGzSNSfpwzZbzBAFHirTRObKKKNMMeydgjIu2q/DXtHo8S8 Ub/B1I+bM1Pn+nJSYDR6cEYLB/sYSt4j93rNe9KckHhPE2lQjjaHWDFOITKz0G9IgGquQ3mCV HoVzS3/Bq5Et2yaxj+KSgjs7Tn5Adr/FiLrz3Gb3BrnXUo4Iy0ArUppTMnPJ2bX4QzV9ykg3t PGrP3bF62jBFNRCDOswwfNM8v1hg3XPD4myVgUTNuNaczs4W4KVm1eu6LGVYq1p71xhjHoycm hzI9An5Hldo+X0LnRYGg5qYVokJQexJxhXayXiHBpSAaj6YIrhFEKS9H1Be9xBIe6JFh09VOA ZJISLUbRRKLe9YwBEfZ0cFznnrEWL7/VU8wyQWa073WpkZ5d803K74OzlfNSlvZ5nMG7MSyPz 7LEWuNNAK9Y9guV+uzuMCJjN9Qxj5E6NBBY4YHfzfzepHs6Arrw9snzY+tsbrbqkuFLXS+Igs YotyA8kWWPjAFPsGNyRgmwjkNMCIQ995KFwm1IRDnGaAsWqt9QQhRgnIwDDrr8DOzEyBXjt2S y0KGKbg96Z5/v8gHbomsJT1mjsSSkpCEvU79vK7enNnEjXQudG0qCNSo+b5EwFrLxN/75TJL3 BQQHKFuBJMv4eqmjyqpTbNc76kUgEC3WC0OBDt/GO1SRW//0FS03UqylGf9+fTYGGSOXnDi30 MyXCFK9e5ay+MKWeLyHkNCNS68n3MztZ2fhUq8ld8uWS65MZcA== X-Spam-Status: No, score=-10.9 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_FROM, GIT_PATCH_0, KAM_ASCII_DIVIDERS, MALFORMED_FREEMAIL, MISSING_HEADERS, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H3, RCVD_IN_MSPIKE_WL, RCVD_IN_VALIDITY_RPBL_BLOCKED, RCVD_IN_VALIDITY_SAFE_BLOCKED, 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~patchwork=sourceware.org@gcc.gnu.org Dear all, here's a - once found - seemingly simple and obvious fix for a memory corruption happening when intrinsic assignment is used to set a scalar allocatable polymorphic component of a derived type when the latter is instanciated as an array of rank > 0. Just get the dimension attribute right when using gfc_variable_attr ... The testcase is an extended version of the reporter's with unlimited polymorphism, including another simpler one contributed by a friend. Without the fix, both tests crash with memory corruption of various kinds. Regtested on x86_64-pc-linux-gnu. OK for mainline? If there are no objections, I would like to backport to at least 15-branch. Thanks, Harald From 0899b826f7196f609fc8991456eb728802061318 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Thu, 11 Sep 2025 20:17:31 +0200 Subject: [PATCH] Fortran: fix assignment to allocatable scalar polymorphic component [PR121616] PR fortran/121616 gcc/fortran/ChangeLog: * primary.cc (gfc_variable_attr): Properly set dimension attribute from a component ref. gcc/testsuite/ChangeLog: * gfortran.dg/alloc_comp_assign_17.f90: New test. --- gcc/fortran/primary.cc | 2 + .../gfortran.dg/alloc_comp_assign_17.f90 | 96 +++++++++++++++++++ 2 files changed, 98 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/alloc_comp_assign_17.f90 diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc index 6df95558bb1..2cb930d83b8 100644 --- a/gcc/fortran/primary.cc +++ b/gcc/fortran/primary.cc @@ -3057,12 +3057,14 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts) if (comp->ts.type == BT_CLASS) { + dimension = CLASS_DATA (comp)->attr.dimension; codimension = CLASS_DATA (comp)->attr.codimension; pointer = CLASS_DATA (comp)->attr.class_pointer; allocatable = CLASS_DATA (comp)->attr.allocatable; } else { + dimension = comp->attr.dimension; codimension = comp->attr.codimension; if (expr->ts.type == BT_CLASS && strcmp (comp->name, "_data") == 0) pointer = comp->attr.class_pointer; diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_assign_17.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_assign_17.f90 new file mode 100644 index 00000000000..7a659f2e0c0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/alloc_comp_assign_17.f90 @@ -0,0 +1,96 @@ +! { dg-do run } +! PR fortran/121616 +! +! Test fix for intrinsic assignment to allocatable scalar polymorphic component + +program p + call pr121616 () + call test_ts () +end + +! Derived from original PR (contributed by Jean Vézina) +subroutine pr121616 () + implicit none + integer :: i + type general + class(*), allocatable :: x + end type general + type(general) :: a(4), b(4) + ! Intrinsic assignment to a variable of unlimited polymorphic type + a(1)%x = 1 + a(2)%x = 3.14 + a(3)%x = .true. + a(4)%x = 'abc' + ! The workaround was to use a structure constructor + b(1) = general(1) + b(2) = general(3.14) + b(3) = general(.true.) + b(4) = general('abc') + do i = 1, 4 + if (.not. allocated (a(i)%x)) stop 10+i + if (.not. allocated (b(i)%x)) stop 20+i + call prt (a(i)%x, b(i)%x) + end do + do i = 1, 4 + deallocate (a(i)%x, b(i)%x) + end do +contains + subroutine prt (x, y) + class(*), intent(in) :: x, y + select type (v=>x) + type is (integer) + print *,v + type is (real) + print *,v + type is (logical) + print *,v + type is (character(*)) + print *,v + class default + error stop 99 + end select + if (.not. same_type_as (x, y)) stop 30+i + end subroutine prt +end + +! Contributed by a friend (private communication) +subroutine test_ts () + implicit none + + type :: t_inner + integer :: i + end type + + type :: t_outer + class(t_inner), allocatable :: inner + end type + + class(t_inner), allocatable :: inner + type(t_outer), allocatable :: outer(:) + integer :: i + + allocate(t_inner :: inner) + inner% i = 0 + + !------------------------------------------------ + ! Size of outer must be > 1 for the bug to appear + !------------------------------------------------ + allocate(outer(2)) + + !------------------------------ + ! Loop is necessary for the bug + !------------------------------ + do i = 1, size(outer) + write(*,*) i + !---------------------------------------------------- + ! Expect intrinsic assignment to polymorphic variable + !---------------------------------------------------- + outer(i)% inner = inner + deallocate (outer(i)% inner) + end do + + write(*,*) 'Loop DONE' + deallocate(outer) + deallocate(inner) + write(*,*) 'Dellocation DONE' +end -- 2.51.0