Subversion Repositories openrisc

! { dg-do run }

! Check that generic bindings targetting ELEMENTAL procedures work.

MODULE m
  IMPLICIT NONE

  TYPE :: t
  CONTAINS
    PROCEDURE, NOPASS :: double
    PROCEDURE, NOPASS :: double_here
    GENERIC :: double_it => double
    GENERIC :: double_inplace => double_here
  END TYPE t

CONTAINS

  ELEMENTAL INTEGER FUNCTION double (val)
    IMPLICIT NONE
    INTEGER, INTENT(IN) :: val
    double = 2 * val
  END FUNCTION double

  ELEMENTAL SUBROUTINE double_here (val)
    IMPLICIT NONE
    INTEGER, INTENT(INOUT) :: val
    val = 2 * val
  END SUBROUTINE double_here

END MODULE m

PROGRAM main
  USE m
  IMPLICIT NONE

  TYPE(t) :: obj
  INTEGER :: arr(42), arr2(42), arr3(42), arr4(42)
  INTEGER :: i

  arr = (/ (i, i = 1, 42) /)

  arr2 = obj%double (arr)
  arr3 = obj%double_it (arr)

  arr4 = arr
  CALL obj%double_inplace (arr4)

  IF (ANY (arr2 /= 2 * arr) .OR. &
      ANY (arr3 /= 2 * arr) .OR. &
      ANY (arr4 /= 2 * arr)) THEN
    CALL abort ()
  END IF
END PROGRAM main

! { dg-final { cleanup-modules "m" } }