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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [entry_13.f90] - Blame information for rev 694

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! { dg-do run }
2
! Tests the fix for pr31214, in which the typespec for the entry would be lost,
3
! thereby causing the function to be disallowed, since the function and entry
4
! types did not match.
5
!
6
! Contributed by Joost VandeVondele 
7
!
8
module type_mod
9
  implicit none
10
 
11
  type x
12
     real x
13
  end type x
14
  type y
15
     real x
16
  end type y
17
  type z
18
     real x
19
  end type z
20
 
21
  interface assignment(=)
22
     module procedure equals
23
  end interface assignment(=)
24
 
25
  interface operator(//)
26
     module procedure a_op_b, b_op_a
27
  end interface operator(//)
28
 
29
  interface operator(==)
30
     module procedure a_po_b, b_po_a
31
  end interface operator(==)
32
 
33
  contains
34
     subroutine equals(x,y)
35
        type(z), intent(in) :: y
36
        type(z), intent(out) :: x
37
 
38
        x%x = y%x
39
     end subroutine equals
40
 
41
     function a_op_b(a,b)
42
        type(x), intent(in) :: a
43
        type(y), intent(in) :: b
44
        type(z) a_op_b
45
        type(z) b_op_a
46
        a_op_b%x = a%x + b%x
47
        return
48
     entry b_op_a(b,a)
49
        b_op_a%x = a%x - b%x
50
     end function a_op_b
51
 
52
     function a_po_b(a,b)
53
        type(x), intent(in) :: a
54
        type(y), intent(in) :: b
55
        type(z) a_po_b
56
        type(z) b_po_a
57
     entry b_po_a(b,a)
58
        a_po_b%x = a%x/b%x
59
     end function a_po_b
60
end module type_mod
61
 
62
program test
63
  use type_mod
64
  implicit none
65
  type(x) :: x1 = x(19.0_4)
66
  type(y) :: y1 = y(7.0_4)
67
  type(z) z1
68
 
69
  z1 = x1//y1
70
  if (abs(z1%x - (19.0_4 + 7.0_4)) > epsilon(x1%x)) call abort ()
71
  z1 = y1//x1
72
  if (abs(z1%x - (19.0_4 - 7.0_4)) > epsilon(x1%x)) call abort ()
73
 
74
  z1 = x1==y1
75
  if (abs(z1%x - 19.0_4/7.0_4) > epsilon(x1%x)) call abort ()
76
  z1 = y1==x1
77
  if (abs(z1%x - 19.0_4/7.0_4) > epsilon(x1%x)) call abort ()
78
end program test
79
! { dg-final { cleanup-modules "type_mod" } }
80
 

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.