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

Subversion Repositories openrisc

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

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

Line No. Rev Author Line
1 694 jeremybenn
! Make sure the f2c calling conventions work
2
! { dg-do run }
3
! { dg-options "-ff2c" }
4
 
5
function f(x)
6
  f = x
7
end function f
8
 
9
complex function c(a,b)
10
  c = cmplx (a,b)
11
end function c
12
 
13
double complex function d(e,f)
14
  double precision e, f
15
  d = cmplx (e, f, kind(d))
16
end function d
17
 
18
subroutine test_with_interface()
19
  interface
20
     real function f(x)
21
       real::x
22
     end function f
23
  end interface
24
 
25
  interface
26
     complex function c(a,b)
27
       real::a,b
28
     end function c
29
  end interface
30
 
31
  interface
32
     double complex function d(e,f)
33
       double precision::e,f
34
     end function d
35
  end interface
36
 
37
  double precision z, w
38
 
39
  x = 8.625
40
  if (x /= f(x)) call abort ()
41
  y = f(x)
42
  if (x /= y) call abort ()
43
 
44
  a = 1.
45
  b = -1.
46
  if (c(a,b) /= cmplx(a,b)) call abort ()
47
 
48
  z = 1.
49
  w = -1.
50
  if (d(z,w) /= cmplx(z,w, kind(z))) call abort ()
51
end subroutine test_with_interface
52
 
53
external f, c, d
54
real f
55
complex c
56
double complex d
57
double precision z, w
58
 
59
x = 8.625
60
if (x /= f(x)) call abort ()
61
y = f(x)
62
if (x /= y) call abort ()
63
 
64
a = 1.
65
b = -1.
66
if (c(a,b) /= cmplx(a,b)) call abort ()
67
 
68
z = 1.
69
w = -1.
70
if (d(z,w) /= cmplx(z,w, kind(z))) call abort ()
71
 
72
call test_with_interface ()
73
end

powered by: WebSVN 2.1.0

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