xref: /llvm-project/flang/test/Semantics/select-rank02.f90 (revision 88f7b4d5b6f47dfe3e8d891fbaafe5e93a4f7648)
1! RUN: %python %S/test_errors.py %s %flang_fc1
2! TODO: crashes compiler mysteriously when built with MSVC since patch
3! 10b990a03b1ede533b8443edffa3607aae4295c7n or maybe earlier
4! UNSUPPORTED: system-windows
5
6!Shape analysis related tests for SELECT RANK Construct(R1148)
7program select_rank
8   implicit none
9   integer, dimension(2,3):: arr_pass
10   call check(arr_pass)
11
12contains
13    subroutine check(arr)
14        implicit none
15        integer :: arr(..)
16        INTEGER :: j
17        select rank (arr)
18            rank(2)
19                j = INT(0, KIND=MERGE(KIND(0), -1, SIZE(SHAPE(arr)) == 2)) !arr is dummy
20        end select
21    end subroutine
22    subroutine check2(arr)
23        implicit none
24        integer :: arr(..)
25        INTEGER :: j
26        integer,dimension(-1:10, 20:30) :: brr
27
28        select rank (arr)
29            rank(2)
30                j = INT(0, KIND=MERGE(KIND(0), -1, SIZE(SHAPE(brr)) == 2)) !brr is local to subroutine
31        end select
32    end subroutine
33    subroutine checK3(arr)
34        implicit none
35        integer :: arr(..)
36        INTEGER :: j,I,n=5,m=5
37        integer,dimension(-1:10, 20:30) :: brr
38        integer :: array(2) = [10,20]
39        REAL, DIMENSION(5, 5) :: A
40        select rank (arr)
41            rank(2)
42                FORALL (i=1:n,j=1:m,RANK(arr).EQ.SIZE(SHAPE(brr))) &
43                    A(i,j) = 1/A(i,j)
44        end select
45    end subroutine
46    subroutine check4(arr)
47        implicit none
48        integer :: arr(..)
49        REAL, DIMENSION(2,3) :: A
50        REAL, DIMENSION(0:1,0:2) :: B
51        INTEGER :: j
52        select rank (arr)
53            rank(2)
54                A = B   !will assign to only same shape after analysing in any order.
55        end select
56    end subroutine
57    subroutine check5(arr)
58        implicit none
59        integer :: arr(..)
60        INTEGER :: j
61        select rank (arr)
62            rank(2)
63                j = LOC(arr(1,2))
64        end select
65    end subroutine
66end program
67