From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mout.gmx.net (mout.gmx.net [212.227.15.15]) by sourceware.org (Postfix) with ESMTPS id 8BB4B3858421; Mon, 13 Dec 2021 20:27:20 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 8BB4B3858421 X-UI-Sender-Class: 01bb95c1-4bf8-414a-932a-4f6e2808ef9c Received: from gluon.fritz.box ([79.251.14.92]) by mail.gmx.net (mrgmx005 [212.227.17.190]) with ESMTPSA (Nemesis) id 1MUXtS-1n5hcU0eeG-00QTTg; Mon, 13 Dec 2021 21:27:18 +0100 Subject: Re: [PATCH, v2] PR libfortran/103634 - Runtime crash with PACK on zero-sized arrays To: Mikael Morin , fortran , gcc-patches Newsgroups: gmane.comp.gcc.patches,gmane.comp.gcc.fortran References: <6c67790c-bda2-299b-a253-dc96bb11fea0@orange.fr> From: Harald Anlauf Message-ID: <44f97688-e1be-e23e-9480-7fc78b3b6d78@gmx.de> Date: Mon, 13 Dec 2021 21:27:17 +0100 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101 Thunderbird/78.12.0 MIME-Version: 1.0 In-Reply-To: Content-Type: multipart/mixed; boundary="------------56B0BEDE8C9BA91A57FF392C" Content-Language: en-US X-Provags-ID: V03:K1:q/Pu3EBz4Whpz+SmhXrU0RI4Yljii0QI1ZdbyNfWTDXOJYEYj/O 2wNcSc91qxk3picdKmn3kaaiXRA14E1ipmGNStMiTSfJ+A+CYZQvfqjihx4pgoe8Dcg4afe I3H7+MEW40IfWCZb0Rk2oT67d05iSJUxvWH+QlTkq+XjUdWq4EZBDZdfTWARhYdLHKJdQt7 iWr2vHynMZcm/cUyPLbGw== X-UI-Out-Filterresults: notjunk:1;V03:K0:KEt8/UhXHZI=:6Lfl+5B6q3QZzFh2qccy4D KvlQ8EdfZqch89jEpv//985V2Oz7LF1LrCzZ79DtV9F6It0pfmFBp8gJX0Vkju2COwIRcd9Ji h1l6kbtMzWqVtWFj95lbcBmGgKjmLOw3WMzMPCYSPnQts4QJURncIya1fOh/H+/nV0yQEFCul EttZ/0RlBAsffatRaaNkG0EQOsQe82IzbYsk/TEYPGZGSU53b4GAMm9LrCcjLKpYHvNPurzYJ u58m+tigLb8ZG8Mn6nuyWnzPZv5qDV+RCrAtNrw5Z9dxQoJNCo/bmTMHXU37C3YoODcZuPZ8b r1SDQqdjvKLXYtBNgHTKJLZ4ANrvkMfXFM8RCJ+58Iv9ZxIyWZNBFPTD2B0HRtkLnhPe2wTC7 PFNcBOU/cyrzSDK2evFG8V2Xz4rX5S6rhCRo+LiUj8Q7b23vqTGuH/c7EASM+7ifzEA+Wkmct 3Be9jgornEgeuNwsOxmQt+MBxJO8IDmmJ7NUSXS44Sl/vq2w36Wsl9KlVHzk+NXcNQlegL3xN W9z9j72hnbk2Z/4ZX01c+AqN8gHHYtH/LszmG3DluSTrNJtISk/ENp2hl8G8I0ktNVLxD7E9w ARx57slVjGTrPmczhes7zHPo7uGst2C6HCB+1qiYhPxHB5hoFVwijhaveYnKpkfpQzhKmXnTK s84NZoEVgI/DAEQfxQOkDU0K0G4BzqZQA1Ymmtkvw9AK6TTC0x/wwmNFFL7R9DLuA6Y0fobq/ 10RGUA5zGRpth4UJa904U2a5kSLQvmSUX4+EW+tQBoWZm1yfx5eBTg+Gd9H7r4KqXNVRuKwOw f88GEMQGaohW7Lie6TYQ70lC+Srv9nqPxu7Jro5kQxqkPmhcLctOEGh2B3ttvOnUx6ZPPq1PU 9OGW1wW7uqTF8BqUNwuKkY2/zovqpJmZv3F0XCRX7ExoypiDsu5IBUlZc7gEsBsC7DJmE3pBb oTTCkMiJS//054kVO3gsLNlq3g0Wkgc+7Q4XpgjUM8gUHlUvo0FfKAK6LCZ9125GTEe5P2/c3 VRSptsfTtYZkyUCO2HykBz+c2jkA7A194eSq9RrG2lr1kgbBkUQCnxMQ6Bnu84xHJMDrSn0Ww FmW0lkazvivvmg= X-Spam-Status: No, score=-13.8 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, FREEMAIL_FROM, GIT_PATCH_0, NICE_REPLY_A, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H2, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on server2.sourceware.org X-BeenThere: fortran@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Fortran mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Mon, 13 Dec 2021 20:27:22 -0000 This is a multi-part message in MIME format. --------------56B0BEDE8C9BA91A57FF392C Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: quoted-printable Works better with patch attached... Am 13.12.21 um 21:25 schrieb Harald Anlauf via Gcc-patches: > Hi Mikael, > > Am 09.12.21 um 21:37 schrieb Mikael Morin: >> Hello, >> >> On 09/12/2021 21:05, Harald Anlauf via Fortran wrote: >>> Dear all, >>> >>> I had thought that we had fixed this in the past (see PR31001), >>> but it did fail for me with all gcc versions I have tried (7-12) >>> for a slightly more elaborate case as in the old testcase. >>> >>> The loop in pack_internal did try to access the first element of >>> the array argument to PACK even if one (or more) extents were zero. >>> This is not good. >>> >>> Solution: check the extents and return early.=C2=A0 (We already do a >>> related check for the vector argument if present). >> >> If there is a vector argument, aren=E2=80=99t we supposed to copy it to= the >> result ? >> There is something else to pay attention for, the early return should >> come at least after the return array bounds have been set.=C2=A0 In the >> testcase an array with the correct bounds has been allocated beforehand >> to hold the return value, but it=E2=80=99s not always the case. > > you are absolutely right, I had gotten that wrong. > >> For what it=E2=80=99s worth, the non-generic variant in pack.m4 (or in >> pack_{i,f,c}{1,2,4,8,10,16}.c) has a zero extent check and it clears th= e >> source ptr in that case, which makes it setup the return array and then >> jump to the vector copy at the end of the function. >> > > The code is so similar (for good reason) that it makes sense to keep > it synchronous.=C2=A0 I added code for 'zero_sized' array with the minor > difference that I made it boolean instead of integer. > > I also extended the testcase so that it exercises PACK/pack_internal > a little, for argument 'vector' present as well as not.=C2=A0 (There are > existing tests for intrinsic types, but not for the issue at hand). > > Regtested again, and checked the testcase (against other compilers > and also with valgrind). > > OK now? > > Thanks, > Harald > --------------56B0BEDE8C9BA91A57FF392C Content-Type: text/x-patch; charset=UTF-8; name="0001-Fortran-PACK-intrinsic-should-not-try-to-read-from-z.patch" Content-Transfer-Encoding: quoted-printable Content-Disposition: attachment; filename*0="0001-Fortran-PACK-intrinsic-should-not-try-to-read-from-z.pa"; filename*1="tch" =46rom f6879cdcc1de83c86eb47bfae33d06fd00f51a99 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Mon, 13 Dec 2021 20:50:19 +0100 Subject: [PATCH] Fortran: PACK intrinsic should not try to read from zero-sized array libgfortran/ChangeLog: PR libfortran/103634 * intrinsics/pack_generic.c (pack_internal): Handle case when the array argument of PACK has one or more extents of size zero to avoid invalid reads. gcc/testsuite/ChangeLog: PR libfortran/103634 * gfortran.dg/intrinsic_pack_6.f90: New test. =2D-- .../gfortran.dg/intrinsic_pack_6.f90 | 57 +++++++++++++++++++ libgfortran/intrinsics/pack_generic.c | 9 +++ 2 files changed, 66 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/intrinsic_pack_6.f90 diff --git a/gcc/testsuite/gfortran.dg/intrinsic_pack_6.f90 b/gcc/testsuit= e/gfortran.dg/intrinsic_pack_6.f90 new file mode 100644 index 00000000000..917944d8846 =2D-- /dev/null +++ b/gcc/testsuite/gfortran.dg/intrinsic_pack_6.f90 @@ -0,0 +1,57 @@ +! { dg-do run } +! PR libfortran/103634 - Runtime crash with PACK on zero-sized arrays +! Exercise PACK intrinsic for cases when it calls pack_internal + +program p + implicit none + type t + real :: r(24) =3D -99. + end type + type(t), allocatable :: new(:), old(:), vec(:) + logical, allocatable :: mask(:) + integer :: n, m +! m =3D 1 ! works + m =3D 0 ! failed with SIGSEGV in pack_internal + do m =3D 0, 2 + print *, m + allocate (old(m), mask(m), vec(m)) + if (m > 0) vec(m)% r(1) =3D 42 + mask(:) =3D .true. + n =3D count (mask) + allocate (new(n)) + + mask(:) =3D .false. + if (size (pack (old, mask)) /=3D 0) stop 1 + mask(:) =3D .true. + if (size (pack (old, mask)) /=3D m) stop 2 + new(:) =3D pack (old, mask) ! this used to segfault for= m=3D0 + + mask(:) =3D .false. + if (size (pack (old, mask, vector=3Dvec)) /=3D m) stop 3 + new(:) =3D t() + new(:) =3D pack (old, mask, vector=3Dvec) ! this used to segfault f= or m=3D0 + if (m > 0) then + if ( new( m )% r(1) /=3D 42) stop 4 + if (any (new(:m-1)% r(1) /=3D -99)) stop 5 + end if + + if (m > 0) mask(m) =3D .true. + if (size (pack (old, mask, vector=3Dvec)) /=3D m) stop 6 + new(:) =3D t() + new(:) =3D pack (old, mask, vector=3Dvec) ! this used to segfault f= or m=3D0 + if (m > 0) then + if (new(1)% r(1) /=3D -99) stop 7 + end if + if (m > 1) then + if (new(m)% r(1) /=3D 42) stop 8 + end if + + if (size (pack (old(:0), mask(:0), vector=3Dvec)) /=3D m) stop 9 + new(:) =3D t() + new(:) =3D pack (old(:0), mask(:0), vector=3Dvec) ! did segfault for= m=3D0 + if (m > 0) then + if (new(m)% r(1) /=3D 42) stop 10 + end if + deallocate (old, mask, new, vec) + end do +end diff --git a/libgfortran/intrinsics/pack_generic.c b/libgfortran/intrinsic= s/pack_generic.c index cad2fbbfbcd..15880e74348 100644 =2D-- a/libgfortran/intrinsics/pack_generic.c +++ b/libgfortran/intrinsics/pack_generic.c @@ -85,6 +85,7 @@ pack_internal (gfc_array_char *ret, const gfc_array_char= *array, index_type count[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS]; + bool zero_sized; index_type n; index_type dim; index_type nelem; @@ -114,10 +115,13 @@ pack_internal (gfc_array_char *ret, const gfc_array_= char *array, else runtime_error ("Funny sized logical array"); + zero_sized =3D false; for (n =3D 0; n < dim; n++) { count[n] =3D 0; extent[n] =3D GFC_DESCRIPTOR_EXTENT(array,n); + if (extent[n] <=3D 0) + zero_sized =3D true; sstride[n] =3D GFC_DESCRIPTOR_STRIDE_BYTES(array,n); mstride[n] =3D GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } @@ -126,6 +130,11 @@ pack_internal (gfc_array_char *ret, const gfc_array_c= har *array, if (mstride[0] =3D=3D 0) mstride[0] =3D mask_kind; + if (zero_sized) + sptr =3D NULL; + else + sptr =3D array->base_addr; + if (ret->base_addr =3D=3D NULL || unlikely (compile_options.bounds_chec= k)) { /* Count the elements, either for allocating memory or =2D- 2.26.2 --------------56B0BEDE8C9BA91A57FF392C-- From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from ciao.gmane.io (ciao.gmane.io [116.202.254.214]) by sourceware.org (Postfix) with ESMTPS id 37EB5385840F for ; Mon, 13 Dec 2021 20:30:03 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 37EB5385840F Received: from list by ciao.gmane.io with local (Exim 4.92) (envelope-from ) id 1mwrxS-0007KH-BW for fortran@gcc.gnu.org; Mon, 13 Dec 2021 21:30:02 +0100 X-Injected-Via-Gmane: http://gmane.org/ To: fortran@gcc.gnu.org From: Harald Anlauf Subject: Re: [PATCH, v2] PR libfortran/103634 - Runtime crash with PACK on zero-sized arrays Date: Mon, 13 Dec 2021 21:27:17 +0100 Message-ID: <44f97688-e1be-e23e-9480-7fc78b3b6d78@gmx.de> References: <6c67790c-bda2-299b-a253-dc96bb11fea0@orange.fr> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="------------56B0BEDE8C9BA91A57FF392C" User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101 Thunderbird/78.12.0 In-Reply-To: Content-Language: en-US Cc: gcc-patches@gcc.gnu.org X-Spam-Status: No, score=-11.0 required=5.0 tests=BAYES_00, FREEMAIL_FORGED_FROMDOMAIN, FREEMAIL_FROM, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, NICE_REPLY_A, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on server2.sourceware.org X-BeenThere: fortran@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Fortran mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Mon, 13 Dec 2021 20:30:05 -0000 Message-ID: <20211213202717.TKErJ3bUriCam5cmU8xeNvGDuRU759R5yIcPXcnWjvE@z> This is a multi-part message in MIME format. --------------56B0BEDE8C9BA91A57FF392C Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 8bit Works better with patch attached... Am 13.12.21 um 21:25 schrieb Harald Anlauf via Gcc-patches: > Hi Mikael, > > Am 09.12.21 um 21:37 schrieb Mikael Morin: >> Hello, >> >> On 09/12/2021 21:05, Harald Anlauf via Fortran wrote: >>> Dear all, >>> >>> I had thought that we had fixed this in the past (see PR31001), >>> but it did fail for me with all gcc versions I have tried (7-12) >>> for a slightly more elaborate case as in the old testcase. >>> >>> The loop in pack_internal did try to access the first element of >>> the array argument to PACK even if one (or more) extents were zero. >>> This is not good. >>> >>> Solution: check the extents and return early.  (We already do a >>> related check for the vector argument if present). >> >> If there is a vector argument, aren’t we supposed to copy it to the >> result ? >> There is something else to pay attention for, the early return should >> come at least after the return array bounds have been set.  In the >> testcase an array with the correct bounds has been allocated beforehand >> to hold the return value, but it’s not always the case. > > you are absolutely right, I had gotten that wrong. > >> For what it’s worth, the non-generic variant in pack.m4 (or in >> pack_{i,f,c}{1,2,4,8,10,16}.c) has a zero extent check and it clears the >> source ptr in that case, which makes it setup the return array and then >> jump to the vector copy at the end of the function. >> > > The code is so similar (for good reason) that it makes sense to keep > it synchronous.  I added code for 'zero_sized' array with the minor > difference that I made it boolean instead of integer. > > I also extended the testcase so that it exercises PACK/pack_internal > a little, for argument 'vector' present as well as not.  (There are > existing tests for intrinsic types, but not for the issue at hand). > > Regtested again, and checked the testcase (against other compilers > and also with valgrind). > > OK now? > > Thanks, > Harald > --------------56B0BEDE8C9BA91A57FF392C Content-Type: text/x-patch; charset=UTF-8; name="0001-Fortran-PACK-intrinsic-should-not-try-to-read-from-z.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename*0="0001-Fortran-PACK-intrinsic-should-not-try-to-read-from-z.pa"; filename*1="tch" >From f6879cdcc1de83c86eb47bfae33d06fd00f51a99 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Mon, 13 Dec 2021 20:50:19 +0100 Subject: [PATCH] Fortran: PACK intrinsic should not try to read from zero-sized array libgfortran/ChangeLog: PR libfortran/103634 * intrinsics/pack_generic.c (pack_internal): Handle case when the array argument of PACK has one or more extents of size zero to avoid invalid reads. gcc/testsuite/ChangeLog: PR libfortran/103634 * gfortran.dg/intrinsic_pack_6.f90: New test. --- .../gfortran.dg/intrinsic_pack_6.f90 | 57 +++++++++++++++++++ libgfortran/intrinsics/pack_generic.c | 9 +++ 2 files changed, 66 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/intrinsic_pack_6.f90 diff --git a/gcc/testsuite/gfortran.dg/intrinsic_pack_6.f90 b/gcc/testsuite/gfortran.dg/intrinsic_pack_6.f90 new file mode 100644 index 00000000000..917944d8846 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/intrinsic_pack_6.f90 @@ -0,0 +1,57 @@ +! { dg-do run } +! PR libfortran/103634 - Runtime crash with PACK on zero-sized arrays +! Exercise PACK intrinsic for cases when it calls pack_internal + +program p + implicit none + type t + real :: r(24) = -99. + end type + type(t), allocatable :: new(:), old(:), vec(:) + logical, allocatable :: mask(:) + integer :: n, m +! m = 1 ! works + m = 0 ! failed with SIGSEGV in pack_internal + do m = 0, 2 + print *, m + allocate (old(m), mask(m), vec(m)) + if (m > 0) vec(m)% r(1) = 42 + mask(:) = .true. + n = count (mask) + allocate (new(n)) + + mask(:) = .false. + if (size (pack (old, mask)) /= 0) stop 1 + mask(:) = .true. + if (size (pack (old, mask)) /= m) stop 2 + new(:) = pack (old, mask) ! this used to segfault for m=0 + + mask(:) = .false. + if (size (pack (old, mask, vector=vec)) /= m) stop 3 + new(:) = t() + new(:) = pack (old, mask, vector=vec) ! this used to segfault for m=0 + if (m > 0) then + if ( new( m )% r(1) /= 42) stop 4 + if (any (new(:m-1)% r(1) /= -99)) stop 5 + end if + + if (m > 0) mask(m) = .true. + if (size (pack (old, mask, vector=vec)) /= m) stop 6 + new(:) = t() + new(:) = pack (old, mask, vector=vec) ! this used to segfault for m=0 + if (m > 0) then + if (new(1)% r(1) /= -99) stop 7 + end if + if (m > 1) then + if (new(m)% r(1) /= 42) stop 8 + end if + + if (size (pack (old(:0), mask(:0), vector=vec)) /= m) stop 9 + new(:) = t() + new(:) = pack (old(:0), mask(:0), vector=vec) ! did segfault for m=0 + if (m > 0) then + if (new(m)% r(1) /= 42) stop 10 + end if + deallocate (old, mask, new, vec) + end do +end diff --git a/libgfortran/intrinsics/pack_generic.c b/libgfortran/intrinsics/pack_generic.c index cad2fbbfbcd..15880e74348 100644 --- a/libgfortran/intrinsics/pack_generic.c +++ b/libgfortran/intrinsics/pack_generic.c @@ -85,6 +85,7 @@ pack_internal (gfc_array_char *ret, const gfc_array_char *array, index_type count[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS]; + bool zero_sized; index_type n; index_type dim; index_type nelem; @@ -114,10 +115,13 @@ pack_internal (gfc_array_char *ret, const gfc_array_char *array, else runtime_error ("Funny sized logical array"); + zero_sized = false; for (n = 0; n < dim; n++) { count[n] = 0; extent[n] = GFC_DESCRIPTOR_EXTENT(array,n); + if (extent[n] <= 0) + zero_sized = true; sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n); mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); } @@ -126,6 +130,11 @@ pack_internal (gfc_array_char *ret, const gfc_array_char *array, if (mstride[0] == 0) mstride[0] = mask_kind; + if (zero_sized) + sptr = NULL; + else + sptr = array->base_addr; + if (ret->base_addr == NULL || unlikely (compile_options.bounds_check)) { /* Count the elements, either for allocating memory or -- 2.26.2 --------------56B0BEDE8C9BA91A57FF392C--