1! { dg-do compile }
2! Test the patch for PR30084 in which the reference to SIZE
3! in function diag caused a segfault in module.c.
4!
5! Contributed by Troban Trumsko <trumsko@yahoo.com>
6! and reduced by Steve Kargl <kargl@gcc.gnu.org>
7!
8module tao_random_numbers
9  integer, dimension(10) :: s_buffer
10  integer :: s_last = size (s_buffer)
11end module tao_random_numbers
12
13module linalg
14  contains
15  function diag (a) result (d)
16    real, dimension(:,:), intent(in) :: a
17    real, dimension(min(size(a,dim=1),size(a,dim=2))) :: d
18    integer :: i
19    do i = 1, min(size(a, dim = 1), size(a, dim = 2))
20       d(i) = a(i,i)
21    end do
22  end function diag
23end module linalg
24
25module vamp_rest
26  use tao_random_numbers
27  use linalg
28end module vamp_rest
29
30  use vamp_rest
31  real :: x(2, 2) = reshape ([1.,2.,3.,4.], [2,2])
32  print *, s_last
33  print *, diag (x)
34end
35