1! { dg-do run }
2!
3! Test the fix for PR85742 in which the descriptors, passed to alsize,
4! for 'a' and 'b' had the wrong element length.
5!
6! Contributed by Cesar Philippidis  <cesar@gcc.gnu.org>
7!
8program main
9  implicit none
10  integer, allocatable :: a
11  real, pointer :: b
12  integer, allocatable :: am(:,:)
13  real, pointer :: bm(:,:)
14
15  allocate (a)
16  allocate (b)
17  allocate (am(3,3))
18  allocate (bm(4,4))
19
20  if (sizeof (a) /= alsize (a)) stop 1
21  if (sizeof (b) /= alsize (b)) stop 2
22  if (sizeof (am) /= alsize (am)) stop 3
23  if (sizeof (bm) /= alsize (bm)) stop 4
24
25  deallocate (b)
26  deallocate (bm)
27contains
28  function alsize (a)
29    integer alsize
30    type (*), dimension (..), contiguous :: a
31    alsize = sizeof(a)
32  end function
33end program main
34
35