1! { dg-do run }
2! { dg-options "-std=f2003 -fall-intrinsics" }
3! Tests the functionality of the patch for PR29642, which requested the
4! implementation of the F2003 VALUE attribute for gfortran.
5!
6! Contributed by Paul Thomas  <pault@gcc.gnu.org>
7!
8module global
9  type :: mytype
10    real(4) :: x
11    character(4) :: c
12  end type mytype
13contains
14  subroutine typhoo (dt)
15    type(mytype), value :: dt
16    if (dtne (dt, mytype (42.0, "lmno"))) call abort ()
17    dt = mytype (21.0, "wxyz")
18    if (dtne (dt, mytype (21.0, "wxyz"))) call abort ()
19  end subroutine typhoo
20
21  logical function dtne (a, b)
22    type(mytype) :: a, b
23    dtne = .FALSE.
24    if ((a%x /= b%x) .or. (a%c /= b%c)) dtne = .TRUE.
25  end function dtne
26end module global
27
28program test_value
29  use global
30  integer(8) :: i = 42
31  real(8) :: r = 42.0
32  character(2) ::   c = "ab"
33  complex(8) :: z = (-99.0, 199.0)
34  type(mytype) :: dt = mytype (42.0, "lmno")
35
36  call foo (c)
37  if (c /= "ab") call abort ()
38
39  call bar (i)
40  if (i /= 42) call abort ()
41
42  call foobar (r)
43  if (r /= 42.0) call abort ()
44
45  call complex_foo (z)
46  if (z /= (-99.0, 199.0)) call abort ()
47
48  call typhoo (dt)
49  if (dtne (dt, mytype (42.0, "lmno"))) call abort ()
50
51  r = 20.0
52  call foobar (r*2.0 + 2.0)
53
54contains
55  subroutine foo (c)
56    character(2), value :: c
57    if (c /= "ab") call abort ()
58    c = "cd"
59    if (c /= "cd") call abort ()
60  end subroutine foo
61
62  subroutine bar (i)
63    integer(8), value :: i
64    if (i /= 42) call abort ()
65    i = 99
66    if (i /= 99) call abort ()
67  end subroutine bar
68
69  subroutine foobar (r)
70    real(8), value :: r
71    if (r /= 42.0) call abort ()
72    r = 99.0
73    if (r /= 99.0) call abort ()
74  end subroutine foobar
75
76  subroutine complex_foo (z)
77    COMPLEX(8), value :: z
78    if (z /= (-99.0, 199.0)) call abort ()
79    z = (77.0, -42.0)
80    if (z /= (77.0, -42.0)) call abort ()
81  end subroutine complex_foo
82
83end program test_value
84