| ! { dg-do compile } |
| |
| ! Type-bound procedures |
| ! Test for errors in specific bindings, during resolution. |
| |
| MODULE othermod |
| IMPLICIT NONE |
| CONTAINS |
| |
| REAL FUNCTION proc_noarg () |
| IMPLICIT NONE |
| END FUNCTION proc_noarg |
| |
| END MODULE othermod |
| |
| MODULE testmod |
| USE othermod |
| IMPLICIT NONE |
| |
| INTEGER :: noproc |
| |
| PROCEDURE() :: proc_nointf |
| |
| INTERFACE |
| SUBROUTINE proc_intf () |
| END SUBROUTINE proc_intf |
| END INTERFACE |
| |
| ABSTRACT INTERFACE |
| SUBROUTINE proc_abstract_intf () |
| END SUBROUTINE proc_abstract_intf |
| END INTERFACE |
| |
| TYPE supert |
| CONTAINS |
| PROCEDURE, NOPASS :: super_overrid => proc_sub_noarg |
| PROCEDURE, NOPASS, NON_OVERRIDABLE :: super_nonoverrid => proc_sub_noarg |
| END TYPE supert |
| |
| TYPE, EXTENDS(supert) :: t |
| CONTAINS |
| |
| ! Bindings that should succeed |
| PROCEDURE, NOPASS :: p0 => proc_noarg |
| PROCEDURE, PASS :: p1 => proc_arg_first |
| PROCEDURE proc_arg_first |
| PROCEDURE, PASS(me) :: p2 => proc_arg_middle |
| PROCEDURE, PASS(me), NON_OVERRIDABLE :: p3 => proc_arg_last |
| PROCEDURE, NOPASS :: p4 => proc_nome |
| PROCEDURE, NOPASS :: p5 => proc_intf |
| PROCEDURE, NOPASS :: super_overrid => proc_sub_noarg |
| |
| ! Bindings that should not succeed |
| PROCEDURE :: e0 => undefined ! { dg-error "has no IMPLICIT|module procedure" } |
| PROCEDURE, PASS :: e1 => proc_noarg ! { dg-error "at least one argument" } |
| PROCEDURE :: e2 => proc_noarg ! { dg-error "at least one argument" } |
| PROCEDURE, PASS(me) :: e3 => proc_nome ! { dg-error "no argument 'me'" } |
| PROCEDURE, PASS(me) :: e4 => proc_mewrong ! { dg-error "Non-polymorphic passed-object dummy argument" } |
| PROCEDURE, PASS :: e5 => proc_mewrong ! { dg-error "Non-polymorphic passed-object dummy argument" } |
| PROCEDURE :: e6 => noproc ! { dg-error "module procedure" } |
| PROCEDURE :: e7 => proc_nointf ! { dg-error "explicit interface" } |
| PROCEDURE, NOPASS :: e8 => proc_abstract_intf ! { dg-error "explicit interface" } |
| PROCEDURE :: super_nonoverrid => proc_arg_first ! { dg-error "NON_OVERRIDABLE" } |
| |
| END TYPE t |
| |
| CONTAINS |
| |
| SUBROUTINE proc_arg_first (me, x) |
| IMPLICIT NONE |
| CLASS(t) :: me |
| REAL :: x |
| END SUBROUTINE proc_arg_first |
| |
| INTEGER FUNCTION proc_arg_middle (x, me, y) |
| IMPLICIT NONE |
| REAL :: x, y |
| CLASS(t) :: me |
| END FUNCTION proc_arg_middle |
| |
| SUBROUTINE proc_arg_last (x, me) |
| IMPLICIT NONE |
| CLASS(t) :: me |
| REAL :: x |
| END SUBROUTINE proc_arg_last |
| |
| SUBROUTINE proc_nome (arg, x, y) |
| IMPLICIT NONE |
| TYPE(t) :: arg |
| REAL :: x, y |
| END SUBROUTINE proc_nome |
| |
| SUBROUTINE proc_mewrong (me, x) |
| IMPLICIT NONE |
| REAL :: x |
| INTEGER :: me |
| END SUBROUTINE proc_mewrong |
| |
| SUBROUTINE proc_sub_noarg () |
| END SUBROUTINE proc_sub_noarg |
| |
| END MODULE testmod |
| |
| PROGRAM main |
| IMPLICIT NONE |
| |
| TYPE t |
| CONTAINS |
| PROCEDURE, NOPASS :: proc_no_module ! { dg-error "module procedure" } |
| END TYPE t |
| |
| CONTAINS |
| |
| SUBROUTINE proc_no_module () |
| END SUBROUTINE proc_no_module |
| |
| END PROGRAM main |