1! { dg-do run }
2! PR 82995 - segfault passing on an optional argument;
3! this tests the library versions.
4module z
5  implicit none
6contains
7  subroutine sum_1 (input, res, mask)
8    logical, intent(in), optional :: mask(:,:)
9    integer, intent(in) :: input(:,:)
10    integer, dimension(:), intent(out) :: res
11    res = sum (input, dim=1, mask=mask)
12  end subroutine sum_1
13
14  subroutine sum_2 (input, res, mask)
15    logical, intent(in), optional :: mask
16    integer, intent(in) :: input(:,:)
17    integer, dimension(:), intent(out) :: res
18    res = sum (input, dim=1, mask=mask)
19  end subroutine sum_2
20
21  subroutine maxloc_1 (input, res, mask)
22    logical, intent(in), optional :: mask(:,:)
23    integer, intent(in) :: input(:,:)
24    integer, dimension(:), intent(out) :: res
25    res = maxloc (input, dim=1, mask=mask)
26  end subroutine maxloc_1
27
28  subroutine minloc_1 (input, res, mask)
29    logical, intent(in), optional :: mask
30    integer, intent(in) :: input(:,:)
31    integer, dimension(:), intent(out) :: res
32    res = minloc (input, dim=1, mask=mask)
33  end subroutine minloc_1
34
35  subroutine maxloc_2 (input, res, mask)
36    logical, intent(in), optional :: mask(:,:)
37    integer, intent(in) :: input(:,:)
38    integer, dimension(:), intent(out) :: res
39    integer :: n
40    n = 1
41    res = maxloc (input, dim=n, mask=mask)
42  end subroutine maxloc_2
43
44  subroutine findloc_1 (input, val, res, mask)
45    logical, intent(in), optional :: mask(:,:)
46    integer, intent(in) :: input(:,:)
47    integer, dimension(:), intent(out) :: res
48    integer, intent(in) :: val
49    res = findloc(input, val)
50  end subroutine findloc_1
51
52  subroutine findloc_2 (input, val, res, mask)
53    logical, intent(in), optional :: mask
54    integer, intent(in) :: input(:,:)
55    integer, dimension(:), intent(out) :: res
56    integer, intent(in) :: val
57    res = findloc(input, val)
58  end subroutine findloc_2
59
60  subroutine findloc_3 (input, val, res, mask)
61    logical, intent(in), optional :: mask(:,:)
62    integer, intent(in) :: input(:,:)
63    integer, dimension(:), intent(out) :: res
64    integer, intent(in) :: val
65    res = findloc(input, val, dim=1)
66  end subroutine findloc_3
67
68  subroutine findloc_4 (input, val, res, mask)
69    logical, intent(in), optional :: mask(:,:)
70    integer, intent(in) :: input(:,:)
71    integer, dimension(:), intent(out) :: res
72    integer, intent(in) :: val
73    integer :: n = 1
74    res = findloc(input, val, dim=n)
75  end subroutine findloc_4
76
77  subroutine maxval_1 (input, res, mask)
78    logical, intent(in), optional :: mask
79    integer, intent(in) :: input(:,:)
80    integer, dimension(:), intent(out) :: res
81    res = maxval (input, dim=1, mask=mask)
82  end subroutine maxval_1
83
84  subroutine maxval_2 (input, res, mask)
85    logical, intent(in), optional :: mask
86    integer, intent(in) :: input(:,:)
87    integer, dimension(:), intent(out) :: res
88    integer :: n = 1
89    res = maxval (input, dim=n, mask=mask)
90  end subroutine maxval_2
91
92  subroutine minval_1 (input, res, mask)
93    logical, intent(in), optional :: mask(:,:)
94    integer, intent(in) :: input(:,:)
95    integer, dimension(:), intent(out) :: res
96    res = minval (input, dim=1, mask=mask)
97  end subroutine minval_1
98
99  subroutine minval_2 (input, res, mask)
100    logical, intent(in), optional :: mask(:,:)
101    integer, intent(in) :: input(:,:)
102    integer, dimension(:), intent(out) :: res
103    integer :: n = 1
104    res = minval (input, dim=n, mask=mask)
105  end subroutine minval_2
106
107end module z
108
109program main
110  use z
111  implicit none
112  integer :: i2(2,3) = reshape([1,2,4,8,16,32], [2,3])
113  integer, dimension(3) :: res3
114  integer, dimension(2) :: res2
115  call sum_1 (i2, res3)
116  if (any (res3 /= [3, 12, 48])) stop 1
117  res3 = -2
118  call sum_2 (i2, res3)
119  if (any (res3 /= [3, 12, 48])) stop 2
120  call maxloc_1 (i2, res3)
121  if (any (res3 /= 2)) stop 3
122  call minloc_1 (i2, res3)
123  if (any (res3 /= 1)) stop 4
124  call maxloc_2 (i2, res3)
125  if (any (res3 /= 2)) stop 5
126  call findloc_1 (i2, 4, res2)
127  if (any(res2 /= [1,2])) stop 6
128  res2 = -1234
129  call findloc_2 (i2, 4, res2)
130  if (any(res2 /= [1,2])) stop 7
131  call findloc_3 (i2, 4, res3)
132  if (any(res3 /= [0,1,0])) stop 8
133  call findloc_4 (i2, 4, res3)
134  if (any(res3 /= [0,1,0])) stop 9
135  call maxval_1 (i2, res3)
136  if (any (res3 /= [2,8,32])) stop 10
137  call minval_1 (i2, res3)
138  if (any (res3 /= [1,4,16])) stop 11
139  call maxval_2 (i2, res3)
140  if (any (res3 /= [2,8,32])) stop 12
141  call minval_2 (i2, res3)
142  if (any (res3 /= [1,4,16])) stop 13
143
144end program main
145