OpenCores
URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [gfortran.dg/] [f2c_9.f90] - Blame information for rev 302

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 302 jeremybenn
! { dg-do run }
2
! { dg-options "-ff2c" }
3
! PR 34868
4
 
5
function f(a) result(res)
6
  implicit none
7
  real(8), intent(in) :: a(:)
8
  complex(8) :: res
9
 
10
  res = cmplx(sum(a),product(a),8)
11
end function f
12
 
13
function g(a)
14
  implicit none
15
  real(8), intent(in) :: a(:)
16
  complex(8) :: g
17
 
18
  g = cmplx(sum(a),product(a),8)
19
end function g
20
 
21
program test
22
  real(8) :: a(1,5)
23
  complex(8) :: c
24
  integer :: i
25
 
26
  interface
27
    complex(8) function f(a)
28
      real(8), intent(in) :: a(:)
29
    end function f
30
    function g(a) result(res)
31
      real(8), intent(in) :: a(:)
32
      complex(8) :: res
33
    end function g
34
  end interface
35
 
36
  do i = 1, 5
37
    a(1,i) = sqrt(real(i,kind(a)))
38
  end do
39
 
40
  c = f(a(1,:))
41
  call check (real(c), sum(a))
42
  call check (imag(c), product(a))
43
 
44
  c = g(a(1,:))
45
  call check (real(c), sum(a))
46
  call check (imag(c), product(a))
47
contains
48
  subroutine check (a, b)
49
    real(8), intent(in) :: a, b
50
    if (abs(a - b) > 1.e-10_8) call abort
51
  end subroutine check
52
end program test

powered by: WebSVN 2.1.0

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