1! RUN: %S/test_modfile.sh %s %t %flang_fc1
2! REQUIRES: shell
3! Test declarations with coarray-spec
4
5! Different ways of declaring the same coarray.
6module m1
7  real :: a(1:5)[1:10,1:*]
8  real, dimension(5) :: b[1:10,1:*]
9  real, codimension[1:10,1:*] :: c(5)
10  real, codimension[1:10,1:*], dimension(5) :: d
11  codimension :: e[1:10,1:*]
12  dimension :: e(5)
13  real :: e
14end
15!Expect: m1.mod
16!module m1
17! real(4)::a(1_8:5_8)[1_8:10_8,1_8:*]
18! real(4)::b(1_8:5_8)[1_8:10_8,1_8:*]
19! real(4)::c(1_8:5_8)[1_8:10_8,1_8:*]
20! real(4)::d(1_8:5_8)[1_8:10_8,1_8:*]
21! real(4)::e(1_8:5_8)[1_8:10_8,1_8:*]
22!end
23
24! coarray-spec in codimension and target statements.
25module m2
26  codimension :: a[10,*], b[*]
27  target :: c[10,*], d[*]
28end
29!Expect: m2.mod
30!module m2
31! real(4)::a[1_8:10_8,1_8:*]
32! real(4)::b[1_8:*]
33! real(4),target::c[1_8:10_8,1_8:*]
34! real(4),target::d[1_8:*]
35!end
36
37! coarray-spec in components and with non-constants bounds
38module m3
39  type t
40    real, allocatable :: c[:,:]
41    complex, allocatable, codimension[:,:] :: d
42  end type
43  real, allocatable :: e[:,:,:]
44contains
45  subroutine s(a, b, n)
46    integer(8) :: n
47    real :: a[1:n,2:*]
48    real, codimension[1:n,2:*] :: b
49  end
50end
51!Expect: m3.mod
52!module m3
53! type::t
54!  real(4),allocatable::c[:,:]
55!  complex(4),allocatable::d[:,:]
56! end type
57! real(4),allocatable::e[:,:,:]
58!contains
59! subroutine s(a,b,n)
60!  integer(8)::n
61!  real(4)::a[1_8:n,2_8:*]
62!  real(4)::b[1_8:n,2_8:*]
63! end
64!end
65
66! coarray-spec in both attributes and entity-decl
67module m4
68  real, codimension[2:*], dimension(2:5) :: a, b(4,4), c[10,*], d(4,4)[10,*]
69end
70!Expect: m4.mod
71!module m4
72! real(4)::a(2_8:5_8)[2_8:*]
73! real(4)::b(1_8:4_8,1_8:4_8)[2_8:*]
74! real(4)::c(2_8:5_8)[1_8:10_8,1_8:*]
75! real(4)::d(1_8:4_8,1_8:4_8)[1_8:10_8,1_8:*]
76!end
77