OSDN Git Service

2010-02-10 Joost VandeVondele <jv244@cam.ac.uk>
[pf3gnuchains/gcc-fork.git] / gcc / testsuite / gfortran.dg / typebound_operator_2.f03
1 ! { dg-do compile }
2
3 ! Type-bound procedures
4 ! Checks for correct errors with invalid OPERATOR/ASSIGNMENT usage.
5
6 MODULE m
7   IMPLICIT NONE
8
9   TYPE t
10   CONTAINS
11     PROCEDURE, PASS :: onearg
12     PROCEDURE, PASS :: onearg_alt => onearg
13     PROCEDURE, PASS :: onearg_alt2 => onearg
14     PROCEDURE, NOPASS :: nopassed => onearg
15     PROCEDURE, PASS :: threearg
16     PROCEDURE, PASS :: sub
17     PROCEDURE, PASS :: sub2
18     PROCEDURE, PASS :: func
19
20     ! These give errors at the targets' definitions.
21     GENERIC :: OPERATOR(.AND.) => sub2
22     GENERIC :: OPERATOR(*) => onearg
23     GENERIC :: ASSIGNMENT(=) => func
24
25     GENERIC :: OPERATOR(.UOPA.) => sub ! { dg-error "must be a FUNCTION" }
26     GENERIC :: OPERATOR(.UOPB.) => threearg ! { dg-error "at most, two arguments" }
27     ! We can't check for the 'at least one argument' error, because in this case
28     ! the procedure must be NOPASS and that other error is issued.  But of
29     ! course this should be alright.
30
31     GENERIC :: OPERATOR(.UNARY.) => onearg_alt
32     GENERIC, PRIVATE :: OPERATOR(.UNARY.) => onearg_alt2 ! { dg-error "must have the same access" }
33
34     GENERIC :: OPERATOR(.UNARYPRIME.) => nopassed ! { dg-error "can't be NOPASS" }
35     GENERIC :: OPERATOR(-) => nopassed ! { dg-error "can't be NOPASS" }
36   END TYPE t
37
38 CONTAINS
39
40   INTEGER FUNCTION onearg (me) ! { dg-error "wrong number of arguments" }
41     CLASS(t), INTENT(IN) :: me
42     onearg = 5
43   END FUNCTION onearg
44
45   INTEGER FUNCTION threearg (a, b, c)
46     CLASS(t), INTENT(IN) :: a, b, c
47     threearg = 42
48   END FUNCTION threearg
49
50   LOGICAL FUNCTION func (me, b) ! { dg-error "must be a SUBROUTINE" }
51     CLASS(t), INTENT(OUT) :: me
52     CLASS(t), INTENT(IN) :: b
53     func = .TRUE.
54   END FUNCTION func
55
56   SUBROUTINE sub (a)
57     CLASS(t), INTENT(IN) :: a
58   END SUBROUTINE sub
59
60   SUBROUTINE sub2 (a, x) ! { dg-error "must be a FUNCTION" }
61     CLASS(t), INTENT(IN) :: a
62     INTEGER, INTENT(IN) :: x
63   END SUBROUTINE sub2
64
65 END MODULE m
66
67 ! { dg-final { cleanup-modules "m" } }