1! { dg-do run }
2! { dg-options "-fbounds-check -fno-realloc-lhs" }
3! { dg-shouldfail "Incorrect extent in return value of TRANSPOSE intrinsic in dimension 1: is 2, should be 3" }
4program main
5  implicit none
6  character(len=10) :: in
7  real, dimension(:,:), allocatable :: a,b
8  integer :: ax, ay, bx, by
9
10  in = "2 2 3 2"
11  read (unit=in,fmt='(4I2)') ax, ay, bx, by
12  allocate (a(ax,ay))
13  allocate (b(bx,by))
14  a = 1.0
15  b = 2.1
16  b = transpose(a)
17end program main
18! { dg-output "Fortran runtime error: Array bound mismatch for dimension 1 of array 'b' \\(3/2\\)" }
19