gcc/testsuite/gfortran.dg/typebound_generic_1.f03

   1 ! { dg-do compile }
   2
   3 ! Type-bound procedures
   4 ! Compiling and errors with GENERIC binding declarations.
   5 ! Bindings with NOPASS.
   6
   7 MODULE m
   8   IMPLICIT NONE
   9
  10   TYPE somet
  11   CONTAINS
  12     PROCEDURE, NOPASS :: p1 => intf1
  13     PROCEDURE, NOPASS :: p1a => intf1a
  14     PROCEDURE, NOPASS :: p2 => intf2
  15     PROCEDURE, NOPASS :: p3 => intf3
  16     PROCEDURE, NOPASS :: subr
  17
  18     GENERIC :: gen1 => p1a ! { dg-error "are ambiguous" }
  19
  20     GENERIC, PUBLIC :: gen1 => p1, p2
  21     GENERIC :: gen1 => p3 ! Implicitelly PUBLIC.
  22     GENERIC, PRIVATE :: gen2 => p1
  23
  24     GENERIC :: gen2 => p2 ! { dg-error "same access" }
  25     GENERIC :: gen1 => p1 ! { dg-error "already defined as specific binding" }
  26     GENERIC, PASS :: gen3 => p1 ! { dg-error "Expected access-specifier" }
  27     GENERIC :: p1 => p1 ! { dg-error "already a non-generic procedure" }
  28     PROCEDURE, NOPASS :: gen1 => intf1 ! { dg-error "already a procedure" }
  29     GENERIC :: gen3 => ! { dg-error "specific binding" }
  30     GENERIC :: gen4 => p1 x ! { dg-error "Junk after" }
  31     GENERIC :: gen5 => p_notthere ! { dg-error "Undefined specific binding" }
  32     GENERIC :: gen6 => gen1 ! { dg-error "must target a specific binding" }
  33
  34     GENERIC :: gensubr => p2 ! { dg-error "mixed FUNCTION/SUBROUTINE" }
  35     GENERIC :: gensubr => subr
  36
  37   END TYPE somet
  38
  39   TYPE supert
  40   CONTAINS
  41     PROCEDURE, NOPASS :: p1 => intf1
  42     PROCEDURE, NOPASS :: p1a => intf1a
  43     PROCEDURE, NOPASS :: p2 => intf2
  44     PROCEDURE, NOPASS :: p3 => intf3
  45     PROCEDURE, NOPASS :: sub1 => subr
  46
  47     GENERIC :: gen1 => p1, p2
  48     GENERIC :: gen1 => p3
  49     GENERIC :: gen2 => p1
  50     GENERIC :: gensub => sub1
  51   END TYPE supert
  52
  53   TYPE, EXTENDS(supert) :: t
  54   CONTAINS
  55     GENERIC :: gen2 => p1a ! { dg-error "are ambiguous" }
  56     GENERIC :: gen2 => p3
  57     GENERIC :: p1 => p2 ! { dg-error "can't overwrite specific" }
  58     GENERIC :: gensub => p2 ! { dg-error "mixed FUNCTION/SUBROUTINE" }
  59
  60     PROCEDURE, NOPASS :: gen1 => intf1 ! { dg-error "Can't overwrite GENERIC" }
  61   END TYPE t
  62
  63 CONTAINS
  64
  65   INTEGER FUNCTION intf1 (a, b)
  66     IMPLICIT NONE
  67     INTEGER :: a, b
  68     intf1 = 42
  69   END FUNCTION intf1
  70
  71   INTEGER FUNCTION intf1a (a, b)
  72     IMPLICIT NONE
  73     INTEGER :: a, b
  74     intf1a = 42
  75   END FUNCTION intf1a
  76
  77   INTEGER FUNCTION intf2 (a, b)
  78     IMPLICIT NONE
  79     REAL :: a, b
  80     intf2 = 42.0
  81   END FUNCTION intf2
  82
  83   LOGICAL FUNCTION intf3 ()
  84     IMPLICIT NONE
  85     intf3 = .TRUE.
  86   END FUNCTION intf3
  87
  88   SUBROUTINE subr (x)
  89     IMPLICIT NONE
  90     INTEGER :: x
  91   END SUBROUTINE subr
  92
  93 END MODULE m
  94
  95 ! { dg-final { cleanup-modules "m" } }