[fortran,v2] PR fortran/84006, PR fortran/100027 - ICE on storage_size with polymorphic argument

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