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