aboutsummaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg/coarray_13.f90
blob: 178baea1ea397d58d23990c1b76158efc3050f75 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
! { dg-do run }
! { dg-options "-fcoarray=single -fcheck=bounds" }
!
! Coarray support -- allocatable array coarrays
!                 -- intrinsic procedures
! PR fortran/18918
! PR fortran/43931
!
program test
  implicit none
  integer,allocatable :: B(:)[:]

  call one()
  call two()
  allocate(B(3)[-4:*])
  call three(3,B,1)
  call three_a(3,B)
  call three_b(3,B)
  call four(B)
  call five()
contains
  subroutine one()
    integer, allocatable :: a(:)[:,:,:]
    allocate(a(1)[-4:9,8,4:*])
 
    if (this_image(a,dim=1) /= -4_8) STOP 1
    if (lcobound  (a,dim=1) /= -4_8) STOP 2
    if (ucobound  (a,dim=1) /=  9_8) STOP 3
 
    if (this_image(a,dim=2) /=  1_8) STOP 4
    if (lcobound  (a,dim=2) /=  1_8) STOP 5
    if (ucobound  (a,dim=2) /=  8_8) STOP 6
 
    if (this_image(a,dim=3) /= 4_8) STOP 7
    if (lcobound  (a,dim=3) /= 4_8) STOP 8
    if (ucobound  (a,dim=3) /= 4_8) STOP 9
 
    if (any(this_image(a) /= [-4_8, 1_8, 4_8])) STOP 10
    if (any(lcobound  (a) /= [-4_8, 1_8, 4_8])) STOP 11
    if (any(ucobound  (a) /= [9_8, 8_8, 4_8])) STOP 12
  end subroutine one

  subroutine two()
    integer, allocatable :: a(:)[:,:,:]
    allocate(a(1)[-4:9,8,4:*])

    if (this_image(a,dim=1) /= -4) STOP 13
    if (lcobound  (a,dim=1) /= -4) STOP 14
    if (ucobound  (a,dim=1) /=  9) STOP 15

    if (this_image(a,dim=2) /=  1) STOP 16
    if (lcobound  (a,dim=2) /=  1) STOP 17
    if (ucobound  (a,dim=2) /=  8) STOP 18

    if (this_image(a,dim=3) /= 4) STOP 19
    if (lcobound  (a,dim=3) /= 4) STOP 20
    if (ucobound  (a,dim=3) /= 4) STOP 21

    if (any(this_image(a) /= [-4, 1, 4])) STOP 22
    if (any(lcobound  (a) /= [-4, 1, 4])) STOP 23
    if (any(ucobound  (a) /= [9, 8, 4])) STOP 24
  end subroutine two

  subroutine three(n,A, n2)
    integer :: n, n2
    integer :: A(3)[n:*]

    A(1) = 42
    if (A(1) /= 42) STOP 25
    A(1)[n2] = -42
    if (A(1)[n2] /= -42) STOP 26

    if (this_image(A,dim=1) /= n) STOP 27
    if (lcobound  (A,dim=1) /= n) STOP 28
    if (ucobound  (A,dim=1) /= n) STOP 29

    if (any(this_image(A) /= n)) STOP 30
    if (any(lcobound  (A) /= n)) STOP 31
    if (any(ucobound  (A) /= n)) STOP 32
  end subroutine three

  subroutine three_a(n,A)
    integer :: n
    integer :: A(3)[n+2:n+5,n-1:*]

    A(1) = 42
    if (A(1) /= 42) STOP 33
    A(1)[4,n] = -42
    if (A(1)[4,n] /= -42) STOP 34

    if (this_image(A,dim=1) /= n+2) STOP 35
    if (lcobound  (A,dim=1) /= n+2) STOP 36
    if (ucobound  (A,dim=1) /= n+5) STOP 37

    if (this_image(A,dim=2) /= n-1) STOP 38
    if (lcobound  (A,dim=2) /= n-1) STOP 39
    if (ucobound  (A,dim=2) /= n-1) STOP 40

    if (any(this_image(A) /= [n+2,n-1])) STOP 41
    if (any(lcobound  (A) /= [n+2,n-1])) STOP 42
    if (any(ucobound  (A) /= [n+5,n-1])) STOP 43
  end subroutine three_a

  subroutine three_b(n,A)
    integer :: n
    integer :: A(-1:3,0:4,-2:5,-4:7)[n+2:n+5,n-1:*]

    A(-1,0,-2,-4) = 42
    if (A(-1,0,-2,-4) /= 42) STOP 44
    A(1,0,-2,-4) = 99
    if (A(1,0,-2,-4) /= 99) STOP 45

    if (this_image(A,dim=1) /= n+2) STOP 46
    if (lcobound  (A,dim=1) /= n+2) STOP 47
    if (ucobound  (A,dim=1) /= n+5) STOP 48

    if (this_image(A,dim=2) /= n-1) STOP 49
    if (lcobound  (A,dim=2) /= n-1) STOP 50
    if (ucobound  (A,dim=2) /= n-1) STOP 51

    if (any(this_image(A) /= [n+2,n-1])) STOP 52
    if (any(lcobound  (A) /= [n+2,n-1])) STOP 53
    if (any(ucobound  (A) /= [n+5,n-1])) STOP 54
  end subroutine three_b

  subroutine four(A)
    integer, allocatable :: A(:)[:]
    if (this_image(A,dim=1) /= -4_8) STOP 55
    if (lcobound  (A,dim=1) /= -4_8) STOP 56
    if (ucobound  (A,dim=1) /= -4_8) STOP 57
  end subroutine four

  subroutine five()
    integer, save :: foo(2)[5:7,4:*]
    integer :: i

    i = 1
    foo(1)[5,4] = 42
    if (foo(1)[5,4] /= 42) STOP 58
    if (this_image(foo,dim=i) /= 5) STOP 59
    if (lcobound(foo,dim=i) /= 5) STOP 60
    if (ucobound(foo,dim=i) /= 7) STOP 61

    i = 2
    if (this_image(foo,dim=i) /= 4) STOP 62
    if (lcobound(foo,dim=i) /= 4) STOP 63
    if (ucobound(foo,dim=i) /= 4) STOP 64
  end subroutine five
end program test