From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mail-wr1-x430.google.com (mail-wr1-x430.google.com [IPv6:2a00:1450:4864:20::430]) by sourceware.org (Postfix) with ESMTPS id 69C44386102F; Fri, 16 Apr 2021 18:38:39 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 69C44386102F Received: by mail-wr1-x430.google.com with SMTP id w4so23869456wrt.5; Fri, 16 Apr 2021 11:38:39 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:to:from:subject:message-id:date:user-agent :mime-version:content-language; bh=x5uMeiTvrckPYowSv4WgAcuX8078C8tgzIewJfffDmA=; b=s20vt+xYf+2Ps2PCP1rgtjqpurupWckqFqu4RWQTEKPljPqdEBKrVXYbo118zGf0C8 XvUzDIt0uOuf7apgRBEwQ8mLnE8KyRKJi9EN1+IXhUPNU6dk6djKqIQyzJxV2A+PIOvL Nj21Mto76HPCUcD3/iin0b0/7CdrIDsG4amZg8PyRlWGHjsaCgEVP8Fd06VPNkvnRZhS ECA63G8G/5Jbgvvq4riClINvYxlSbYA4VEkFqShE7gTTayFKa7qvLH+Ln1qcnqDqJfGs nvlcD92QwqO56lAx0uMKvneqruZDIL6FWt5PIwT6jmvV67RV/lM1A1TDuKG3a+FXP8EO 6Ajg== X-Gm-Message-State: AOAM533d50D4cShUR4ouk80U3UkLXJ5vEWEFL5ykdCLFi9Kro53tYKGX eEA3J+RrzghGhXY8Cx+9rW1vT0FyCI4= X-Google-Smtp-Source: ABdhPJzIec0z/GSUK4dmhgeQ9Nnfxw1NFZHNtfWZc8Xw8kcd5uBN+sN+XTkIN7Sq6mVTJz+9WqxFNg== X-Received: by 2002:a5d:47ad:: with SMTP id 13mr610571wrb.56.1618598318471; Fri, 16 Apr 2021 11:38:38 -0700 (PDT) Received: from ?IPv6:2001:8a0:7d5c:3000:d08d:aa39:36d3:d458? ([2001:8a0:7d5c:3000:d08d:aa39:36d3:d458]) by smtp.googlemail.com with ESMTPSA id o12sm3557839wmq.21.2021.04.16.11.38.36 (version=TLS1_3 cipher=TLS_AES_128_GCM_SHA256 bits=128/128); Fri, 16 Apr 2021 11:38:37 -0700 (PDT) To: fortran@gcc.gnu.org, gcc-patches@gcc.gnu.org From: =?UTF-8?Q?Jos=c3=a9_Rui_Faustino_de_Sousa?= Subject: [Patch, fortran v2] PR fortran/84006, PR fortran/100027 - ICE on storage_size with polymorphic argument Message-ID: Date: Fri, 16 Apr 2021 18:38:36 +0000 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:68.0) Gecko/20100101 Thunderbird/68.10.0 MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="------------58946BFF0FC8C2490EFE5297" Content-Language: en-US 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_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Fri, 16 Apr 2021 18:38:41 -0000 This is a multi-part message in MIME format. --------------58946BFF0FC8C2490EFE5297 Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 8bit Hi All! Proposed patch to: PR84006 - [8/9/10/11 Regression] ICE in storage_size() with CLASS entity PR100027 - ICE on storage_size with polymorphic argument Patch tested only on x86_64-pc-linux-gnu. Add branch to if clause to handle polymorphic objects, not sure if I got all possible variations... Now with a new and extended test. Thank you very much. Best regards, José Rui Fortran: Fix ICE using storage_size intrinsic [PR84006, PR100027] gcc/fortran/ChangeLog: PR fortran/84006 PR fortran/100027 * trans-intrinsic.c (gfc_conv_intrinsic_storage_size): add if clause branch to handle polymorphic objects. gcc/testsuite/ChangeLog: PR fortran/84006 * gfortran.dg/PR84006.f90: New test. PR fortran/100027 * gfortran.dg/PR100027.f90: New test. --------------58946BFF0FC8C2490EFE5297 Content-Type: text/x-patch; charset=UTF-8; name="PR100027v2.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="PR100027v2.patch" diff --git a/configure b/configure index 504f6410274..1be51708c03 100755 --- a/configure +++ b/configure @@ -756,6 +756,7 @@ infodir docdir oldincludedir includedir +runstatedir localstatedir sharedstatedir sysconfdir @@ -922,6 +923,7 @@ datadir='${datarootdir}' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' +runstatedir='${localstatedir}/run' includedir='${prefix}/include' oldincludedir='/usr/include' docdir='${datarootdir}/doc/${PACKAGE}' @@ -1174,6 +1176,15 @@ do | -silent | --silent | --silen | --sile | --sil) silent=yes ;; + -runstatedir | --runstatedir | --runstatedi | --runstated \ + | --runstate | --runstat | --runsta | --runst | --runs \ + | --run | --ru | --r) + ac_prev=runstatedir ;; + -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \ + | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \ + | --run=* | --ru=* | --r=*) + runstatedir=$ac_optarg ;; + -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ @@ -1311,7 +1322,7 @@ fi for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ datadir sysconfdir sharedstatedir localstatedir includedir \ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ - libdir localedir mandir + libdir localedir mandir runstatedir do eval ac_val=\$$ac_var # Remove trailing slashes. @@ -1471,6 +1482,7 @@ Fine tuning of the installation directories: --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] + --runstatedir=DIR modifiable per-process data [LOCALSTATEDIR/run] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 5e53d1162fa..6536c121f2b 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -8353,10 +8353,16 @@ gfc_conv_intrinsic_storage_size (gfc_se *se, gfc_expr *expr) if (arg->ts.type == BT_CLASS) { if (arg->rank > 0) - tmp = gfc_class_vtab_size_get ( - GFC_DECL_SAVED_DESCRIPTOR (arg->symtree->n.sym->backend_decl)); + { + if (TREE_CODE (argse.expr) == COMPONENT_REF) + tmp = TREE_OPERAND (argse.expr, 0); + else + tmp = GFC_DECL_SAVED_DESCRIPTOR ( + arg->symtree->n.sym->backend_decl); + } else - tmp = gfc_class_vtab_size_get (TREE_OPERAND (argse.expr, 0)); + tmp = TREE_OPERAND (argse.expr, 0); + tmp = gfc_class_vtab_size_get (tmp); tmp = fold_convert (result_type, tmp); goto done; } diff --git a/gcc/testsuite/gfortran.dg/PR100027.f90 b/gcc/testsuite/gfortran.dg/PR100027.f90 new file mode 100644 index 00000000000..4cee549d055 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR100027.f90 @@ -0,0 +1,425 @@ +! { dg-do run } +! +! Test fix for PR100027 +! +! in colaboration with Tobias Burnus. +! + +program main_p + + implicit none + + integer, parameter :: n = 111 + + integer, parameter :: ikind = kind(n) + integer, parameter :: bsize = 8 + integer, parameter :: isize = bit_size(n) + integer, parameter :: dsize = (n+1)*isize + + type :: foo_t + integer :: i + end type foo_t + + type, extends(foo_t) :: bar_t + integer :: j(n) + end type bar_t + + type :: box_t + class(foo_t), allocatable :: x, y(:) + end type box_t + + integer, target :: ain(n) + type(foo_t), target :: afd(n) + type(bar_t), target :: abd(n) + type(box_t), target :: afx(n) + type(box_t), target :: abx(n) + ! + class(*), pointer :: spu + class(*), pointer :: apu(:) + ! + class(foo_t), pointer :: spf + class(foo_t), pointer :: apf(:) + ! + class(bar_t), pointer :: spb + class(bar_t), pointer :: apb(:) + ! + class(box_t), pointer :: spx + class(box_t), pointer :: apx(:) + ! + integer :: i, j, so, ss + + ain = [(i, i=1,n)] + afd%i = ain + abd%i = ain + do i = 1, n + allocate(foo_t::afx(i)%x, afx(i)%y(n)) + allocate(bar_t::abx(i)%x, abx(i)%y(n)) + abd(i)%j = ain + afx(i)%x%i = ain(i) + afx(i)%y%i = ain + abx(i)%x%i = ain(i) + select type(x=>abx(i)%x) + type is(bar_t) + x%j = ain + class default + stop 1 + end select + abx(i)%y%i = ain + select type(y=>abx(i)%y) + type is(bar_t) + do j = 1, n + y(j)%j = ain + end do + class default + stop 2 + end select + end do + ! integer + so = bsize * int(sizeof(ain), kind=ikind) / n + if (so/=isize) stop 3 + ss = storage_size(ain) + if (so/=ss) stop 4 + call size_u(ain, n, 1) + ! + so = bsize * int(sizeof(ain(n)), kind=ikind) + if (so/=isize) stop 5 + ss = storage_size(ain(n)) + if (so/=ss) stop 6 + call size_u(ain(n), 1, 1) + ! foo_t + so = bsize * int(sizeof(afd), kind=ikind) / n + if (so/=isize) stop 7 + ss = storage_size(afd) + if (so/=ss) stop 8 + call size_u(afd, n, 1) + call size_f(afd, n, 1) + ! + so = bsize * int(sizeof(afd(n)), kind=ikind) + if (so/=isize) stop 9 + ss = storage_size(afd(n)) + if (so/=ss) stop 10 + call size_u(afd(n), 1, 1) + call size_f(afd(n), 1, 1) + ! bar_t + so = bsize * int(sizeof(abd), kind=ikind) / n + if (so/=dsize) stop 11 + ss = storage_size(abd) + if (so/=ss) stop 12 + call size_u(abd, n, n+1) + call size_f(abd, n, n+1) + call size_b(abd, n, n+1) + ! + so = bsize * int(sizeof(abd(n)), kind=ikind) + if (so/=dsize) stop 13 + ss = storage_size(abd(n)) + if (so/=ss) stop 14 + call size_u(abd(n), 1, n+1) + call size_f(abd(n), 1, n+1) + call size_b(abd(n), 1, n+1) + ! box_t + so = bsize * int(sizeof(afx(n)%x), kind=ikind) + if (so/=isize) stop 15 + ss = storage_size(afx(n)%x) + if (so/=ss) stop 16 + call size_u(afx(n)%x, 1, 1) + call size_f(afx(n)%x, 1, 1) + ! + ! see PR100118 + ! so = bsize * int(sizeof(afx(n)%y), kind=ikind) / n + so = bsize * 4 + if (so/=isize) stop 17 + ss = storage_size(afx(n)%y) + if (so/=ss) stop 18 + call size_u(afx(n)%y, n, 1) + call size_f(afx(n)%y, n, 1) + ! + so = bsize * int(sizeof(abx(n)%x), kind=ikind) + if (so/=dsize) stop 19 + ss = storage_size(abx(n)%x) + if (so/=ss) stop 20 + call size_u(abx(n)%x, 1, n+1) + call size_f(abx(n)%x, 1, n+1) + select type(x=>abx(n)%x) + type is(bar_t) + call size_b(x, 1, n+1) + class default + stop 21 + end select + ! + ! see PR100118 + ! so = bsize * int(sizeof(abx(n)%y), kind=ikind) / n + so = bsize * 4 * (n+1) + if (so/=dsize) stop 22 + ss = storage_size(abx(n)%y) + if (so/=ss) stop 23 + call size_u(abx(n)%y, n, n+1) + call size_f(abx(n)%y, n, n+1) + select type(y=>abx(n)%y) + type is(bar_t) + call size_b(y, n, n+1) + class default + stop 24 + end select + ! + so = bsize * int(sizeof(abx(n)%x), kind=ikind) + if (so/=dsize) stop 25 + ss = storage_size(abx(n)%x) + if (so/=ss) stop 26 + call size_u(abx(n)%x, 1, n+1) + call size_f(abx(n)%x, 1, n+1) + select type(x=>abx(n)%x) + type is(bar_t) + call size_b(x, 1, n+1) + class default + stop 27 + end select + ! + ! see PR100118 + ! so = bsize * int(sizeof(abx(n)%y), kind=ikind) / n + so = bsize * 4 * (n+1) + if (so/=dsize) stop 28 + ss = storage_size(abx(n)%y) + if (so/=ss) stop 29 + call size_u(abx(n)%y, n, n+1) + call size_f(abx(n)%y, n, n+1) + select type(y=>abx(n)%y) + type is(bar_t) + call size_b(y, n, n+1) + class default + stop 30 + end select + ! + ! unlimited on integer + apu => ain + so = bsize * int(sizeof(apu), kind=ikind) / n + if (so/=isize) stop 31 + ss = storage_size(apu) + if (so/=ss) stop 32 + call size_u(apu, n, 1) + ! + spu => ain(n) + so = bsize * int(sizeof(spu), kind=ikind) + if (so/=isize) stop 33 + ss = storage_size(spu) + if (so/=ss) stop 34 + call size_u(spu, 1, 1) + ! unlimited on foo_t + apu => afd + so = bsize * int(sizeof(apu), kind=ikind) / n + if (so/=isize) stop 35 + ss = storage_size(apu) + if (so/=ss) stop 36 + call size_u(apu, n, 1) + ! + spu => afd(n) + so = bsize * int(sizeof(spu), kind=ikind) + if (so/=isize) stop 37 + ss = storage_size(spu) + if (so/=ss) stop 38 + call size_u(spu, 1, 1) + ! unlimited on bar_t + apu => abd + so = bsize * int(sizeof(apu), kind=ikind) / n + if (so/=dsize) stop 39 + ss = storage_size(apu) + if (so/=ss) stop 40 + call size_u(apu, n, n+1) + ! + spu => abd(n) + so = bsize * int(sizeof(spu), kind=ikind) + if (so/=dsize) stop 41 + ss = storage_size(spu) + if (so/=ss) stop 42 + call size_u(spu, 1, n+1) + ! foo_t on foo_t + apf => afd + so = bsize * int(sizeof(apf), kind=ikind) / n + if (so/=isize) stop 43 + ss = storage_size(apf) + if (so/=ss) stop 44 + call size_u(apf, n, 1) + call size_f(apf, n, 1) + ! + spf => afd(n) + so = bsize * int(sizeof(spf), kind=ikind) + if (so/=isize) stop 45 + ss = storage_size(spf) + if (so/=ss) stop 46 + call size_u(spf, 1, 1) + call size_f(spf, 1, 1) + ! foo_t on bar_t + apf => abd + so = bsize * int(sizeof(apf), kind=ikind) / n + if (so/=dsize) stop 47 + ss = storage_size(apf) + if (so/=ss) stop 48 + call size_u(apf, n, n+1) + call size_f(apf, n, n+1) + ! + spf => abd(n) + so = bsize * int(sizeof(spf), kind=ikind) + if (so/=dsize) stop 11 + ss = storage_size(spf) + if (so/=ss) stop 49 + call size_u(spf, 1, n+1) + call size_f(spf, 1, n+1) + ! bar_t on bar_t + apb => abd + so = bsize * int(sizeof(apb), kind=ikind) / n + if (so/=dsize) stop 50 + ss = storage_size(apb) + if (so/=ss) stop 51 + call size_u(apb, n, n+1) + call size_f(apb, n, n+1) + call size_b(apb, n, n+1) + ! + spb => abd(n) + so = bsize * int(sizeof(spb), kind=ikind) + if (so/=dsize) stop 52 + ss = storage_size(spb) + if (so/=ss) stop 53 + call size_u(spb, 1, n+1) + call size_f(spb, 1, n+1) + call size_b(spb, 1, n+1) + ! box_t on box_t + apx => afx + ! see PR100118 + ! so = bsize * int(sizeof(apx(n)%x), kind=ikind) + so = bsize * 4 + if (so/=isize) stop 54 + ss = storage_size(apx(n)%x) + if (so/=ss) stop 55 + call size_u(apx(n)%x, 1, 1) + call size_f(apx(n)%x, 1, 1) + ! + ! see PR100118 + ! so = bsize * int(sizeof(apx(n)%y), kind=ikind) / n + so = bsize * 4 + if (so/=isize) stop 56 + ss = storage_size(apx(n)%y) + if (so/=ss) stop 57 + call size_u(apx(n)%y, n, 1) + call size_f(apx(n)%y, n, 1) + ! + spx => afx(n) + ! see PR100118 + ! so = bsize * int(sizeof(spx%x), kind=ikind) + so = bsize * 4 + if (so/=isize) stop 58 + ss = storage_size(spx%x) + if (so/=ss) stop 59 + call size_u(spx%x, 1, 1) + call size_f(spx%x, 1, 1) + ! + ! see PR100118 + ! so = bsize * int(sizeof(spx%y), kind=ikind) / n + so = bsize * 4 + if (so/=isize) stop 60 + ss = storage_size(spx%y) + if (so/=ss) stop 61 + call size_u(spx%y, n, 1) + call size_f(spx%y, n, 1) + ! + apx => abx + ! see PR100118 + ! so = bsize * int(sizeof(apx(n)%x), kind=ikind) + so = bsize * 4 * (n+1) + if (so/=dsize) stop 62 + ss = storage_size(apx(n)%x) + if (so/=ss) stop 63 + call size_u(apx(n)%x, 1, n+1) + call size_f(apx(n)%x, 1, n+1) + select type(x=>apx(n)%x) + type is(bar_t) + call size_b(x, 1, n+1) + class default + stop 64 + end select + ! + ! see PR100118 + ! so = bsize * int(sizeof(apx(n)%y), kind=ikind) / n + so = bsize * 4 * (n+1) + if (so/=dsize) stop 65 + ss = storage_size(apx(n)%y) + if (so/=ss) stop 65 + call size_u(apx(n)%y, n, n+1) + call size_f(apx(n)%y, n, n+1) + select type(y=>apx(n)%y) + type is(bar_t) + call size_b(y, n, n+1) + class default + stop 66 + end select + ! + spx => abx(n) + ! see PR100118 + ! so = bsize * int(sizeof(spx%x), kind=ikind) + so = bsize * 4 * (n+1) + if (so/=dsize) stop 67 + ss = storage_size(spx%x) + if (so/=ss) stop 68 + call size_u(spx%x, 1, n+1) + call size_f(spx%x, 1, n+1) + select type(x=>spx%x) + type is(bar_t) + call size_b(x, 1, n+1) + class default + stop 69 + end select + ! + ! see PR100118 + ! so = bsize * int(sizeof(spx%y), kind=ikind) / n + so = bsize * 4 * (n+1) + if (so/=dsize) stop 25 + ss = storage_size(spx%y) + if (so/=ss) stop 70 + call size_u(spx%y, n, n+1) + call size_f(spx%y, n, n+1) + select type(y=>spx%y) + type is(bar_t) + call size_b(y, n, n+1) + class default + stop 71 + end select + + stop + +contains + + subroutine size_u(a, n, m) + class(*), intent(in) :: a(..) + integer, intent(in) :: n + integer, intent(in) :: m + + so = bsize * int(sizeof(a), kind=ikind) / n + if (so/=m*isize) stop 100 + ss = storage_size(a) + if (so/=ss) stop 101 + return + end subroutine size_u + + subroutine size_f(a, n, m) + class(foo_t), intent(in) :: a(..) + integer, intent(in) :: n + integer, intent(in) :: m + + so = bsize * int(sizeof(a), kind=ikind) / n + if (so/=m*isize) stop 102 + ss = storage_size(a) + if (so/=ss) stop 103 + return + end subroutine size_f + + subroutine size_b(a, n, m) + class(bar_t), intent(in) :: a(..) + integer, intent(in) :: n + integer, intent(in) :: m + + so = bsize * int(sizeof(a), kind=ikind) / n + if (so/=m*isize) stop 104 + ss = storage_size(a) + if (so/=ss) stop 105 + return + end subroutine size_b + +end program main_p diff --git a/gcc/testsuite/gfortran.dg/PR84006.f90 b/gcc/testsuite/gfortran.dg/PR84006.f90 new file mode 100644 index 00000000000..41e2161b6e5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/PR84006.f90 @@ -0,0 +1,12 @@ +! { dg-do run } +! + +program p + type t + integer i + end type + integer rslt + class(t), allocatable :: t_alloc(:) + allocate (t_alloc(10), source=t(1)) + rslt = storage_size(t_alloc) +end program p --------------58946BFF0FC8C2490EFE5297--