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 ! Implicitly 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 => p1
  33     GENERIC :: gen7 => gen6 ! { dg-error "must target a specific binding" }
  34
  35     GENERIC :: gensubr => p2 ! { dg-error "mixed FUNCTION/SUBROUTINE" }
  36     GENERIC :: gensubr => subr
  37
  38   END TYPE somet
  39
  40   TYPE supert
  41   CONTAINS
  42     PROCEDURE, NOPASS :: p1 => intf1
  43     PROCEDURE, NOPASS :: p1a => intf1a
  44     PROCEDURE, NOPASS :: p2 => intf2
  45     PROCEDURE, NOPASS :: p3 => intf3
  46     PROCEDURE, NOPASS :: sub1 => subr
  47
  48     GENERIC :: gen1 => p1, p2
  49     GENERIC :: gen1 => p3
  50     GENERIC :: gen2 => p1
  51     GENERIC :: gensub => sub1
  52   END TYPE supert
  53
  54   TYPE, EXTENDS(supert) :: t
  55   CONTAINS
  56     GENERIC :: gen2 => p1a ! { dg-error "are ambiguous" }
  57     GENERIC :: gen2 => p3
  58     GENERIC :: p1 => p2 ! { dg-error "cannot overwrite specific" }
  59     GENERIC :: gensub => p2 ! { dg-error "mixed FUNCTION/SUBROUTINE" }
  60
  61     PROCEDURE, NOPASS :: gen1 => intf1 ! { dg-error "Cannot overwrite GENERIC" }
  62   END TYPE t
  63
  64 CONTAINS
  65
  66   INTEGER FUNCTION intf1 (a, b)
  67     IMPLICIT NONE
  68     INTEGER :: a, b
  69     intf1 = 42
  70   END FUNCTION intf1
  71
  72   INTEGER FUNCTION intf1a (a, b)
  73     IMPLICIT NONE
  74     INTEGER :: a, b
  75     intf1a = 42
  76   END FUNCTION intf1a
  77
  78   INTEGER FUNCTION intf2 (a, b)
  79     IMPLICIT NONE
  80     REAL :: a, b
  81     intf2 = 42.0
  82   END FUNCTION intf2
  83
  84   LOGICAL FUNCTION intf3 ()
  85     IMPLICIT NONE
  86     intf3 = .TRUE.
  87   END FUNCTION intf3
  88
  89   SUBROUTINE subr (x)
  90     IMPLICIT NONE
  91     INTEGER :: x
  92   END SUBROUTINE subr
  93
  94 END MODULE m