URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc3/] [gcc/] [testsuite/] [gfortran.dg/] [typebound_operator_3.f03] - Blame information for rev 302

Go to most recent revision | Details | Compare with Previous | View Log


! { dg-do run }
 
! Type-bound procedures
! Check they can actually be called and run correctly.
! This also checks for correct module save/restore.
 
! FIXME: Check that calls to inherited bindings work once CLASS allows that.
 
MODULE m
  IMPLICIT NONE
 
  TYPE mynum
    REAL :: num_real
    INTEGER :: num_int
  CONTAINS
    PROCEDURE, PASS, PRIVATE :: add_mynum ! Check that this may be PRIVATE.
    PROCEDURE, PASS :: add_int
    PROCEDURE, PASS :: add_real
    PROCEDURE, PASS :: assign_int
    PROCEDURE, PASS :: assign_real
    PROCEDURE, PASS(from) :: assign_to_int
    PROCEDURE, PASS(from) :: assign_to_real
    PROCEDURE, PASS :: get_all
 
    GENERIC :: OPERATOR(+) => add_mynum, add_int, add_real
    GENERIC :: OPERATOR(.GET.) => get_all
    GENERIC :: ASSIGNMENT(=) => assign_int, assign_real, &
                                assign_to_int, assign_to_real
  END TYPE mynum
 
CONTAINS
 
  TYPE(mynum) FUNCTION add_mynum (a, b)
    CLASS(mynum), INTENT(IN) :: a, b
    add_mynum = mynum (a%num_real + b%num_real, a%num_int + b%num_int)
  END FUNCTION add_mynum
 
  TYPE(mynum) FUNCTION add_int (a, b)
    CLASS(mynum), INTENT(IN) :: a
    INTEGER, INTENT(IN) :: b
    add_int = mynum (a%num_real, a%num_int + b)
  END FUNCTION add_int
 
  TYPE(mynum) FUNCTION add_real (a, b)
    CLASS(mynum), INTENT(IN) :: a
    REAL, INTENT(IN) :: b
    add_real = mynum (a%num_real + b, a%num_int)
  END FUNCTION add_real
 
  REAL FUNCTION get_all (me)
    CLASS(mynum), INTENT(IN) :: me
    get_all = me%num_real + me%num_int
  END FUNCTION get_all
 
  SUBROUTINE assign_real (dest, from)
    CLASS(mynum), INTENT(INOUT) :: dest
    REAL, INTENT(IN) :: from
    dest%num_real = from
  END SUBROUTINE assign_real
 
  SUBROUTINE assign_int (dest, from)
    CLASS(mynum), INTENT(INOUT) :: dest
    INTEGER, INTENT(IN) :: from
    dest%num_int = from
  END SUBROUTINE assign_int
 
  SUBROUTINE assign_to_real (dest, from)
    REAL, INTENT(OUT) :: dest
    CLASS(mynum), INTENT(IN) :: from
    dest = from%num_real
  END SUBROUTINE assign_to_real
 
  SUBROUTINE assign_to_int (dest, from)
    INTEGER, INTENT(OUT) :: dest
    CLASS(mynum), INTENT(IN) :: from
    dest = from%num_int
  END SUBROUTINE assign_to_int
 
  ! Test it works basically within the module.
  SUBROUTINE check_in_module ()
    IMPLICIT NONE
    TYPE(mynum) :: num
 
    num = mynum (1.0, 2)
    num = num + 7
    IF (num%num_real /= 1.0 .OR. num%num_int /= 9) CALL abort ()
  END SUBROUTINE check_in_module
 
END MODULE m
 
! Here we see it also works for use-associated operators loaded from a module.
PROGRAM main
  USE m, ONLY: mynum, check_in_module
  IMPLICIT NONE
 
  TYPE(mynum) :: num1, num2, num3
  REAL :: real_var
  INTEGER :: int_var
 
  CALL check_in_module ()
 
  num1 = mynum (1.0, 2)
  num2 = mynum (2.0, 3)
 
  num3 = num1 + num2
  IF (num3%num_real /= 3.0 .OR. num3%num_int /= 5) CALL abort ()
 
  num3 = num1 + 5
  IF (num3%num_real /= 1.0 .OR. num3%num_int /= 7) CALL abort ()
 
  num3 = num1 + (-100.5)
  IF (num3%num_real /= -99.5 .OR. num3%num_int /= 2) CALL abort ()
 
  num3 = 42
  num3 = -1.2
  IF (num3%num_real /= -1.2 .OR. num3%num_int /= 42) CALL abort ()
 
  real_var = num3
  int_var = num3
  IF (real_var /= -1.2 .OR. int_var /= 42) CALL abort ()
 
  IF (.GET. num1 /= 3.0) CALL abort ()
END PROGRAM main
 
! { dg-final { cleanup-modules "m" } }

