gcc/testsuite/gfortran.dg/typebound_operator_1.f03

   1 ! { dg-do compile }
   2
   3 ! Type-bound procedures
   4 ! Check correct type-bound operator definitions.
   5
   6 MODULE m
   7   IMPLICIT NONE
   8
   9   TYPE t
  10     LOGICAL :: x
  11   CONTAINS
  12     PROCEDURE, PASS :: onearg
  13     PROCEDURE, PASS :: twoarg1
  14     PROCEDURE, PASS :: twoarg2
  15     PROCEDURE, PASS(me) :: assign_proc
  16
  17     GENERIC :: OPERATOR(.BINARY.) => twoarg1, twoarg2
  18     GENERIC :: OPERATOR(.UNARY.) => onearg
  19     GENERIC :: ASSIGNMENT(=) => assign_proc
  20   END TYPE t
  21
  22 CONTAINS
  23
  24   INTEGER FUNCTION onearg (me)
  25     CLASS(t), INTENT(IN) :: me
  26     onearg = 5
  27   END FUNCTION onearg
  28
  29   INTEGER FUNCTION twoarg1 (me, a)
  30     CLASS(t), INTENT(IN) :: me
  31     INTEGER, INTENT(IN) :: a
  32     twoarg1 = 42
  33   END FUNCTION twoarg1
  34
  35   INTEGER FUNCTION twoarg2 (me, a)
  36     CLASS(t), INTENT(IN) :: me
  37     REAL, INTENT(IN) :: a
  38     twoarg2 = 123
  39   END FUNCTION twoarg2
  40
  41   SUBROUTINE assign_proc (me, b)
  42     CLASS(t), INTENT(OUT) :: me
  43     LOGICAL, INTENT(IN) :: b
  44     me%x = .NOT. b
  45   END SUBROUTINE assign_proc
  46
  47 END MODULE m