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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! { dg-do run }
2
! { dg-options "-fdefault-integer-8" }
3
!
4
! As image_index_1.f90 but with -fdefault-integer-8
5
! PR fortran/51682
6
!
7
! Run-time test for IMAGE_INDEX with cobounds only known at
8
! the compile time, suitable for any number of NUM_IMAGES()
9
! For compile-time cobounds, the -fcoarray=lib version still
10
! needs to run-time evalulation if image_index returns > 1
11
! as image_index is 0 if the index would exceed num_images().
12
!
13
! Please set num_images() to >= 13, if possible.
14
!
15
! PR fortran/18918
16
!
17
 
18
program test_image_index
19
implicit none
20
integer :: index1, index2, index3
21
logical :: one
22
 
23
integer, allocatable :: a(:)[:,:,:], b(:)[:,:], c(:,:)[:]
24
integer, save :: d(2)[-1:3, *]
25
integer, save :: e(2)[-1:-1, 3:*]
26
 
27
one = num_images() == 1
28
 
29
allocate(a(1)[3:3, -4:-3, 88:*])
30
allocate(b(2)[-1:0,0:*])
31
allocate(c(3,3)[*])
32
 
33
index1 = image_index(a, [3, -4, 88] )
34
index2 = image_index(b, [-1, 0] )
35
index3 = image_index(c, [1] )
36
if (index1 /= 1 .or. index2 /= 1 .or. index3 /= 1) call abort()
37
 
38
 
39
index1 = image_index(a, [3, -3, 88] )
40
index2 = image_index(b, [0, 0] )
41
index3 = image_index(c, [2] )
42
 
43
if (one .and. (index1 /= 0 .or. index2 /= 0 .or. index3 /= 0)) &
44
  call abort()
45
if (.not. one .and. (index1 /= 2 .or. index2 /= 2 .or. index3 /= 2)) &
46
  call abort()
47
 
48
 
49
index1 = image_index(d, [-1, 1] )
50
index2 = image_index(d, [0, 1] )
51
 
52
if (one .and. (index1 /= 1 .or. index2 /= 0)) &
53
  call abort()
54
if (.not. one .and. (index1 /= 1 .or. index2 /= 2)) &
55
  call abort()
56
 
57
index1 = image_index(e, [-1, 3] )
58
index2 = image_index(e, [-1, 4] )
59
 
60
if (one .and. (index1 /= 1 .or. index2 /= 0)) &
61
  call abort()
62
if (.not. one .and. (index1 /= 1 .or. index2 /= 2)) &
63
  call abort()
64
 
65
call test(1, a,b,c)
66
 
67
! The following test is in honour of the F2008 standard:
68
deallocate(a)
69
allocate(a (10) [10, 0:9, 0:*])
70
 
71
index1 = image_index(a, [1, 0, 0] )
72
index2 = image_index(a, [3, 1, 2] )  ! = 213, yeah!
73
index3 = image_index(a, [3, 1, 0] )  ! = 13
74
 
75
if (num_images() < 13 .and. (index1 /= 1 .or. index2 /= 0 .or. index3 /= 0)) &
76
  call abort()
77
if (num_images() >= 213 .and. (index1 /= 1 .or. index2 /= 213 .or. index3 /= 13)) &
78
  call abort()
79
if (num_images() >= 13 .and. (index1 /= 1 .or. index2 /= 0 .or. index3 /= 13)) &
80
  call abort()
81
 
82
 
83
contains
84
subroutine test(n, a, b, c)
85
  integer :: n
86
  integer :: a(1)[3*n:3*n, -4*n:-3*n, 88*n:*], b(2)[-1*n:0*n,0*n:*], c(3*n,3*n)[*]
87
 
88
  index1 = image_index(a, [3, -4, 88] )
89
  index2 = image_index(b, [-1, 0] )
90
  index3 = image_index(c, [1] )
91
  if (index1 /= 1 .or. index2 /= 1 .or. index3 /= 1) call abort()
92
 
93
 
94
  index1 = image_index(a, [3, -3, 88] )
95
  index2 = image_index(b, [0, 0] )
96
  index3 = image_index(c, [2] )
97
 
98
  if (one .and. (index1 /= 0 .or. index2 /= 0 .or. index3 /= 0)) &
99
    call abort()
100
  if (.not. one .and. (index1 /= 2 .or. index2 /= 2 .or. index3 /= 2)) &
101
    call abort()
102
end subroutine test
103
end program test_image_index

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.