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.
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
