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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-stable/] [gcc-4.5.1/] [gcc/] [testsuite/] [gfortran.dg/] [entry_14.f90] - Blame information for rev 862

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

Line No. Rev Author Line
1 302 jeremybenn
! { dg-do run }
2
!
3
! PR fortran/34137
4
!
5
! Entry was previously not possible in a module.
6
! Checks also whether the different result combinations
7
! work properly.
8
!
9
module m1
10
  implicit none
11
contains
12
function func(a)
13
  implicit none
14
  integer :: a, func
15
  real :: ent
16
  func = a*4
17
  return
18
entry ent(a)
19
  ent = -a*2.0
20
  return
21
end function func
22
end module m1
23
 
24
module m2
25
  implicit none
26
contains
27
function func(a)
28
  implicit none
29
  integer :: a, func
30
  real :: func2
31
  func = a*8
32
  return
33
entry ent(a) result(func2)
34
  func2 = -a*4.0
35
  return
36
end function func
37
end module m2
38
 
39
module m3
40
  implicit none
41
contains
42
function func(a) result(res)
43
  implicit none
44
  integer :: a, res
45
  real :: func2
46
  res = a*12
47
  return
48
entry ent(a) result(func2)
49
  func2 = -a*6.0
50
  return
51
end function func
52
end module m3
53
 
54
 
55
module m4
56
  implicit none
57
contains
58
function func(a) result(res)
59
  implicit none
60
  integer :: a, res
61
  real :: ent
62
  res = a*16
63
  return
64
entry ent(a)
65
  ent = -a*8.0
66
  return
67
end function func
68
end module m4
69
 
70
program main
71
  implicit none
72
  call test1()
73
  call test2()
74
  call test3()
75
  call test4()
76
contains
77
  subroutine test1()
78
    use m1
79
    implicit none
80
    if(func(3) /= 12) call abort()
81
    if(abs(ent(7) + 14.0) > tiny(1.0)) call abort()
82
  end subroutine test1
83
  subroutine test2()
84
    use m2
85
    implicit none
86
    if(func(9) /= 72) call abort()
87
    if(abs(ent(11) + 44.0) > tiny(1.0)) call abort()
88
  end subroutine test2
89
  subroutine test3()
90
    use m3
91
    implicit none
92
    if(func(13) /= 156) call abort()
93
    if(abs(ent(17) + 102.0) > tiny(1.0)) call abort()
94
  end subroutine test3
95
  subroutine test4()
96
    use m4
97
    implicit none
98
    if(func(23) /= 368) call abort()
99
    if(abs(ent(27) + 216.0) > tiny(1.0)) call abort()
100
  end subroutine test4
101
end program main
102
 
103
! { dg-final { cleanup-modules "m1 m2 m3 m4" } }

powered by: WebSVN 2.1.0

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