gcc/testsuite/gfortran.dg/typebound_proc_5.f03

   1 ! { dg-do compile }
   2
   3 ! Type-bound procedures
   4 ! Test for errors in specific bindings, during resolution.
   5
   6 MODULE othermod
   7   IMPLICIT NONE
   8 CONTAINS
   9
  10   REAL FUNCTION proc_noarg ()
  11     IMPLICIT NONE
  12   END FUNCTION proc_noarg
  13
  14 END MODULE othermod
  15
  16 MODULE testmod
  17   USE othermod
  18   IMPLICIT NONE
  19
  20   INTEGER :: noproc
  21
  22   PROCEDURE() :: proc_nointf
  23
  24   INTERFACE
  25     SUBROUTINE proc_intf ()
  26     END SUBROUTINE proc_intf
  27   END INTERFACE
  28
  29   ABSTRACT INTERFACE
  30     SUBROUTINE proc_abstract_intf ()
  31     END SUBROUTINE proc_abstract_intf
  32   END INTERFACE
  33
  34   TYPE supert
  35   CONTAINS
  36     PROCEDURE, NOPASS :: super_overrid => proc_sub_noarg
  37     PROCEDURE, NOPASS, NON_OVERRIDABLE :: super_nonoverrid => proc_sub_noarg
  38   END TYPE supert
  39
  40   TYPE, EXTENDS(supert) :: t
  41   CONTAINS
  42
  43     ! Bindings that should succeed
  44     PROCEDURE, NOPASS :: p0 => proc_noarg
  45     PROCEDURE, PASS :: p1 => proc_arg_first
  46     PROCEDURE proc_arg_first
  47     PROCEDURE, PASS(me) :: p2 => proc_arg_middle
  48     PROCEDURE, PASS(me), NON_OVERRIDABLE :: p3 => proc_arg_last
  49     PROCEDURE, NOPASS :: p4 => proc_nome
  50     PROCEDURE, NOPASS :: p5 => proc_intf
  51     PROCEDURE, NOPASS :: super_overrid => proc_sub_noarg
  52
  53     ! Bindings that should not succeed
  54     PROCEDURE :: e0 => undefined ! { dg-error "has no IMPLICIT|module procedure" }
  55     PROCEDURE, PASS :: e1 => proc_noarg ! { dg-error "at least one argument" }
  56     PROCEDURE :: e2 => proc_noarg ! { dg-error "at least one argument" }
  57     PROCEDURE, PASS(me) :: e3 => proc_nome ! { dg-error "no argument 'me'" }
  58     PROCEDURE, PASS(me) :: e4 => proc_mewrong ! { dg-error "Non-polymorphic passed-object dummy argument" }
  59     PROCEDURE, PASS :: e5 => proc_mewrong ! { dg-error "Non-polymorphic passed-object dummy argument" }
  60     PROCEDURE :: e6 => noproc ! { dg-error "module procedure" }
  61     PROCEDURE :: e7 => proc_nointf ! { dg-error "explicit interface" }
  62     PROCEDURE, NOPASS :: e8 => proc_abstract_intf ! { dg-error "explicit interface" }
  63     PROCEDURE :: super_nonoverrid => proc_arg_first ! { dg-error "NON_OVERRIDABLE" }
  64
  65   END TYPE t
  66
  67 CONTAINS
  68
  69   SUBROUTINE proc_arg_first (me, x)
  70     IMPLICIT NONE
  71     CLASS(t) :: me
  72     REAL :: x
  73   END SUBROUTINE proc_arg_first
  74
  75   INTEGER FUNCTION proc_arg_middle (x, me, y)
  76     IMPLICIT NONE
  77     REAL :: x, y
  78     CLASS(t) :: me
  79   END FUNCTION proc_arg_middle
  80
  81   SUBROUTINE proc_arg_last (x, me)
  82     IMPLICIT NONE
  83     CLASS(t) :: me
  84     REAL :: x
  85   END SUBROUTINE proc_arg_last
  86
  87   SUBROUTINE proc_nome (arg, x, y)
  88     IMPLICIT NONE
  89     TYPE(t) :: arg
  90     REAL :: x, y
  91   END SUBROUTINE proc_nome
  92
  93   SUBROUTINE proc_mewrong (me, x)
  94     IMPLICIT NONE
  95     REAL :: x
  96     INTEGER :: me
  97   END SUBROUTINE proc_mewrong
  98
  99   SUBROUTINE proc_sub_noarg ()
 100   END SUBROUTINE proc_sub_noarg
 101
 102 END MODULE testmod
 103
 104 PROGRAM main
 105   IMPLICIT NONE
 106
 107   TYPE t
 108   CONTAINS
 109     PROCEDURE, NOPASS :: proc_no_module ! { dg-error "module procedure" }
 110   END TYPE t
 111
 112 CONTAINS
 113
 114   SUBROUTINE proc_no_module ()
 115   END SUBROUTINE proc_no_module
 116
 117 END PROGRAM main