1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
|
! { 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 "can't be NOPASS" }
GENERIC :: OPERATOR(-) => nopassed ! { dg-error "can't 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
! { dg-final { cleanup-modules "m" } }
|