1! { dg-do run }
2! PR 49479 - this used not to print anything.
3! Test case by Joost VandeVondele.
4MODULE M1
5  IMPLICIT NONE
6  type foo
7     character(len=5) :: x
8  end type foo
9CONTAINS
10  SUBROUTINE S1(data)
11    INTEGER, DIMENSION(:), INTENT(IN), &
12         OPTIONAL                               :: DATA
13    character(20) :: line
14    IF (.not. PRESENT(data)) call abort
15    write (unit=line,fmt='(I5)') size(data)
16    if (line /= '    0               ') call abort
17  END SUBROUTINE S1
18
19  subroutine s_type(data)
20    type(foo), dimension(:), intent(in), optional :: data
21    character(20) :: line
22    IF (.not. PRESENT(data)) call abort
23    write (unit=line,fmt='(I5)') size(data)
24    if (line /= '    0               ') call abort
25  end subroutine s_type
26
27  SUBROUTINE S2(N)
28    INTEGER :: N
29    INTEGER, ALLOCATABLE, DIMENSION(:, :)    :: blki
30    type(foo), allocatable, dimension(:, :)  :: bar
31    ALLOCATE(blki(3,N))
32    allocate (bar(3,n))
33    blki=0
34    CALL S1(RESHAPE(blki,(/3*N/)))
35    call s_type(reshape(bar, (/3*N/)))
36  END SUBROUTINE S2
37
38END MODULE M1
39
40USE M1
41CALL S2(0)
42END
43