202 lines · plain
1! RUN: %python %S/test_errors.py %s %flang_fc12! Test SELECT CASE Constraints: C1145, C1146, C1147, C1148, C11493program selectCaseProg4 implicit none5 ! local variable declaration6 character :: grade1 = 'B'7 integer :: grade2 = 38 logical :: grade3 = .false.9 real :: grade4 = 2.010 character (len = 10) :: name = 'test'11 logical, parameter :: grade5 = .false.12 CHARACTER(KIND=1), parameter :: ASCII_parm1 = 'a', ASCII_parm2='b'13 CHARACTER(KIND=2), parameter :: UCS16_parm = 'c'14 CHARACTER(KIND=4), parameter :: UCS32_parm ='d'15 type scores16 integer :: val17 end type18 type (scores) :: score = scores(25)19 type (scores), parameter :: score_val = scores(50)20 21 ! Valid Cases22 select case (grade1)23 case ('A')24 case ('B')25 case ('C')26 case default27 end select28 29 select case (grade2)30 case (1)31 case (2)32 case (3)33 case default34 end select35 36 select case (grade3)37 case (.true.)38 case (.false.)39 end select40 41 select case (name)42 case default43 case ('now')44 case ('test')45 end select46 47 ! C114548 !ERROR: SELECT CASE expression must be integer, logical, or character49 select case (grade4)50 case (1.0)51 case (2.0)52 case (3.0)53 case default54 end select55 56 !ERROR: SELECT CASE expression must be integer, logical, or character57 select case (score)58 case (score_val)59 case (scores(100))60 end select61 62 ! C114663 select case (grade3)64 case default65 case (.true.)66 !ERROR: CASE DEFAULT conflicts with previous cases67 case default68 end select69 70 ! C114771 select case (grade2)72 !ERROR: CASE value has type 'CHARACTER(KIND=1,LEN=1_8)' which is not compatible with the SELECT CASE expression's type 'INTEGER(4)'73 case (:'Z')74 case default75 end select76 77 select case (grade1)78 !ERROR: CASE value has type 'INTEGER(4)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(KIND=1,LEN=1_8)'79 case (:1)80 case default81 end select82 83 select case (grade3)84 case default85 case (.true.)86 !ERROR: CASE value has type 'INTEGER(4)' which is not compatible with the SELECT CASE expression's type 'LOGICAL(4)'87 case (3)88 end select89 90 select case (grade2)91 case default92 case (2 :)93 !ERROR: CASE value has type 'LOGICAL(4)' which is not compatible with the SELECT CASE expression's type 'INTEGER(4)'94 case (.true. :)95 !ERROR: CASE value has type 'REAL(4)' which is not compatible with the SELECT CASE expression's type 'INTEGER(4)'96 case (1.0)97 !ERROR: CASE value has type 'CHARACTER(KIND=1,LEN=3_8)' which is not compatible with the SELECT CASE expression's type 'INTEGER(4)'98 case ('wow')99 end select100 101 select case (ASCII_parm1)102 case (ASCII_parm2)103 !ERROR: CASE value has type 'CHARACTER(KIND=4,LEN=1_8)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(KIND=1,LEN=1_8)'104 case (UCS32_parm)105 !ERROR: CASE value has type 'CHARACTER(KIND=2,LEN=1_8)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(KIND=1,LEN=1_8)'106 case (UCS16_parm)107 !ERROR: CASE value has type 'CHARACTER(KIND=4,LEN=6_8)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(KIND=1,LEN=1_8)'108 case (4_"ucs-32")109 !ERROR: CASE value has type 'CHARACTER(KIND=2,LEN=6_8)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(KIND=1,LEN=1_8)'110 case (2_"ucs-16")111 case default112 end select113 114 ! C1148115 select case (grade3)116 case default117 !ERROR: CASE range is not allowed for LOGICAL118 case (.true. :)119 end select120 121 ! C1149122 select case (grade3)123 case (.true.)124 case (.false.)125 !ERROR: CASE (.true._1) conflicts with previous cases126 case (.true.)127 !ERROR: CASE (.false._1) conflicts with previous cases128 case (grade5)129 end select130 131 select case (grade2)132 !WARNING: CASE has lower bound greater than upper bound [-Wempty-case]133 case (51:50)134 case (100:)135 case (:30)136 case (40)137 case (90)138 case (91:99)139 !ERROR: CASE (81_4:90_4) conflicts with previous cases140 case (81:90)141 !ERROR: CASE (:80_4) conflicts with previous cases142 case (:80)143 !ERROR: CASE (200_4) conflicts with previous cases144 case (200)145 case default146 end select147 148 select case (name)149 case ('hello')150 case ('hey')151 !ERROR: CASE (:"hh") conflicts with previous cases152 case (:'hh')153 !ERROR: CASE (:"hd") conflicts with previous cases154 case (:'hd')155 case ( 'hu':)156 case ('hi':'ho')157 !ERROR: CASE ("hj") conflicts with previous cases158 case ('hj')159 !ERROR: CASE ("ha") conflicts with previous cases160 case ('ha')161 !ERROR: CASE ("hz") conflicts with previous cases162 case ('hz')163 case default164 end select165 166end program167 168subroutine test_overlap169 integer :: i170 !OK: these cases do not overlap171 select case(i)172 case(0:)173 case(:-1)174 end select175 select case(i)176 case(-1:)177 !ERROR: CASE (:0_4) conflicts with previous cases178 case(:0)179 end select180end181 182subroutine test_overflow183 integer :: j184 select case(1_1)185 case (127)186 !WARNING: CASE value (128_4) overflows type (INTEGER(1)) of SELECT CASE expression [-Wcase-overflow]187 case (128)188 !WARNING: CASE value (129_4) overflows type (INTEGER(1)) of SELECT CASE expression [-Wcase-overflow]189 !WARNING: CASE value (130_4) overflows type (INTEGER(1)) of SELECT CASE expression [-Wcase-overflow]190 case (129:130)191 !WARNING: CASE value (-130_4) overflows type (INTEGER(1)) of SELECT CASE expression [-Wcase-overflow]192 !WARNING: CASE value (-129_4) overflows type (INTEGER(1)) of SELECT CASE expression [-Wcase-overflow]193 case (-130:-129)194 case (-128)195 !ERROR: Must be a scalar value, but is a rank-1 array196 case ([1, 2])197 !ERROR: Must be a constant value198 case (j)199 case default200 end select201end202