67 lines · plain
1! RUN: %python %S/test_errors.py %s %flang_fc12! TODO: crashes compiler mysteriously when built with MSVC since patch3! 10b990a03b1ede533b8443edffa3607aae4295c7n or maybe earlier4! UNSUPPORTED: system-windows5 6!Shape analysis related tests for SELECT RANK Construct(R1148)7program select_rank8 implicit none9 integer, dimension(2,3):: arr_pass10 call check(arr_pass)11 12contains13 subroutine check(arr)14 implicit none15 integer :: arr(..)16 INTEGER :: j17 select rank (arr)18 rank(2)19 j = INT(0, KIND=MERGE(KIND(0), -1, SIZE(SHAPE(arr)) == 2)) !arr is dummy20 end select21 end subroutine22 subroutine check2(arr)23 implicit none24 integer :: arr(..)25 INTEGER :: j26 integer,dimension(-1:10, 20:30) :: brr27 28 select rank (arr)29 rank(2)30 j = INT(0, KIND=MERGE(KIND(0), -1, SIZE(SHAPE(brr)) == 2)) !brr is local to subroutine31 end select32 end subroutine33 subroutine checK3(arr)34 implicit none35 integer :: arr(..)36 INTEGER :: j,I,n=5,m=537 integer,dimension(-1:10, 20:30) :: brr38 integer :: array(2) = [10,20]39 REAL, DIMENSION(5, 5) :: A40 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 select45 end subroutine46 subroutine check4(arr)47 implicit none48 integer :: arr(..)49 REAL, DIMENSION(2,3) :: A50 REAL, DIMENSION(0:1,0:2) :: B51 INTEGER :: j52 select rank (arr)53 rank(2)54 A = B !will assign to only same shape after analysing in any order.55 end select56 end subroutine57 subroutine check5(arr)58 implicit none59 integer :: arr(..)60 INTEGER :: j61 select rank (arr)62 rank(2)63 j = LOC(arr(1,2))64 end select65 end subroutine66end program67