1! { dg-do run }
2! Tests the fix for PR40646 in which the assignment would cause an ICE.
3!
4! Contributed by Charlie Sharpsteen  <chuck@sharpsteen.net>
5! http://gcc.gnu.org/ml/fortran/2009-07/msg00010.html
6! and reported by Tobias Burnus  <burnus@gcc,gnu.org>
7!
8module bugTestMod
9  implicit none
10  type:: boundTest
11  contains
12    procedure, nopass:: test => returnMat
13  end type boundTest
14contains
15  function returnMat( a, b ) result( mat )
16    integer:: a, b, i
17    double precision, dimension(a,b):: mat
18    mat = dble (reshape ([(i, i = 1, a * b)],[a,b]))
19    return
20  end function returnMat
21end module bugTestMod
22
23program bugTest
24  use bugTestMod
25  implicit none
26  integer i
27  double precision, dimension(2,2):: testCatch
28  type( boundTest ):: testObj
29  testCatch = testObj%test(2,2)  ! This would cause an ICE
30  if (any (testCatch .ne. dble (reshape ([(i, i = 1, 4)],[2,2])))) call abort
31end program bugTest
32