• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
1! RUN: %S/test_errors.sh %s %t %f18
2! Test SELECT CASE Constraints: C1145, C1146, C1147, C1148, C1149
3program selectCaseProg
4   implicit none
5   ! local variable declaration
6   character :: grade1 = 'B'
7   integer :: grade2 = 3
8   logical :: grade3 = .false.
9   real :: grade4 = 2.0
10   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 scores
16     integer :: val
17   end type
18   type (scores) :: score = scores(25)
19   type (scores), parameter :: score_val = scores(50)
20
21  ! Valid Cases
22   select case (grade1)
23      case ('A')
24      case ('B')
25      case ('C')
26      case default
27   end select
28
29   select case (grade2)
30      case (1)
31      case (2)
32      case (3)
33      case default
34   end select
35
36   select case (grade3)
37      case (.true.)
38      case (.false.)
39   end select
40
41   select case (name)
42      case default
43      case ('now')
44      case ('test')
45   end select
46
47  ! C1145
48  !ERROR: SELECT CASE expression must be integer, logical, or character
49  select case (grade4)
50     case (1.0)
51     case (2.0)
52     case (3.0)
53     case default
54  end select
55
56  !ERROR: SELECT CASE expression must be integer, logical, or character
57  select case (score)
58     case (score_val)
59     case (scores(100))
60  end select
61
62  ! C1146
63  select case (grade3)
64     case default
65     case (.true.)
66     !ERROR: CASE DEFAULT conflicts with previous cases
67     case default
68  end select
69
70  ! C1147
71  select case (grade2)
72     !ERROR: CASE value has type 'CHARACTER(1)' which is not compatible with the SELECT CASE expression's type 'INTEGER(4)'
73     case (:'Z')
74     case default
75   end select
76
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 default
81   end select
82
83  select case (grade3)
84     case default
85     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 select
89
90  select case (grade2)
91     case default
92     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(1)' which is not compatible with the SELECT CASE expression's type 'INTEGER(4)'
98     case ('wow')
99  end select
100
101  select case (ASCII_parm1)
102     case (ASCII_parm2)
103     !ERROR: CASE value has type 'CHARACTER(4)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(1)'
104     case (UCS32_parm)
105     !ERROR: CASE value has type 'CHARACTER(2)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(1)'
106     case (UCS16_parm)
107     !ERROR: CASE value has type 'CHARACTER(4)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(1)'
108     case (4_"ucs-32")
109     !ERROR: CASE value has type 'CHARACTER(2)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(1)'
110     case (2_"ucs-16")
111     case default
112   end select
113
114  ! C1148
115  select case (grade3)
116     case default
117     !ERROR: CASE range is not allowed for LOGICAL
118     case (.true. :)
119  end select
120
121  ! C1149
122  select case (grade3)
123    case (.true.)
124    case (.false.)
125     !ERROR: CASE (.true._1) conflicts with previous cases
126     case (.true.)
127    !ERROR: CASE (.false._1) conflicts with previous cases
128     case (grade5)
129  end select
130
131  select case (grade2)
132     case (51:50) ! warning
133     case (100:)
134     case (:30)
135     case (40)
136     case (90)
137     case (91:99)
138     !ERROR: CASE (81_4:90_4) conflicts with previous cases
139     case (81:90)
140     !ERROR: CASE (:80_4) conflicts with previous cases
141     case (:80)
142     !ERROR: CASE (200_4) conflicts with previous cases
143     case (200)
144     case default
145  end select
146
147  select case (name)
148     case ('hello')
149     case ('hey')
150     !ERROR: CASE (:"hh") conflicts with previous cases
151     case (:'hh')
152     !ERROR: CASE (:"hd") conflicts with previous cases
153     case (:'hd')
154     case ( 'hu':)
155     case ('hi':'ho')
156     !ERROR: CASE ("hj") conflicts with previous cases
157     case ('hj')
158     !ERROR: CASE ("ha") conflicts with previous cases
159     case ('ha')
160     !ERROR: CASE ("hz") conflicts with previous cases
161     case ('hz')
162     case default
163   end select
164
165end program
166
167program test_overlap
168  integer :: i
169  !OK: these cases do not overlap
170  select case(i)
171    case(0:)
172    case(:-1)
173  end select
174  select case(i)
175    case(-1:)
176    !ERROR: CASE (:0_4) conflicts with previous cases
177    case(:0)
178  end select
179end
180