blob: bdef47d4087c2194d12305886ace10878015da5c [file] [log] [blame]
! { dg-do compile }
! Type-bound procedures
! Checks for correct errors with invalid OPERATOR/ASSIGNMENT usage.
MODULE m
IMPLICIT NONE
TYPE t
CONTAINS
PROCEDURE, PASS :: onearg
PROCEDURE, PASS :: onearg_alt => onearg
PROCEDURE, PASS :: onearg_alt2 => onearg
PROCEDURE, NOPASS :: nopassed => onearg
PROCEDURE, PASS :: threearg
PROCEDURE, PASS :: sub
PROCEDURE, PASS :: sub2
PROCEDURE, PASS :: func
! These give errors at the targets' definitions.
GENERIC :: OPERATOR(.AND.) => sub2
GENERIC :: OPERATOR(*) => onearg
GENERIC :: ASSIGNMENT(=) => func
GENERIC :: OPERATOR(.UOPA.) => sub ! { dg-error "must be a FUNCTION" }
GENERIC :: OPERATOR(.UOPB.) => threearg ! { dg-error "at most, two arguments" }
! We can't check for the 'at least one argument' error, because in this case
! the procedure must be NOPASS and that other error is issued. But of
! course this should be alright.
GENERIC :: OPERATOR(.UNARY.) => onearg_alt
GENERIC, PRIVATE :: OPERATOR(.UNARY.) => onearg_alt2 ! { dg-error "must have the same access" }
GENERIC :: OPERATOR(.UNARYPRIME.) => nopassed ! { dg-error "cannot be NOPASS" }
GENERIC :: OPERATOR(-) => nopassed ! { dg-error "cannot be NOPASS" }
END TYPE t
CONTAINS
INTEGER FUNCTION onearg (me) ! { dg-error "wrong number of arguments" }
CLASS(t), INTENT(IN) :: me
onearg = 5
END FUNCTION onearg
INTEGER FUNCTION threearg (a, b, c)
CLASS(t), INTENT(IN) :: a, b, c
threearg = 42
END FUNCTION threearg
LOGICAL FUNCTION func (me, b) ! { dg-error "must be a SUBROUTINE" }
CLASS(t), INTENT(OUT) :: me
CLASS(t), INTENT(IN) :: b
func = .TRUE.
END FUNCTION func
SUBROUTINE sub (a)
CLASS(t), INTENT(IN) :: a
END SUBROUTINE sub
SUBROUTINE sub2 (a, x) ! { dg-error "must be a FUNCTION" }
CLASS(t), INTENT(IN) :: a
INTEGER, INTENT(IN) :: x
END SUBROUTINE sub2
END MODULE m