268 lines · plain
1! RUN: %python %S/test_errors.py %s %flang_fc12 3!Tests for SELECT RANK Construct(R1148)4program select_rank5 implicit none6 integer, dimension(10:30, 10:20, -1:20) :: x7 integer, parameter :: y(*) = [1,2,3,4]8 integer, dimension(5) :: z9 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 18contains19 !No error expected20 subroutine CALL_ME(x)21 implicit none22 integer :: x(..)23 SELECT RANK(x)24 RANK (0)25 print *, "PRINT RANK 0"26 RANK (1)27 print *, "PRINT RANK 1"28 END SELECT29 end30 31 subroutine CALL_ME9(x)32 implicit none33 integer :: x(..),j34 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 boo39 end subroutine40 41 !Error expected42 subroutine CALL_ME2(x)43 implicit none44 integer :: x(..)45 integer :: y(3),j46 !ERROR: Selector 'y' is not an assumed-rank array variable47 SELECT RANK(y)48 RANK (0)49 print *, "PRINT RANK 0"50 RANK (1)51 print *, "PRINT RANK 1"52 END SELECT53 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 here57 END SELECT58 end subroutine59 60 subroutine CALL_ME3(x)61 implicit none62 integer :: x(..),j63 SELECT RANK(x)64 !ERROR: The value of the selector must be between zero and 1565 RANK (16)66 j = INT(0, KIND=MERGE(KIND(0), -1, RANK(x) == 16))67 END SELECT68 end subroutine69 70 subroutine CALL_ME4(x)71 implicit none72 integer :: x(..)73 SELECT RANK(x)74 RANK DEFAULT75 print *, "ok "76 !ERROR: Not more than one of the selectors of SELECT RANK statement may be DEFAULT77 RANK DEFAULT78 print *, "not ok"79 RANK (3)80 print *, "IT'S 3"81 END SELECT82 end subroutine83 84 subroutine CALL_ME5(x)85 implicit none86 integer :: x(..),j87 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 once94 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 once99 RANK(1+1)100 END SELECT101 end subroutine102 103 subroutine CALL_ME6(x)104 implicit none105 integer :: x(..),j106 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 15111 RANK(-1)112 print *, "rank: negative"113 !ERROR: 'kind=' argument must be a constant scalar integer whose value is a supported kind for the intrinsic result type114 j = INT(0, KIND=MERGE(KIND(0), -1, RANK(x) == -1))115 END SELECT116 end subroutine117 118 subroutine CALL_ME7(arg)119 implicit none120 integer :: i,j121 integer, dimension(..), pointer :: arg122 integer, pointer :: arg2123 select RANK(arg)124 !ERROR: RANK (*) cannot be used when selector is POINTER or ALLOCATABLE125 RANK (*)126 print *, arg(1:1)127 RANK (1)128 print *, arg129 j = INT(0, KIND=MERGE(KIND(0), -1, RANK(arg) == 1))130 end select131 132 !ERROR: Selector 'arg2' is not an assumed-rank array variable133 select RANK(arg2)134 RANK (*)135 print *,"This would lead to crash when saveSelSymbol has std::nullptr"136 RANK (1)137 print *, "Rank is 1"138 end select139 140 end subroutine141 142 subroutine CALL_ME8(x)143 implicit none144 integer :: x(..),j145 SELECT RANK(x)146 Rank(2)147 print *, "Now it's rank 2 "148 RANK (*)149 print *, "Going for another rank"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 END SELECT155 end subroutine156 157 subroutine CALL_ME10(x)158 implicit none159 integer:: x(..), a=10,b=20,j160 integer, dimension(5) :: arr = (/1,2,3,4,5/),brr161 integer :: const_variable=10162 integer, pointer :: ptr,nullptr=>NULL()163 type derived164 character(len = 50) :: title165 end type derived166 type(derived) :: obj1167 168 SELECT RANK(x)169 Rank(2)170 print *, "Now it's rank 2 "171 RANK (*)172 print *, "Going for a other rank"173 !ERROR: Not more than one of the selectors of SELECT RANK statement may be '*'174 RANK (*)175 print *, "This is Wrong"176 END SELECT177 178 !ERROR: Selector 'brr' is not an assumed-rank array variable179 SELECT RANK(ptr=>brr)180 !ERROR: Must be a constant value181 RANK(const_variable)182 print *, "PRINT RANK 3"183 !j = INT(0, KIND=MERGE(KIND(0), -1, RANK(ptr) == 1))184 !ERROR: Must be a constant value185 RANK(nullptr)186 print *, "PRINT RANK 3"187 END SELECT188 189 !ERROR: Selector 'x(1) + x(2)' is not an assumed-rank array variable190 SELECT RANK (x(1) + x(2))191 192 END SELECT193 194 !ERROR: Selector 'x(1)' is not an assumed-rank array variable195 SELECT RANK(x(1))196 197 END SELECT198 199 !ERROR: Selector 'x(1:2)' is not an assumed-rank array variable200 SELECT RANK(x(1:2))201 202 END SELECT203 204 !ERROR: 'x' is not an object of derived type205 SELECT RANK(x(1)%x(2))206 207 END SELECT208 209 !ERROR: Selector 'obj1%title' is not an assumed-rank array variable210 SELECT RANK(obj1%title)211 212 END SELECT213 214 !ERROR: Selector 'arr(1:2)+ arr(4:5)' is not an assumed-rank array variable215 SELECT RANK(arr(1:2)+ arr(4:5))216 217 END SELECT218 219 SELECT RANK(ptr=>x)220 RANK (3)221 PRINT *, "PRINT RANK 3"222 !ERROR: 'kind=' argument must be a constant scalar integer whose value is a supported kind for the intrinsic result type223 j = INT(0, KIND=MERGE(KIND(0), -1, RANK(ptr) == 0))224 RANK (1)225 PRINT *, "PRINT RANK 1"226 j = INT(0, KIND=MERGE(KIND(0), -1, RANK(ptr) == 1))227 END SELECT228 end subroutine229 subroutine CALL_ME_TYPES(x)230 implicit none231 integer :: x(..),j232 SELECT RANK(x)233 !ERROR: Must have INTEGER type, but is LOGICAL(4)234 RANK(.TRUE.)235 !ERROR: Must have INTEGER type, but is REAL(4)236 RANK(1.0)237 !ERROR: Must be a constant value238 RANK(RANK(x))239 !ERROR: Must have INTEGER type, but is CHARACTER(KIND=1,LEN=6_8)240 RANK("STRING")241 END SELECT242 end subroutine243 subroutine CALL_SHAPE(x)244 implicit none245 integer :: x(..)246 integer :: j247 integer, pointer :: ptr248 SELECT RANK(x)249 RANK(1)250 print *, "RANK 1"251 j = INT(0, KIND=MERGE(KIND(0), -1, RANK(x) == 1))252 RANK (3)253 print *, "RANK 3"254 j = INT(0, KIND=MERGE(KIND(0), -1, RANK(x) == 3))255 END SELECT256 SELECT RANK(ptr => x )257 RANK(1)258 print *, "RANK 1"259 j = INT(0, KIND=MERGE(KIND(0), -1, RANK(ptr) == 1))260 RANK (3)261 print *, "RANK 3"262 j = INT(0, KIND=MERGE(KIND(0), -1, RANK(ptr) == 3))263 END SELECT264 265 end subroutine266 267end program268