flang/test/Semantics/select-rank.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2
   3 !Tests for SELECT RANK Construct(R1148)
   4 program select_rank
   5    implicit none
   6    integer, dimension(10:30, 10:20, -1:20) :: x
   7    integer, parameter :: y(*) = [1,2,3,4]
   8    integer, dimension(5) :: z
   9    integer, allocatable :: a(:)
  10
  11    allocate(a(10:20))
  12
  13    call CALL_SHAPE(x)
  14    call CALL_SHAPE(y)
  15    call CALL_SHAPE(z)
  16    call CALL_SHAPE(a)
  17
  18 contains
  19    !No error expected
  20    subroutine CALL_ME(x)
  21     implicit none
  22     integer :: x(..)
  23     SELECT RANK(x)
  24     RANK (0)
  25       print *, "PRINT RANK 0"
  26     RANK (1)
  27       print *, "PRINT RANK 1"
  28     END SELECT
  29    end
  30
  31    subroutine CALL_ME9(x)
  32     implicit none
  33     integer :: x(..),j
  34     boo: SELECT RANK(x)
  35     RANK (1+0)
  36       print *, "PRINT RANK 1"
  37       j = INT(0, KIND=MERGE(KIND(0), -1, RANK(x) == (1+0)))
  38     END SELECT boo
  39    end subroutine
  40
  41    !Error expected
  42    subroutine CALL_ME2(x)
  43     implicit none
  44     integer :: x(..)
  45     integer :: y(3),j
  46     !ERROR: Selector 'y' is not an assumed-rank array variable
  47     SELECT RANK(y)
  48     RANK (0)
  49       print *, "PRINT RANK 0"
  50     RANK (1)
  51       print *, "PRINT RANK 1"
  52      END SELECT
  53
  54     SELECT RANK(x)
  55     RANK(0)
  56       j = INT(0, KIND=MERGE(KIND(0), -1, RANK(x) == 0)) ! will fail when RANK(x) is not zero here
  57     END SELECT
  58    end subroutine
  59
  60    subroutine CALL_ME3(x)
  61     implicit none
  62     integer :: x(..),j
  63     SELECT RANK(x)
  64     !ERROR: The value of the selector must be between zero and 15
  65     RANK (16)
  66       j = INT(0, KIND=MERGE(KIND(0), -1, RANK(x) == 16))
  67     END SELECT
  68    end subroutine
  69
  70    subroutine CALL_ME4(x)
  71     implicit none
  72     integer :: x(..)
  73     SELECT RANK(x)
  74     RANK DEFAULT
  75       print *, "ok "
  76     !ERROR: Not more than one of the selectors of SELECT RANK statement may be DEFAULT
  77     RANK DEFAULT
  78       print *, "not ok"
  79     RANK (3)
  80       print *, "IT'S 3"
  81     END SELECT
  82    end subroutine
  83
  84    subroutine CALL_ME5(x)
  85     implicit none
  86     integer :: x(..),j
  87     SELECT RANK(x)
  88     RANK (0)
  89       print *, "PRINT RANK 0"
  90       j = INT(0, KIND=MERGE(KIND(0), -1, RANK(x) == 0))
  91     RANK(1)
  92       print *, "PRINT RANK 1"
  93     !ERROR: Same rank value (0) not allowed more than once
  94     RANK(0)
  95       print *, "ERROR"
  96       j = INT(0, KIND=MERGE(KIND(0), -1, RANK(x) == 0))
  97     RANK(1+1)
  98     !ERROR: Same rank value (2) not allowed more than once
  99     RANK(1+1)
 100     END SELECT
 101    end subroutine
 102
 103    subroutine CALL_ME6(x)
 104     implicit none
 105     integer :: x(..),j
 106     SELECT RANK(x)
 107     RANK (3)
 108       print *, "one"
 109       j = INT(0, KIND=MERGE(KIND(0), -1, RANK(x) == 3))
 110     !ERROR: The value of the selector must be between zero and 15
 111     RANK(-1)
 112       print *, "rank: -ve"
 113       j = INT(0, KIND=MERGE(KIND(0), -1, RANK(x) == -1))
 114     END SELECT
 115    end subroutine
 116
 117    subroutine CALL_ME7(arg)
 118    implicit none
 119    integer :: i,j
 120    integer, dimension(..), pointer :: arg
 121    integer, pointer :: arg2
 122    !ERROR: RANK (*) cannot be used when selector is POINTER or ALLOCATABLE
 123    select RANK(arg)
 124    RANK (*)
 125       print *, arg(1:1)
 126    RANK (1)
 127       print *, arg
 128       j = INT(0, KIND=MERGE(KIND(0), -1, RANK(arg) == 1))
 129    end select
 130
 131    !ERROR: Selector 'arg2' is not an assumed-rank array variable
 132    select RANK(arg2)
 133    RANK (*)
 134       print *,"This would lead to crash when saveSelSymbol has std::nullptr"
 135    RANK (1)
 136       print *, "Rank is 1"
 137    end select
 138
 139    end subroutine
 140
 141    subroutine CALL_ME8(x)
 142     implicit none
 143     integer :: x(..),j
 144     SELECT RANK(x)
 145     Rank(2)
 146       print *, "Now it's rank 2 "
 147     RANK (*)
 148       print *, "Going for another rank"
 149       !ERROR: 'kind=' argument must be a constant scalar integer whose value is a supported kind for the intrinsic result type
 150       j = INT(0, KIND=MERGE(KIND(0), -1, RANK(x) == 1))
 151     !ERROR: Not more than one of the selectors of SELECT RANK statement may be '*'
 152     RANK (*)
 153       print *, "This is Wrong"
 154       !ERROR: 'kind=' argument must be a constant scalar integer whose value is a supported kind for the intrinsic result type
 155       j = INT(0, KIND=MERGE(KIND(0), -1, RANK(x) == 1))
 156     END SELECT
 157    end subroutine
 158
 159    subroutine CALL_ME10(x)
 160     implicit none
 161     integer:: x(..), a=10,b=20,j
 162     integer, dimension(5) :: arr = (/1,2,3,4,5/),brr
 163     integer :: const_variable=10
 164     integer, pointer :: ptr,nullptr=>NULL()
 165     type derived
 166          character(len = 50) :: title
 167     end type derived
 168     type(derived) :: obj1
 169
 170     SELECT RANK(x)
 171     Rank(2)
 172       print *, "Now it's rank 2 "
 173     RANK (*)
 174       print *, "Going for a other rank"
 175     !ERROR: Not more than one of the selectors of SELECT RANK statement may be '*'
 176     RANK (*)
 177       print *, "This is Wrong"
 178     END SELECT
 179
 180     !ERROR: Selector 'brr' is not an assumed-rank array variable
 181     SELECT RANK(ptr=>brr)
 182     !ERROR: Must be a constant value
 183     RANK(const_variable)
 184       print *, "PRINT RANK 3"
 185       !j = INT(0, KIND=MERGE(KIND(0), -1, RANK(ptr) == 1))
 186     !ERROR: Must be a constant value
 187     RANK(nullptr)
 188       print *, "PRINT RANK 3"
 189     END SELECT
 190
 191     !ERROR: Selector 'x(1) + x(2)' is not an assumed-rank array variable
 192     SELECT RANK (x(1) + x(2))
 193
 194     END SELECT
 195
 196     !ERROR: Selector 'x(1)' is not an assumed-rank array variable
 197     SELECT RANK(x(1))
 198
 199     END SELECT
 200
 201     !ERROR: Selector 'x(1:2)' is not an assumed-rank array variable
 202     SELECT RANK(x(1:2))
 203
 204     END SELECT
 205
 206     !ERROR: 'x' is not an object of derived type
 207     SELECT RANK(x(1)%x(2))
 208
 209     END SELECT
 210
 211     !ERROR: Selector 'obj1%title' is not an assumed-rank array variable
 212     SELECT RANK(obj1%title)
 213
 214     END SELECT
 215
 216     !ERROR: Selector 'arr(1:2)+ arr(4:5)' is not an assumed-rank array variable
 217     SELECT RANK(arr(1:2)+ arr(4:5))
 218
 219     END SELECT
 220
 221     SELECT RANK(ptr=>x)
 222     RANK (3)
 223       PRINT *, "PRINT RANK 3"
 224       !ERROR: 'ptr' is not an object that can appear in an expression
 225       j = INT(0, KIND=MERGE(KIND(0), -1, RANK(ptr) == 0))
 226     RANK (1)
 227       PRINT *, "PRINT RANK 1"
 228       !ERROR: 'ptr' is not an object that can appear in an expression
 229       j = INT(0, KIND=MERGE(KIND(0), -1, RANK(ptr) == 1))
 230     END SELECT
 231    end subroutine
 232    subroutine CALL_ME_TYPES(x)
 233     implicit none
 234     integer :: x(..),j
 235     SELECT RANK(x)
 236     !ERROR: Must have INTEGER type, but is LOGICAL(4)
 237         RANK(.TRUE.)
 238     !ERROR: Must have INTEGER type, but is REAL(4)
 239         RANK(1.0)
 240     !ERROR: Must be a constant value
 241         RANK(RANK(x))
 242     !ERROR: Must have INTEGER type, but is CHARACTER(KIND=1,LEN=6_8)
 243         RANK("STRING")
 244     END SELECT
 245    end subroutine
 246    subroutine CALL_SHAPE(x)
 247     implicit none
 248     integer :: x(..)
 249     integer :: j
 250     integer, pointer :: ptr
 251     SELECT RANK(x)
 252      RANK(1)
 253        print *, "RANK 1"
 254        j = INT(0, KIND=MERGE(KIND(0), -1, RANK(x) == 1))
 255      RANK (3)
 256        print *, "RANK 3"
 257        j = INT(0, KIND=MERGE(KIND(0), -1, RANK(x) == 3))
 258     END SELECT
 259     SELECT RANK(ptr => x )
 260      RANK(1)
 261        print *, "RANK 1"
 262        j = INT(0, KIND=MERGE(KIND(0), -1, RANK(ptr) == 1))
 263      RANK (3)
 264        print *, "RANK 3"
 265        j = INT(0, KIND=MERGE(KIND(0), -1, RANK(ptr) == 3))
 266     END SELECT
 267
 268    end subroutine
 269
 270 end program