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
|
! RUN: %python %S/test_errors.py %s %flang_fc1
! TODO: crashes compiler mysteriously when built with MSVC since patch
! 10b990a03b1ede533b8443edffa3607aae4295c7n or maybe earlier
! UNSUPPORTED: system-windows
!Shape analysis related tests for SELECT RANK Construct(R1148)
program select_rank
implicit none
integer, dimension(2,3):: arr_pass
call check(arr_pass)
contains
subroutine check(arr)
implicit none
integer :: arr(..)
INTEGER :: j
select rank (arr)
rank(2)
j = INT(0, KIND=MERGE(KIND(0), -1, SIZE(SHAPE(arr)) == 2)) !arr is dummy
end select
end subroutine
subroutine check2(arr)
implicit none
integer :: arr(..)
INTEGER :: j
integer,dimension(-1:10, 20:30) :: brr
select rank (arr)
rank(2)
j = INT(0, KIND=MERGE(KIND(0), -1, SIZE(SHAPE(brr)) == 2)) !brr is local to subroutine
end select
end subroutine
subroutine checK3(arr)
implicit none
integer :: arr(..)
INTEGER :: j,I,n=5,m=5
integer,dimension(-1:10, 20:30) :: brr
integer :: array(2) = [10,20]
REAL, DIMENSION(5, 5) :: A
select rank (arr)
rank(2)
FORALL (i=1:n,j=1:m,RANK(arr).EQ.SIZE(SHAPE(brr))) &
A(i,j) = 1/A(i,j)
end select
end subroutine
subroutine check4(arr)
implicit none
integer :: arr(..)
REAL, DIMENSION(2,3) :: A
REAL, DIMENSION(0:1,0:2) :: B
INTEGER :: j
select rank (arr)
rank(2)
A = B !will assign to only same shape after analysing in any order.
end select
end subroutine
subroutine check5(arr)
implicit none
integer :: arr(..)
INTEGER :: j
select rank (arr)
rank(2)
j = LOC(arr(1,2))
end select
end subroutine
end program
|
