1! { dg-do compile }
2! { dg-options "" }
3! Tests standard indepedendent constraints for variables in a data statement
4!
5! Contributed by Paul Thomas <pault@gcc.gnu.org>
6!
7  module global
8   integer n
9  end module global
10
11  use global
12  integer q
13  data n /0/            ! { dg-error "Cannot change attributes" }
14  n = 1
15  n = foo (n)
16contains
17  function foo (m) result (bar)
18  integer p (m), bar
19  integer, allocatable :: l(:)
20  allocate (l(1))
21  data l /42/           ! { dg-error "conflicts with ALLOCATABLE" }
22  data p(1) /1/         ! { dg-error "non-constant array in DATA" }
23  data q /1/            ! { dg-error "Host associated variable" }
24  data m /1/            ! { dg-error "conflicts with DUMMY attribute" }
25  data bar /99/         ! { dg-error "conflicts with RESULT" }
26  end function foo
27  function foobar ()
28  integer foobar
29  data foobar /0/       ! { dg-error "conflicts with FUNCTION" }
30  end function foobar
31end
32