gcc/testsuite/gfortran.dg/typebound_call_1.f03

! { dg-do run }

! Type-bound procedures
! Check basic calls to NOPASS type-bound procedures.

MODULE m
  IMPLICIT NONE

  TYPE add
  CONTAINS
    PROCEDURE, NOPASS :: func => func_add
    PROCEDURE, NOPASS :: sub => sub_add
    PROCEDURE, NOPASS :: echo => echo_add
  END TYPE add

  TYPE mul
  CONTAINS
    PROCEDURE, NOPASS :: func => func_mul
    PROCEDURE, NOPASS :: sub => sub_mul
    PROCEDURE, NOPASS :: echo => echo_mul
  END TYPE mul

CONTAINS

  INTEGER FUNCTION func_add (a, b)
    IMPLICIT NONE
    INTEGER :: a, b
    func_add = a + b
  END FUNCTION func_add

  INTEGER FUNCTION func_mul (a, b)
    IMPLICIT NONE
    INTEGER :: a, b
    func_mul = a * b
  END FUNCTION func_mul

  SUBROUTINE sub_add (a, b, c)
    IMPLICIT NONE
    INTEGER, INTENT(IN) :: a, b
    INTEGER, INTENT(OUT) :: c
    c = a + b
  END SUBROUTINE sub_add

  SUBROUTINE sub_mul (a, b, c)
    IMPLICIT NONE
    INTEGER, INTENT(IN) :: a, b
    INTEGER, INTENT(OUT) :: c
    c = a * b
  END SUBROUTINE sub_mul

  SUBROUTINE echo_add ()
    IMPLICIT NONE
    WRITE (*,*) "Hi from adder!"
  END SUBROUTINE echo_add

  INTEGER FUNCTION echo_mul ()
    IMPLICIT NONE
    echo_mul = 5
    WRITE (*,*) "Hi from muler!"
  END FUNCTION echo_mul

  ! Do the testing here, in the same module as the type is.
  SUBROUTINE test ()
    IMPLICIT NONE

    TYPE(add) :: adder
    TYPE(mul) :: muler

    INTEGER :: x

    IF (adder%func (2, 3) /= 5 .OR. muler%func (2, 3) /= 6) THEN
      STOP 1
    END IF

    CALL adder%sub (2, 3, x)
    IF (x /= 5) THEN
      STOP 2
    END IF

    CALL muler%sub (2, 3, x)
    IF (x /= 6) THEN
      STOP 3
    END IF

    ! Check procedures without arguments.
    CALL adder%echo ()
    x = muler%echo ()
    CALL adder%echo
  END SUBROUTINE test

END MODULE m

PROGRAM main
  USE m, ONLY: test
  CALL test ()
END PROGRAM main