From patchwork Mon Apr 29 18:39:04 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 1929133 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=MSq+MpBb; 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 4VSsYy5Sq9z23jG for ; Tue, 30 Apr 2024 04:39:34 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id C4BCC3858433 for ; Mon, 29 Apr 2024 18:39:32 +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.15.15]) by sourceware.org (Postfix) with ESMTPS id 4FFE93858D35; Mon, 29 Apr 2024 18:39:06 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 4FFE93858D35 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 4FFE93858D35 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=1714415949; cv=none; b=nJ/KZq3MP1noDhOyex0iSR7x5hbvBnrVT5f1ZOPnEtq34GtwwC+KgJIFZRUz5qB14vhXzYvM54DdQ7pEVomfp2NgOn9nN2fSPA+OYxfab0v81zKfJM6IT4e5zjObUbF/FM++yfS5UrloEd1sKnrHEQGoPkvEbWIhihh+t8n6jqs= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1714415949; c=relaxed/simple; bh=snnR25K7MQtVFEOwCKFzVrF79ZFNyReIKOwwaskKY7M=; h=DKIM-Signature:MIME-Version:Message-ID:From:To:Subject:Date; b=BCywvXLn5Ehquyt/nZbMYUmzpYNVamjQ6SYJh0fU4CDtwlrh2RhASdqqRXPm5zEyFymrrVGSjZrYMB3Tohp/TzIhhokoMZeJm41x1F8/3KLD6O+3gGjRUXcv6/xg5/03isLTWetIuk09Op01PTuIwzrbeqSNCV5NAHtCBaO2JcM= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmx.de; s=s31663417; t=1714415945; x=1715020745; i=anlauf@gmx.de; bh=1N2d2O8j5VEfM4aFHzHJpnr07a79JpkiJ9GhvR3DVaI=; h=X-UI-Sender-Class:MIME-Version:Message-ID:From:To:Subject: Content-Type:Date:cc:content-transfer-encoding:content-type:date: from:message-id:mime-version:reply-to:subject:to; b=MSq+MpBbG11aosRp25JrWSUZIBajbq4ua7vrsy3i+G1Bd8jy3v/TsTTK7oO0zkK6 NcKZ2gd6ZwdQMZ5jmlXKvSnWg/BWIAWsRtfnIA5EaJPkUyUKhOIq1mGXZKuVPV4tn Az6UWBVAyTpJU3acSOgU/8bKRgWwQbsHOnWQ20oWbo8tg6nzHI8rB7hkxvo7B0aOh bwbLV0RGusJRwesi1UJRz0QipOgtqGhbv9VlmJJ8sy8xU2yOaXtBWXHBFew/YXIJ9 U7yoS3fRwrLyQC6ZABWXHlGX4DNYSAzVL/xRdohbjoPMxv6iGVw5F/RDPlfbo1Xsm az2bfSuPC7pnYSx2AQ== X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Received: from [93.207.83.167] ([93.207.83.167]) by web-mail.gmx.net (3c-app-gmx-bs06.server.lan [172.19.170.55]) (via HTTP); Mon, 29 Apr 2024 20:39:04 +0200 MIME-Version: 1.0 Message-ID: From: Harald Anlauf To: fortran , gcc-patches Subject: [PATCH] Fortran: fix issues with class(*) assignment [PR114827] Date: Mon, 29 Apr 2024 20:39:04 +0200 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:XjWcX8flzFzphH3w4AeeHM/tIb+ruNTn3qDPFXneKfzxAO76O8NGx19okzyYoGr05Vaut XjgXZo8Q3EPdmvbUkDBC5baWyrEIZsQE7cphNGqAHYDchRmbnwLCrgaFrYf6XqKMSNdwhtKUFfA+ 987Jj1zcUmTpXsiWWkPRMddNlwjGipTnKszmJSMm+Pl8eDk3j1KT/kh1qo7SsYj6uoUIKLQOP+7q mfVHpvhW2DN6OYLW+snSwPEiCWopxi4OU4TrViVLjuXOWvDK7wxk6KeU9pBl/6it9uHn7hJjB+av IY= UI-OutboundReport: notjunk:1;M01:P0:UfLHV6goQXg=;UunXavZJQw11+noo4n/q4rkdH3O F9n4b6+OrRhIDQiLF8RCbI3e4yelBbg/yFxJOLOW9yOnEyHCDDe+aPgs4h0lOB5DuGGBz4xbF PIdjtGyW4dZKwcoNON8Pco7rT+dZl/FUMP9v6FrObYY4VGwWixNvpOhe0eZqowGO+58lH5n2v y0q9zdtzMicY0AMq6Av26Lda9upSf0P5vKbBH9OApTYwq61Z+FWoWSdx/d6iuGG+zauzC68t2 zCnIcCAUY7VgJS1SLj5WkCt2hZEo0l8rKlz+eJUJXDgmUnWKI5faRViyBD8LfN7PAl/t1+qyz miS3XukuvA4RY+y44djQdJuea3vO37NICBcAwvm+spTjkKT7Eag4t3kuFs2LFM9lanrnW/hoC Q8PaaZ+UbuTvaUIOreH2ezcV1Z8TtNIHMTiSjyLm0ejPu+7ipmLkskFePn5Hbk/6cP5t9ytr1 rEupr1t13kci7b5pfJP0PMRDt/bhjNCH/KD8sMQAxsmtxRXpb8XrXmBoOaBYMSnVOoSrUuZ18 jOk8kLHRheOAXvmycD7LcttslpCrTgEPIuncORnwHo06gNqQ8Oj0M3HT0V1v1MxbvGFSB4G05 Bzpiy/cMoonBPhwzIJy+wtrltp0JsVqErOn+K3tqKFyfJWLjlybVqhnoICV4HSB3oQHvhnV7D 2NWJhFPH9w8YBjQ3H9rpS31fvIfNQOID19PqM2iL5QErFvkhPMbrS92leBNnlVk= X-Spam-Status: No, score=-12.1 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_H3, RCVD_IN_MSPIKE_WL, 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 issues with assignments of unlimited polymorphic entities that were found with the help of valgrind or asan, see PR. Looking further into it, it turns out that allocation sizes as well as array spans could be set incorrectly, leading to wrong results or heap corruption. The fix is rather straightforward: take into the _len of unlimited polymorphic entities when it is non-zero to get the correct allocation sizes and array spans. The patch has been tested by the reporter, see PR. Regtested on x86_64-pc-linux-gnu. OK for 15-mainline? I would like to backport this to active branches where appropriate, starting with 14 after it reopens after release. Is this OK? Thanks, Harald From 3b73471b570898e5a5085422da48d5bf118edff1 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Mon, 29 Apr 2024 19:52:52 +0200 Subject: [PATCH] Fortran: fix issues with class(*) assignment [PR114827] gcc/fortran/ChangeLog: PR fortran/114827 * trans-array.cc (gfc_alloc_allocatable_for_assignment): Take into account _len of unlimited polymorphic entities when calculating the effective element size for allocation size and array span. Set _len of lhs to _len of rhs. * trans-expr.cc (trans_class_assignment): Take into account _len of unlimited polymorphic entities for allocation size. gcc/testsuite/ChangeLog: PR fortran/114827 * gfortran.dg/asan/unlimited_polymorphic_34.f90: New test. --- gcc/fortran/trans-array.cc | 16 +++ gcc/fortran/trans-expr.cc | 12 ++ .../asan/unlimited_polymorphic_34.f90 | 135 ++++++++++++++++++ 3 files changed, 163 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/asan/unlimited_polymorphic_34.f90 diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 30b84762346..7ec33fb1598 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -11278,6 +11278,19 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, gfc_add_modify (&fblock, linfo->delta[dim], tmp); } + /* Take into account _len of unlimited polymorphic entities, so that span + for array descriptors and allocation sizes are computed correctly. */ + if (UNLIMITED_POLY (expr2)) + { + tree len = gfc_class_len_get (TREE_OPERAND (desc2, 0)); + len = fold_build2_loc (input_location, MAX_EXPR, size_type_node, + fold_convert (size_type_node, len), + size_one_node); + elemsize2 = fold_build2_loc (input_location, MULT_EXPR, + gfc_array_index_type, elemsize2, + fold_convert (gfc_array_index_type, len)); + } + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc))) gfc_conv_descriptor_span_set (&fblock, desc, elemsize2); @@ -11324,6 +11337,9 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, gfc_add_modify (&fblock, tmp, fold_convert (TREE_TYPE (tmp), TYPE_SIZE_UNIT (type))); + else if (UNLIMITED_POLY (expr2)) + gfc_add_modify (&fblock, tmp, + gfc_class_len_get (TREE_OPERAND (desc2, 0))); else gfc_add_modify (&fblock, tmp, build_int_cst (TREE_TYPE (tmp), 0)); diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 0280c441ced..4ba40bfdbd3 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -11991,6 +11991,18 @@ trans_class_assignment (stmtblock_t *block, gfc_expr *lhs, gfc_expr *rhs, old_vptr = build_int_cst (TREE_TYPE (vptr), 0); size = gfc_vptr_size_get (rhs_vptr); + + /* Take into account _len of unlimited polymorphic entities. */ + if (UNLIMITED_POLY (rhs)) + { + tree len = trans_get_upoly_len (block, rhs); + len = fold_build2_loc (input_location, MAX_EXPR, size_type_node, + fold_convert (size_type_node, len), + size_one_node); + size = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (size), + size, fold_convert (TREE_TYPE (size), len)); + } + tmp = lse->expr; class_han = GFC_CLASS_TYPE_P (TREE_TYPE (tmp)) ? gfc_class_data_get (tmp) : tmp; diff --git a/gcc/testsuite/gfortran.dg/asan/unlimited_polymorphic_34.f90 b/gcc/testsuite/gfortran.dg/asan/unlimited_polymorphic_34.f90 new file mode 100644 index 00000000000..c69158a1b55 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/asan/unlimited_polymorphic_34.f90 @@ -0,0 +1,135 @@ +! { dg-do run } +! PR fortran/114827 - issues with class(*) assignment found by valgrind +! +! Contributed by Neil Carlson + +program main + implicit none + call run + call run1 + call run2 +contains + ! Scalar tests + subroutine run () + character(*), parameter :: c = 'fubarfubarfubarfubarfubarfu' + character(*,kind=4), parameter :: d = 4_"abcdef" + complex, parameter :: z = (1.,2.) + class(*), allocatable :: y + + call foo (c, y) + select type (y) + type is (character(*)) +! print *, y(5:6) ! ICE (-> pr114874) + if (y /= c) stop 1 + class default + stop 2 + end select + + call foo (z, y) + select type (y) + type is (complex) + if (y /= z) stop 3 + class default + stop 4 + end select + + call foo (d, y) + select type (y) + type is (character(*,kind=4)) +! print *, y ! NAG fails here + if (y /= d) stop 5 + class default + stop 6 + end select + end subroutine + ! + subroutine foo (a, b) + class(*), intent(in) :: a + class(*), allocatable :: b + b = a + end subroutine + + ! Rank-1 tests + subroutine run1 () + character(*), parameter :: c(*) = ['fubar','snafu'] + character(*,kind=4), parameter :: d(*) = [4_"abc",4_"def"] + real, parameter :: r(*) = [1.,2.,3.] + class(*), allocatable :: y(:) + + call foo1 (c, y) + select type (y) + type is (character(*)) +! print *, ">",y(2)(1:3),"< >", c(2)(1:3), "<" + if (any (y /= c)) stop 11 + if (y(2)(1:3) /= c(2)(1:3)) stop 12 + class default + stop 13 + end select + + call foo1 (r, y) + select type (y) + type is (real) + if (any (y /= r)) stop 14 + class default + stop 15 + end select + + call foo1 (d, y) + select type (y) + type is (character(*,kind=4)) +! print *, ">",y(2)(2:3),"< >", d(2)(2:3), "<" + if (any (y /= d)) stop 16 + class default + stop 17 + end select + end subroutine + ! + subroutine foo1 (a, b) + class(*), intent(in) :: a(:) + class(*), allocatable :: b(:) + b = a + end subroutine + + ! Rank-2 tests + subroutine run2 () + character(7) :: c(2,3) + complex :: z(3,3) + integer :: i, j + class(*), allocatable :: y(:,:) + + c = reshape (['fubar11','snafu21',& + 'fubar12','snafu22',& + 'fubar13','snafu23'],shape(c)) + call foo2 (c, y) + select type (y) + type is (character(*)) +! print *, y(2,1) + if (y(2,1) /= c(2,1)) stop 21 + if (any (y /= c)) stop 22 + class default + stop 23 + end select + + do j = 1, size (z,2) + do i = 1, size (z,1) + z(i,j) = cmplx (i,j) + end do + end do + call foo2 (z, y) + select type (y) + type is (complex) +! print *, y(2,1) + if (any (y%re /= z%re)) stop 24 + if (any (y%im /= z%im)) stop 25 + class default + stop 26 + end select + end subroutine + ! + subroutine foo2 (a, b) + class(*), intent(in) :: a(:,:) + class(*), allocatable :: b(:,:) + b = a + end subroutine + +end program -- 2.35.3