1! { dg-do run }
2
3! Check that generic bindings targetting ELEMENTAL procedures work.
4
5MODULE m
6  IMPLICIT NONE
7
8  TYPE :: t
9  CONTAINS
10    PROCEDURE, NOPASS :: double
11    PROCEDURE, NOPASS :: double_here
12    GENERIC :: double_it => double
13    GENERIC :: double_inplace => double_here
14  END TYPE t
15
16CONTAINS
17
18  ELEMENTAL INTEGER FUNCTION double (val)
19    IMPLICIT NONE
20    INTEGER, INTENT(IN) :: val
21    double = 2 * val
22  END FUNCTION double
23
24  ELEMENTAL SUBROUTINE double_here (val)
25    IMPLICIT NONE
26    INTEGER, INTENT(INOUT) :: val
27    val = 2 * val
28  END SUBROUTINE double_here
29
30END MODULE m
31
32PROGRAM main
33  USE m
34  IMPLICIT NONE
35
36  TYPE(t) :: obj
37  INTEGER :: arr(42), arr2(42), arr3(42), arr4(42)
38  INTEGER :: i
39
40  arr = (/ (i, i = 1, 42) /)
41
42  arr2 = obj%double (arr)
43  arr3 = obj%double_it (arr)
44
45  arr4 = arr
46  CALL obj%double_inplace (arr4)
47
48  IF (ANY (arr2 /= 2 * arr) .OR. &
49      ANY (arr3 /= 2 * arr) .OR. &
50      ANY (arr4 /= 2 * arr)) THEN
51    CALL abort ()
52  END IF
53END PROGRAM main
54