[LoopReroll] Add an extra defensive check to avoid SCEV assertion.
[llvm-project.git] / flang / test / Semantics / case01.f90
blobe863b71d7332ac79808c47747c4994a1be05dec9
1 ! RUN: %S/test_errors.sh %s %t %flang_fc1
2 ! REQUIRES: shell
3 ! Test SELECT CASE Constraints: C1145, C1146, C1147, C1148, C1149
4 program selectCaseProg
5 implicit none
6 ! local variable declaration
7 character :: grade1 = 'B'
8 integer :: grade2 = 3
9 logical :: grade3 = .false.
10 real :: grade4 = 2.0
11 character (len = 10) :: name = 'test'
12 logical, parameter :: grade5 = .false.
13 CHARACTER(KIND=1), parameter :: ASCII_parm1 = 'a', ASCII_parm2='b'
14 CHARACTER(KIND=2), parameter :: UCS16_parm = 'c'
15 CHARACTER(KIND=4), parameter :: UCS32_parm ='d'
16 type scores
17 integer :: val
18 end type
19 type (scores) :: score = scores(25)
20 type (scores), parameter :: score_val = scores(50)
22 ! Valid Cases
23 select case (grade1)
24 case ('A')
25 case ('B')
26 case ('C')
27 case default
28 end select
30 select case (grade2)
31 case (1)
32 case (2)
33 case (3)
34 case default
35 end select
37 select case (grade3)
38 case (.true.)
39 case (.false.)
40 end select
42 select case (name)
43 case default
44 case ('now')
45 case ('test')
46 end select
48 ! C1145
49 !ERROR: SELECT CASE expression must be integer, logical, or character
50 select case (grade4)
51 case (1.0)
52 case (2.0)
53 case (3.0)
54 case default
55 end select
57 !ERROR: SELECT CASE expression must be integer, logical, or character
58 select case (score)
59 case (score_val)
60 case (scores(100))
61 end select
63 ! C1146
64 select case (grade3)
65 case default
66 case (.true.)
67 !ERROR: CASE DEFAULT conflicts with previous cases
68 case default
69 end select
71 ! C1147
72 select case (grade2)
73 !ERROR: CASE value has type 'CHARACTER(1)' which is not compatible with the SELECT CASE expression's type 'INTEGER(4)'
74 case (:'Z')
75 case default
76 end select
78 select case (grade1)
79 !ERROR: CASE value has type 'INTEGER(4)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(KIND=1,LEN=1_8)'
80 case (:1)
81 case default
82 end select
84 select case (grade3)
85 case default
86 case (.true.)
87 !ERROR: CASE value has type 'INTEGER(4)' which is not compatible with the SELECT CASE expression's type 'LOGICAL(4)'
88 case (3)
89 end select
91 select case (grade2)
92 case default
93 case (2 :)
94 !ERROR: CASE value has type 'LOGICAL(4)' which is not compatible with the SELECT CASE expression's type 'INTEGER(4)'
95 case (.true. :)
96 !ERROR: CASE value has type 'REAL(4)' which is not compatible with the SELECT CASE expression's type 'INTEGER(4)'
97 case (1.0)
98 !ERROR: CASE value has type 'CHARACTER(1)' which is not compatible with the SELECT CASE expression's type 'INTEGER(4)'
99 case ('wow')
100 end select
102 select case (ASCII_parm1)
103 case (ASCII_parm2)
104 !ERROR: CASE value has type 'CHARACTER(4)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(1)'
105 case (UCS32_parm)
106 !ERROR: CASE value has type 'CHARACTER(2)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(1)'
107 case (UCS16_parm)
108 !ERROR: CASE value has type 'CHARACTER(4)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(1)'
109 case (4_"ucs-32")
110 !ERROR: CASE value has type 'CHARACTER(2)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(1)'
111 case (2_"ucs-16")
112 case default
113 end select
115 ! C1148
116 select case (grade3)
117 case default
118 !ERROR: CASE range is not allowed for LOGICAL
119 case (.true. :)
120 end select
122 ! C1149
123 select case (grade3)
124 case (.true.)
125 case (.false.)
126 !ERROR: CASE (.true._1) conflicts with previous cases
127 case (.true.)
128 !ERROR: CASE (.false._1) conflicts with previous cases
129 case (grade5)
130 end select
132 select case (grade2)
133 case (51:50) ! warning
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 cases
140 case (81:90)
141 !ERROR: CASE (:80_4) conflicts with previous cases
142 case (:80)
143 !ERROR: CASE (200_4) conflicts with previous cases
144 case (200)
145 case default
146 end select
148 select case (name)
149 case ('hello')
150 case ('hey')
151 !ERROR: CASE (:"hh") conflicts with previous cases
152 case (:'hh')
153 !ERROR: CASE (:"hd") conflicts with previous cases
154 case (:'hd')
155 case ( 'hu':)
156 case ('hi':'ho')
157 !ERROR: CASE ("hj") conflicts with previous cases
158 case ('hj')
159 !ERROR: CASE ("ha") conflicts with previous cases
160 case ('ha')
161 !ERROR: CASE ("hz") conflicts with previous cases
162 case ('hz')
163 case default
164 end select
166 end program
168 program test_overlap
169 integer :: i
170 !OK: these cases do not overlap
171 select case(i)
172 case(0:)
173 case(:-1)
174 end select
175 select case(i)
176 case(-1:)
177 !ERROR: CASE (:0_4) conflicts with previous cases
178 case(:0)
179 end select