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

Subversion Repositories openrisc_me

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

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

Line No. Rev Author Line
1 302 jeremybenn
! { dg-do run }
2
! { dg-options "-ff2c" }
3
! Verifies that array results work with -ff2c
4
! try all permutations of result clause in function yes/no
5
!                     and result clause in interface yes/no
6
! this is not possible in Fortran 77, but this exercises a previously
7
! buggy codepath
8
function c() result (r)
9
  complex :: r(5)
10
  r = 0.
11
end function c
12
 
13
function d()
14
  complex :: d(5)
15
  d = 1.
16
end function d
17
 
18
subroutine test_without_result
19
interface
20
   function c ()
21
     complex :: c(5)
22
   end function c
23
end interface
24
interface
25
   function d ()
26
     complex :: d(5)
27
   end function d
28
end interface
29
complex z(5)
30
z = c()
31
if (any(z /= 0.)) call abort ()
32
z = d()
33
if (any(z /= 1.)) call abort ()
34
end subroutine test_without_result
35
 
36
subroutine test_with_result
37
interface
38
   function c () result(r)
39
     complex :: r(5)
40
   end function c
41
end interface
42
interface
43
   function d () result(r)
44
     complex :: r(5)
45
   end function d
46
end interface
47
complex z(5)
48
z = c()
49
if (any(z /= 0.)) call abort ()
50
z = d()
51
if (any(z /= 1.)) call abort ()
52
end subroutine test_with_result
53
 
54
call test_without_result
55
call test_with_result
56
end
57
 

powered by: WebSVN 2.1.0

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