aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.9/gcc/testsuite/gfortran.dg/typebound_operator_2.f03
blob: 67b6b5e0326fe1e42cb0f52b21078aec2ebdd9c8 (plain)
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
! { 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