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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.2.2/] [gcc/] [testsuite/] [gfortran.dg/] [f2c_6.f90] - Blame information for rev 154

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
! { dg-do run }
2
! { dg-options "-ff2c" }
3
! Verifies that complex pointer 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
  common // z
10
  complex, pointer :: r
11
  complex, target :: z
12
 
13
  r=>z
14
end function c
15
 
16
function d()
17
  common // z
18
  complex, pointer :: d
19
  complex, target :: z
20
 
21
  d=>z
22
end function d
23
 
24
function e()
25
  common // z
26
  complex, pointer :: e
27
  complex, target :: z
28
 
29
  e=>z
30
end function e
31
 
32
function f() result(r)
33
  common // z
34
  complex, pointer :: r
35
  complex, target :: z
36
 
37
  r=>z
38
end function f
39
 
40
interface
41
   function c ()
42
     complex, pointer :: c
43
   end function c
44
end interface
45
interface
46
   function d()
47
     complex, pointer :: d
48
   end function d
49
end interface
50
interface
51
   function e () result(r)
52
     complex, pointer :: r
53
   end function e
54
end interface
55
interface
56
   function f () result(r)
57
     complex, pointer :: r
58
   end function f
59
end interface
60
 
61
common // z
62
complex, target :: z
63
complex, pointer :: p
64
 
65
z = (1.,0.)
66
p => c()
67
z = (2.,0.)
68
if (p /= z) call abort ()
69
 
70
NULLIFY(p)
71
p => d()
72
z = (3.,0.)
73
if (p /= z) call abort ()
74
 
75
NULLIFY(p)
76
p => e()
77
z = (4.,0.)
78
if (p /= z) call abort ()
79
 
80
NULLIFY(p)
81
p => f()
82
z = (5.,0.)
83
if (p /= z) call abort ()
84
end

powered by: WebSVN 2.1.0

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