Line No.	Rev	Author	Line
1	302	jeremybenn	`! { dg-do run }`
2
3			`! Type-bound procedures`
4			`! Check they can actually be called and run correctly.`
5			`! This also checks for correct module save/restore.`
6
7			`! FIXME: Check that calls to inherited bindings work once CLASS allows that.`
8
9			`MODULE m`
10			`IMPLICIT NONE`
11
12			`TYPE mynum`
13			`REAL :: num_real`
14			`INTEGER :: num_int`
15			`CONTAINS`
16			`PROCEDURE, PASS, PRIVATE :: add_mynum ! Check that this may be PRIVATE.`
17			`PROCEDURE, PASS :: add_int`
18			`PROCEDURE, PASS :: add_real`
19			`PROCEDURE, PASS :: assign_int`
20			`PROCEDURE, PASS :: assign_real`
21			`PROCEDURE, PASS(from) :: assign_to_int`
22			`PROCEDURE, PASS(from) :: assign_to_real`
23			`PROCEDURE, PASS :: get_all`
24
25			`GENERIC :: OPERATOR(+) => add_mynum, add_int, add_real`
26			`GENERIC :: OPERATOR(.GET.) => get_all`
27			`GENERIC :: ASSIGNMENT(=) => assign_int, assign_real, &`
28			`assign_to_int, assign_to_real`
29			`END TYPE mynum`
30
31			`CONTAINS`
32
33			`TYPE(mynum) FUNCTION add_mynum (a, b)`
34			`CLASS(mynum), INTENT(IN) :: a, b`
35			`add_mynum = mynum (a%num_real + b%num_real, a%num_int + b%num_int)`
36			`END FUNCTION add_mynum`
37
38			`TYPE(mynum) FUNCTION add_int (a, b)`
39			`CLASS(mynum), INTENT(IN) :: a`
40			`INTEGER, INTENT(IN) :: b`
41			`add_int = mynum (a%num_real, a%num_int + b)`
42			`END FUNCTION add_int`
43
44			`TYPE(mynum) FUNCTION add_real (a, b)`
45			`CLASS(mynum), INTENT(IN) :: a`
46			`REAL, INTENT(IN) :: b`
47			`add_real = mynum (a%num_real + b, a%num_int)`
48			`END FUNCTION add_real`
49
50			`REAL FUNCTION get_all (me)`
51			`CLASS(mynum), INTENT(IN) :: me`
52			`get_all = me%num_real + me%num_int`
53			`END FUNCTION get_all`
54
55			`SUBROUTINE assign_real (dest, from)`
56			`CLASS(mynum), INTENT(INOUT) :: dest`
57			`REAL, INTENT(IN) :: from`
58			`dest%num_real = from`
59			`END SUBROUTINE assign_real`
60
61			`SUBROUTINE assign_int (dest, from)`
62			`CLASS(mynum), INTENT(INOUT) :: dest`
63			`INTEGER, INTENT(IN) :: from`
64			`dest%num_int = from`
65			`END SUBROUTINE assign_int`
66
67			`SUBROUTINE assign_to_real (dest, from)`
68			`REAL, INTENT(OUT) :: dest`
69			`CLASS(mynum), INTENT(IN) :: from`
70			`dest = from%num_real`
71			`END SUBROUTINE assign_to_real`
72
73			`SUBROUTINE assign_to_int (dest, from)`
74			`INTEGER, INTENT(OUT) :: dest`
75			`CLASS(mynum), INTENT(IN) :: from`
76			`dest = from%num_int`
77			`END SUBROUTINE assign_to_int`
78
79			`! Test it works basically within the module.`
80			`SUBROUTINE check_in_module ()`
81			`IMPLICIT NONE`
82			`TYPE(mynum) :: num`
83
84			`num = mynum (1.0, 2)`
85			`num = num + 7`
86			`IF (num%num_real /= 1.0 .OR. num%num_int /= 9) CALL abort ()`
87			`END SUBROUTINE check_in_module`
88
89			`END MODULE m`
90
91			`! Here we see it also works for use-associated operators loaded from a module.`
92			`PROGRAM main`
93			`USE m, ONLY: mynum, check_in_module`
94			`IMPLICIT NONE`
95
96			`TYPE(mynum) :: num1, num2, num3`
97			`REAL :: real_var`
98			`INTEGER :: int_var`
99
100			`CALL check_in_module ()`
101
102			`num1 = mynum (1.0, 2)`
103			`num2 = mynum (2.0, 3)`
104
105			`num3 = num1 + num2`
106			`IF (num3%num_real /= 3.0 .OR. num3%num_int /= 5) CALL abort ()`
107
108			`num3 = num1 + 5`
109			`IF (num3%num_real /= 1.0 .OR. num3%num_int /= 7) CALL abort ()`
110
111			`num3 = num1 + (-100.5)`
112			`IF (num3%num_real /= -99.5 .OR. num3%num_int /= 2) CALL abort ()`
113
114			`num3 = 42`
115			`num3 = -1.2`
116			`IF (num3%num_real /= -1.2 .OR. num3%num_int /= 42) CALL abort ()`
117
118			`real_var = num3`
119			`int_var = num3`
120			`IF (real_var /= -1.2 .OR. int_var /= 42) CALL abort ()`
121
122			`IF (.GET. num1 /= 3.0) CALL abort ()`
123			`END PROGRAM main`
124
125			`! { dg-final { cleanup-modules "m" } }`

Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc3/] [gcc/] [testsuite/] [gfortran.dg/] [typebound_operator_3.f03] - Blame information for rev 302