URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [coarray/] [this_image_2.f90] - Blame information for rev 694

Details | Compare with Previous | View Log


! { dg-do run }
!
! PR fortran/18918
!
! Version for scalar coarrays
!
! this_image(coarray) run test,
! expecially for num_images > 1
!
! Tested are values up to num_images == 8,
! higher values are OK, but not tested for
!
implicit none
integer :: a[2:2, 3:4, 7:*]
integer :: i
 
if (this_image(A, dim=1) /= 2) call abort()
i = 1
if (this_image(A, dim=i) /= 2) call abort()
 
select case (this_image())
  case (1)
    if (this_image(A, dim=2) /= 3) call abort()
    if (this_image(A, dim=3) /= 7) call abort()
    i = 2
    if (this_image(A, dim=i) /= 3) call abort()
    i = 3
    if (this_image(A, dim=i) /= 7) call abort()
    if (any (this_image(A) /= [2,3,7])) call abort()
 
  case (2)
    if (this_image(A, dim=2) /= 4) call abort()
    if (this_image(A, dim=3) /= 7) call abort()
    i = 2
    if (this_image(A, dim=i) /= 4) call abort()
    i = 3
    if (this_image(A, dim=i) /= 7) call abort()
    if (any (this_image(A) /= [2,4,7])) call abort()
 
  case (3)
    if (this_image(A, dim=2) /= 3) call abort()
    if (this_image(A, dim=3) /= 8) call abort()
    i = 2
    if (this_image(A, dim=i) /= 3) call abort()
    i = 3
    if (this_image(A, dim=i) /= 8) call abort()
    if (any (this_image(A) /= [2,3,8])) call abort()
 
  case (4)
    if (this_image(A, dim=2) /= 4) call abort()
    if (this_image(A, dim=3) /= 8) call abort()
    i = 2
    if (this_image(A, dim=i) /= 4) call abort()
    i = 3
    if (this_image(A, dim=i) /= 8) call abort()
    if (any (this_image(A) /= [2,4,8])) call abort()
 
  case (5)
    if (this_image(A, dim=2) /= 3) call abort()
    if (this_image(A, dim=3) /= 9) call abort()
    i = 2
    if (this_image(A, dim=i) /= 3) call abort()
    i = 3
    if (this_image(A, dim=i) /= 9) call abort()
    if (any (this_image(A) /= [2,3,9])) call abort()
 
  case (6)
    if (this_image(A, dim=2) /= 4) call abort()
    if (this_image(A, dim=3) /= 9) call abort()
    i = 2
    if (this_image(A, dim=i) /= 4) call abort()
    i = 3
    if (this_image(A, dim=i) /= 9) call abort()
    if (any (this_image(A) /= [2,4,9])) call abort()
 
  case (7)
    if (this_image(A, dim=2) /= 3) call abort()
    if (this_image(A, dim=3) /= 10) call abort()
    i = 2
    if (this_image(A, dim=i) /= 3) call abort()
    i = 3
    if (this_image(A, dim=i) /= 10) call abort()
    if (any (this_image(A) /= [2,3,10])) call abort()
 
  case (8)
    if (this_image(A, dim=2) /= 4) call abort()
    if (this_image(A, dim=3) /= 10) call abort()
    i = 2
    if (this_image(A, dim=i) /= 4) call abort()
    i = 3
    if (this_image(A, dim=i) /= 10) call abort()
    if (any (this_image(A) /= [2,4,10])) call abort()
end select
 
contains
 
subroutine test_image_index
implicit none
integer :: index1, index2, index3
logical :: one
 
integer, save :: d(2)[-1:3, *]
integer, save :: e(2)[-1:-1, 3:*]
 
one = num_images() == 1
 
index1 = image_index(d, [-1, 1] )
index2 = image_index(d, [0, 1] )
 
if (one .and. (index1 /= 1 .or. index2 /= 0)) &
  call abort()
if (.not. one .and. (index1 /= 1 .or. index2 /= 2)) &
  call abort()
 
index1 = image_index(e, [-1, 3] )
index2 = image_index(e, [-1, 4] )
 
if (one .and. (index1 /= 1 .or. index2 /= 0)) &
  call abort()
if (.not. one .and. (index1 /= 1 .or. index2 /= 2)) &
  call abort()
 
end subroutine test_image_index
 
end

