OSDN Git Service

2009-08-17 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, NOPASS :: nopassed => onearg
17     PROCEDURE, PASS :: threearg
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     ! We can't check for the 'at least one argument' error, because in this case
30     ! the procedure must be NOPASS and that other error is issued.  But of
31     ! course this should be alright.
32
33     GENERIC :: OPERATOR(.UNARY.) => onearg_alt
34     GENERIC, PRIVATE :: OPERATOR(.UNARY.) => onearg_alt2 ! { dg-error "must have the same access" }
35
36     GENERIC :: OPERATOR(.UNARYPRIME.) => nopassed ! { dg-error "can't be NOPASS" }
37     GENERIC :: OPERATOR(-) => nopassed ! { dg-error "can't be NOPASS" }
38   END TYPE t
39
40 CONTAINS
41
42   INTEGER FUNCTION onearg (me) ! { dg-error "wrong number of arguments" }
43     CLASS(t), INTENT(IN) :: me
44     onearg = 5
45   END FUNCTION onearg
46
47   INTEGER FUNCTION threearg (a, b, c)
48     CLASS(t), INTENT(IN) :: a, b, c
49     threearg = 42
50   END FUNCTION threearg
51
52   LOGICAL FUNCTION func (me, b) ! { dg-error "must be a SUBROUTINE" }
53     CLASS(t), INTENT(OUT) :: me
54     CLASS(t), INTENT(IN) :: b
55     me = t ()
56     func = .TRUE.
57   END FUNCTION func
58
59   SUBROUTINE sub (a)
60     CLASS(t), INTENT(IN) :: a
61   END SUBROUTINE sub
62
63   SUBROUTINE sub2 (a, x)
64     CLASS(t), INTENT(IN) :: a
65     INTEGER, INTENT(IN) :: x
66   END SUBROUTINE sub2
67
68 END MODULE m
69
70 ! { dg-final { cleanup-modules "m" } }