gcc/testsuite/gfortran.dg/typebound_generic_3.f03

   1 ! { dg-do run }
   2
   3 ! FIXME: Remove -w once switched to polymorphic passed-object dummy arguments.
   4 ! { dg-options "-w" }
   5
   6 ! Type-bound procedures
   7 ! Check calls with GENERIC bindings.
   8
   9 MODULE m
  10   IMPLICIT NONE
  11
  12   TYPE t
  13   CONTAINS
  14     PROCEDURE, NOPASS :: plain_int
  15     PROCEDURE, NOPASS :: plain_real
  16     PROCEDURE, PASS(me) :: passed_intint
  17     PROCEDURE, PASS(me) :: passed_realreal
  18
  19     GENERIC :: gensub => plain_int, plain_real, passed_intint, passed_realreal
  20   END TYPE t
  21
  22 CONTAINS
  23
  24   SUBROUTINE plain_int (x)
  25     IMPLICIT NONE
  26     INTEGER :: x
  27     WRITE (*,*) "Plain Integer"
  28   END SUBROUTINE plain_int
  29
  30   SUBROUTINE plain_real (x)
  31     IMPLICIT NONE
  32     REAL :: x
  33     WRITE (*,*) "Plain Real"
  34   END SUBROUTINE plain_real
  35
  36   SUBROUTINE passed_intint (me, x, y)
  37     IMPLICIT NONE
  38     CLASS(t) :: me
  39     INTEGER :: x, y
  40     WRITE (*,*) "Passed Integer"
  41   END SUBROUTINE passed_intint
  42
  43   SUBROUTINE passed_realreal (x, me, y)
  44     IMPLICIT NONE
  45     REAL :: x, y
  46     CLASS(t) :: me
  47     WRITE (*,*) "Passed Real"
  48   END SUBROUTINE passed_realreal
  49
  50 END MODULE m
  51
  52 PROGRAM main
  53   USE m
  54   IMPLICIT NONE
  55
  56   TYPE(t) :: myobj
  57
  58   CALL myobj%gensub (5)
  59   CALL myobj%gensub (2.5)
  60   CALL myobj%gensub (5, 5)
  61   CALL myobj%gensub (2.5, 2.5)
  62 END PROGRAM main
  63
  64 ! { dg-output "Plain Integer(\n|\r\n|\r).*Plain Real(\n|\r\n|\r).*Passed Integer(\n|\r\n|\r).*Passed Real" }
  65 ! { dg-final { cleanup-modules "m" } }