Line No.	Rev	Author	Line
1	694	jeremybenn	`! { dg-do run }`
2			`!`
3			`! PR fortran/18918`
4			`!`
5			`! Version for scalar coarrays`
6			`!`
7			`! this_image(coarray) run test,`
8			`! expecially for num_images > 1`
9			`!`
10			`! Tested are values up to num_images == 8,`
11			`! higher values are OK, but not tested for`
12			`!`
13			`implicit none`
14			`integer :: a[2:2, 3:4, 7:*]`
15			`integer :: i`
16
17			`if (this_image(A, dim=1) /= 2) call abort()`
18			`i = 1`
19			`if (this_image(A, dim=i) /= 2) call abort()`
20
21			`select case (this_image())`
22			`case (1)`
23			`if (this_image(A, dim=2) /= 3) call abort()`
24			`if (this_image(A, dim=3) /= 7) call abort()`
25			`i = 2`
26			`if (this_image(A, dim=i) /= 3) call abort()`
27			`i = 3`
28			`if (this_image(A, dim=i) /= 7) call abort()`
29			`if (any (this_image(A) /= [2,3,7])) call abort()`
30
31			`case (2)`
32			`if (this_image(A, dim=2) /= 4) call abort()`
33			`if (this_image(A, dim=3) /= 7) call abort()`
34			`i = 2`
35			`if (this_image(A, dim=i) /= 4) call abort()`
36			`i = 3`
37			`if (this_image(A, dim=i) /= 7) call abort()`
38			`if (any (this_image(A) /= [2,4,7])) call abort()`
39
40			`case (3)`
41			`if (this_image(A, dim=2) /= 3) call abort()`
42			`if (this_image(A, dim=3) /= 8) call abort()`
43			`i = 2`
44			`if (this_image(A, dim=i) /= 3) call abort()`
45			`i = 3`
46			`if (this_image(A, dim=i) /= 8) call abort()`
47			`if (any (this_image(A) /= [2,3,8])) call abort()`
48
49			`case (4)`
50			`if (this_image(A, dim=2) /= 4) call abort()`
51			`if (this_image(A, dim=3) /= 8) call abort()`
52			`i = 2`
53			`if (this_image(A, dim=i) /= 4) call abort()`
54			`i = 3`
55			`if (this_image(A, dim=i) /= 8) call abort()`
56			`if (any (this_image(A) /= [2,4,8])) call abort()`
57
58			`case (5)`
59			`if (this_image(A, dim=2) /= 3) call abort()`
60			`if (this_image(A, dim=3) /= 9) call abort()`
61			`i = 2`
62			`if (this_image(A, dim=i) /= 3) call abort()`
63			`i = 3`
64			`if (this_image(A, dim=i) /= 9) call abort()`
65			`if (any (this_image(A) /= [2,3,9])) call abort()`
66
67			`case (6)`
68			`if (this_image(A, dim=2) /= 4) call abort()`
69			`if (this_image(A, dim=3) /= 9) call abort()`
70			`i = 2`
71			`if (this_image(A, dim=i) /= 4) call abort()`
72			`i = 3`
73			`if (this_image(A, dim=i) /= 9) call abort()`
74			`if (any (this_image(A) /= [2,4,9])) call abort()`
75
76			`case (7)`
77			`if (this_image(A, dim=2) /= 3) call abort()`
78			`if (this_image(A, dim=3) /= 10) call abort()`
79			`i = 2`
80			`if (this_image(A, dim=i) /= 3) call abort()`
81			`i = 3`
82			`if (this_image(A, dim=i) /= 10) call abort()`
83			`if (any (this_image(A) /= [2,3,10])) call abort()`
84
85			`case (8)`
86			`if (this_image(A, dim=2) /= 4) call abort()`
87			`if (this_image(A, dim=3) /= 10) call abort()`
88			`i = 2`
89			`if (this_image(A, dim=i) /= 4) call abort()`
90			`i = 3`
91			`if (this_image(A, dim=i) /= 10) call abort()`
92			`if (any (this_image(A) /= [2,4,10])) call abort()`
93			`end select`
94
95			`contains`
96
97			`subroutine test_image_index`
98			`implicit none`
99			`integer :: index1, index2, index3`
100			`logical :: one`
101
102			`integer, save :: d(2)[-1:3, *]`
103			`integer, save :: e(2)[-1:-1, 3:*]`
104
105			`one = num_images() == 1`
106
107			`index1 = image_index(d, [-1, 1] )`
108			`index2 = image_index(d, [0, 1] )`
109
110			`if (one .and. (index1 /= 1 .or. index2 /= 0)) &`
111			`call abort()`
112			`if (.not. one .and. (index1 /= 1 .or. index2 /= 2)) &`
113			`call abort()`
114
115			`index1 = image_index(e, [-1, 3] )`
116			`index2 = image_index(e, [-1, 4] )`
117
118			`if (one .and. (index1 /= 1 .or. index2 /= 0)) &`
119			`call abort()`
120			`if (.not. one .and. (index1 /= 1 .or. index2 /= 2)) &`
121			`call abort()`
122
123			`end subroutine test_image_index`
124
125			`end`

Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [coarray/] [this_image_2.f90] - Blame information for rev 694