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
|
! { dg-do compile }
!
! PR 44549: [OOP][F2008] Type-bound procedure: bogus error from list after PROCEDURE
!
! Contributed by Dominique d'Humieres <dominiq@lps.ens.fr>
MODULE rational_numbers
IMPLICIT NONE
PRIVATE
TYPE,PUBLIC :: rational
PRIVATE
INTEGER n,d
CONTAINS
! ordinary type-bound procedure
PROCEDURE :: real => rat_to_real
! specific type-bound procedures for generic support
PROCEDURE,PRIVATE :: rat_asgn_i, rat_plus_rat, rat_plus_i
PROCEDURE,PRIVATE,PASS(b) :: i_plus_rat
! generic type-bound procedures
GENERIC :: ASSIGNMENT(=) => rat_asgn_i
GENERIC :: OPERATOR(+) => rat_plus_rat, rat_plus_i, i_plus_rat
END TYPE
CONTAINS
ELEMENTAL REAL FUNCTION rat_to_real(this) RESULT(r)
CLASS(rational),INTENT(IN) :: this
r = REAL(this%n)/this%d
END FUNCTION
ELEMENTAL SUBROUTINE rat_asgn_i(a,b)
CLASS(rational),INTENT(OUT) :: a
INTEGER,INTENT(IN) :: b
a%n = b
a%d = 1
END SUBROUTINE
ELEMENTAL TYPE(rational) FUNCTION rat_plus_i(a,b) RESULT(r)
CLASS(rational),INTENT(IN) :: a
INTEGER,INTENT(IN) :: b
r%n = a%n + b*a%d
r%d = a%d
END FUNCTION
ELEMENTAL TYPE(rational) FUNCTION i_plus_rat(a,b) RESULT(r)
INTEGER,INTENT(IN) :: a
CLASS(rational),INTENT(IN) :: b
r%n = b%n + a*b%d
r%d = b%d
END FUNCTION
ELEMENTAL TYPE(rational) FUNCTION rat_plus_rat(a,b) RESULT(r)
CLASS(rational),INTENT(IN) :: a,b
r%n = a%n*b%d + b%n*a%d
r%d = a%d*b%d
END FUNCTION
END
|
