flang/test/Semantics/select-rank02.f90

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