flang/test/Semantics/select-rank02.f90

   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)
   7 program select_rank
   8    implicit none
   9    integer, dimension(2,3):: arr_pass
  10    call check(arr_pass)
  11
  12 contains
  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
  66 end program