llvm-project/flang/test/Semantics/select-rank02.f90

! RUN: %S/test_errors.sh %s %t %flang_fc1

!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