gcc/testsuite/gfortran.dg/typebound_generic_2.f03

   1 ! { dg-do compile }
   2
   3 ! Type-bound procedures
   4 ! Check for errors with calls to GENERIC bindings and their module IO.
   5 ! Calls with NOPASS.
   6
   7 MODULE m
   8   IMPLICIT NONE
   9
  10   TYPE supert
  11   CONTAINS
  12     PROCEDURE, NOPASS :: func_int
  13     PROCEDURE, NOPASS :: sub_int
  14     GENERIC :: func => func_int
  15     GENERIC :: sub => sub_int
  16   END TYPE supert
  17
  18   TYPE, EXTENDS(supert) :: t
  19   CONTAINS
  20     PROCEDURE, NOPASS :: func_real
  21     GENERIC :: func => func_real
  22   END TYPE t
  23
  24 CONTAINS
  25
  26   INTEGER FUNCTION func_int (x)
  27     IMPLICIT NONE
  28     INTEGER :: x
  29     func_int = x
  30   END FUNCTION func_int
  31
  32   INTEGER FUNCTION func_real (x)
  33     IMPLICIT NONE
  34     REAL :: x
  35     func_real = INT(x * 4.2)
  36   END FUNCTION func_real
  37
  38   SUBROUTINE sub_int (x)
  39     IMPLICIT NONE
  40     INTEGER :: x
  41   END SUBROUTINE sub_int
  42
  43 END MODULE m
  44
  45 PROGRAM main
  46   USE m
  47   IMPLICIT NONE
  48
  49   TYPE(t) :: myobj
  50
  51   ! These are ok.
  52   CALL myobj%sub (1)
  53   WRITE (*,*) myobj%func (1)
  54   WRITE (*,*) myobj%func (2.5)
  55
  56   ! These are not.
  57   CALL myobj%sub (2.5) ! { dg-error "no matching specific binding" }
  58   WRITE (*,*) myobj%func ("hello") ! { dg-error "no matching specific binding" }
  59   CALL myobj%func (2.5) ! { dg-error "SUBROUTINE" }
  60   WRITE (*,*) myobj%sub (1) ! { dg-error "FUNCTION" }
  61
  62 END PROGRAM main