aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.9/gcc/testsuite/gfortran.dg/typebound_generic_2.f03
blob: 8094d863ffae6610c0e149149b1a5224412bcba1 (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
! { dg-do compile }

! Type-bound procedures
! Check for errors with calls to GENERIC bindings and their module IO.
! Calls with NOPASS.

MODULE m
  IMPLICIT NONE

  TYPE supert
  CONTAINS
    PROCEDURE, NOPASS :: func_int
    PROCEDURE, NOPASS :: sub_int
    GENERIC :: func => func_int
    GENERIC :: sub => sub_int
  END TYPE supert

  TYPE, EXTENDS(supert) :: t
  CONTAINS
    PROCEDURE, NOPASS :: func_real
    GENERIC :: func => func_real
  END TYPE t

CONTAINS

  INTEGER FUNCTION func_int (x)
    IMPLICIT NONE
    INTEGER :: x
    func_int = x
  END FUNCTION func_int

  INTEGER FUNCTION func_real (x)
    IMPLICIT NONE
    REAL :: x
    func_real = INT(x * 4.2)
  END FUNCTION func_real

  SUBROUTINE sub_int (x)
    IMPLICIT NONE
    INTEGER :: x
  END SUBROUTINE sub_int

END MODULE m

PROGRAM main
  USE m
  IMPLICIT NONE

  TYPE(t) :: myobj

  ! These are ok.
  CALL myobj%sub (1)
  WRITE (*,*) myobj%func (1)
  WRITE (*,*) myobj%func (2.5)

  ! These are not.
  CALL myobj%sub (2.5) ! { dg-error "no matching specific binding" }
  WRITE (*,*) myobj%func ("hello") ! { dg-error "no matching specific binding" }
  CALL myobj%func (2.5) ! { dg-error "SUBROUTINE" }
  WRITE (*,*) myobj%sub (1) ! { dg-error "FUNCTION" }

END PROGRAM main