gcc/testsuite/gfortran.dg/typebound_proc_5.f03

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