OSDN Git Service

2009-08-10 Daniel Kraft <d@domob.eu>
[pf3gnuchains/gcc-fork.git] / gcc / testsuite / gfortran.dg / typebound_operator_2.f03
1 ! { dg-do compile }
2 ! { dg-options "-w" }
3 ! FIXME: Remove -w once CLASS is fully supported.
4
5 ! Type-bound procedures
6 ! Checks for correct errors with invalid OPERATOR/ASSIGNMENT usage.
7
8 MODULE m
9   IMPLICIT NONE
10
11   TYPE t ! { dg-error "not yet implemented" }
12   CONTAINS
13     PROCEDURE, PASS :: onearg
14     PROCEDURE, PASS :: onearg_alt => onearg
15     PROCEDURE, PASS :: onearg_alt2 => onearg
16     PROCEDURE, PASS :: threearg
17     PROCEDURE, NOPASS :: noarg
18     PROCEDURE, PASS :: sub
19     PROCEDURE, PASS :: sub2 ! { dg-error "must be a FUNCTION" }
20     PROCEDURE, PASS :: func
21
22     ! These give errors at the targets' definitions.
23     GENERIC :: OPERATOR(.AND.) => sub2
24     GENERIC :: OPERATOR(*) => onearg
25     GENERIC :: ASSIGNMENT(=) => func
26
27     GENERIC :: OPERATOR(.UOPA.) => sub ! { dg-error "must be a FUNCTION" }
28     GENERIC :: OPERATOR(.UOPB.) => threearg ! { dg-error "at most, two arguments" }
29     GENERIC :: OPERATOR(.UOPC.) => noarg ! { dg-error "at least one argument" }
30
31     GENERIC :: OPERATOR(.UNARY.) => onearg_alt
32     GENERIC, PRIVATE :: OPERATOR(.UNARY.) => onearg_alt2 ! { dg-error "must have the same access" }
33   END TYPE t
34
35 CONTAINS
36
37   INTEGER FUNCTION onearg (me) ! { dg-error "wrong number of arguments" }
38     CLASS(t), INTENT(IN) :: me
39     onearg = 5
40   END FUNCTION onearg
41
42   INTEGER FUNCTION threearg (a, b, c)
43     CLASS(t), INTENT(IN) :: a, b, c
44     threearg = 42
45   END FUNCTION threearg
46
47   INTEGER FUNCTION noarg ()
48     noarg = 42
49   END FUNCTION noarg
50
51   LOGICAL FUNCTION func (me, b) ! { dg-error "must be a SUBROUTINE" }
52     CLASS(t), INTENT(OUT) :: me
53     CLASS(t), INTENT(IN) :: b
54     me = t ()
55     func = .TRUE.
56   END FUNCTION func
57
58   SUBROUTINE sub (a)
59     CLASS(t), INTENT(IN) :: a
60   END SUBROUTINE sub
61
62   SUBROUTINE sub2 (a, x)
63     CLASS(t), INTENT(IN) :: a
64     INTEGER, INTENT(IN) :: x
65   END SUBROUTINE sub2
66
67 END MODULE m
68
69 ! { dg-final { cleanup-modules "m" } }