1! { dg-do compile } 2 3! Type-bound procedures 4! Test for errors in specific bindings, during resolution. 5 6MODULE othermod 7 IMPLICIT NONE 8CONTAINS 9 10 REAL FUNCTION proc_noarg () 11 IMPLICIT NONE 12 END FUNCTION proc_noarg 13 14END MODULE othermod 15 16MODULE 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 67CONTAINS 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 102END MODULE testmod 103 104PROGRAM 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 112CONTAINS 113 114 SUBROUTINE proc_no_module () 115 END SUBROUTINE proc_no_module 116 117END PROGRAM main 118