aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.9/gcc/ada/sem_case.adb
blob: b3f47a6df9b1cee911b97c000ecda9ca5bd8ccca (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                             S E M _ C A S E                              --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 1996-2013, Free Software Foundation, Inc.         --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license.          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------

with Atree;    use Atree;
with Einfo;    use Einfo;
with Errout;   use Errout;
with Namet;    use Namet;
with Nlists;   use Nlists;
with Nmake;    use Nmake;
with Opt;      use Opt;
with Sem;      use Sem;
with Sem_Aux;  use Sem_Aux;
with Sem_Eval; use Sem_Eval;
with Sem_Res;  use Sem_Res;
with Sem_Util; use Sem_Util;
with Sem_Type; use Sem_Type;
with Snames;   use Snames;
with Stand;    use Stand;
with Sinfo;    use Sinfo;
with Tbuild;   use Tbuild;
with Uintp;    use Uintp;

with Ada.Unchecked_Deallocation;

with GNAT.Heap_Sort_G;

package body Sem_Case is

   type Choice_Bounds is record
     Lo   : Node_Id;
     Hi   : Node_Id;
     Node : Node_Id;
   end record;
   --  Represent one choice bounds entry with Lo and Hi values, Node points
   --  to the choice node itself.

   type Choice_Table_Type is array (Nat range <>) of Choice_Bounds;
   --  Table type used to sort the choices present in a case statement or
   --  record variant. The actual entries are stored in 1 .. Last, but we
   --  have a 0 entry for use in sorting.

   -----------------------
   -- Local Subprograms --
   -----------------------

   procedure Check_Choice_Set
     (Choice_Table   : in out Choice_Table_Type;
      Bounds_Type    : Entity_Id;
      Subtyp         : Entity_Id;
      Others_Present : Boolean;
      Case_Node      : Node_Id);
   --  This is the procedure which verifies that a set of case alternatives
   --  or record variant choices has no duplicates, and covers the range
   --  specified by Bounds_Type. Choice_Table contains the discrete choices
   --  to check. These must start at position 1.
   --
   --  Furthermore Choice_Table (0) must exist. This element is used by
   --  the sorting algorithm as a temporary. Others_Present is a flag
   --  indicating whether or not an Others choice is present. Finally
   --  Msg_Sloc gives the source location of the construct containing the
   --  choices in the Choice_Table.
   --
   --  Bounds_Type is the type whose range must be covered by the alternatives
   --
   --  Subtyp is the subtype of the expression. If its bounds are non-static
   --  the alternatives must cover its base type.

   function Choice_Image (Value : Uint; Ctype : Entity_Id) return Name_Id;
   --  Given a Pos value of enumeration type Ctype, returns the name
   --  ID of an appropriate string to be used in error message output.

   procedure Expand_Others_Choice
     (Case_Table     : Choice_Table_Type;
      Others_Choice  : Node_Id;
      Choice_Type    : Entity_Id);
   --  The case table is the table generated by a call to Check_Choices
   --  (with just 1 .. Last_Choice entries present). Others_Choice is a
   --  pointer to the N_Others_Choice node (this routine is only called if
   --  an others choice is present), and Choice_Type is the discrete type
   --  of the bounds. The effect of this call is to analyze the cases and
   --  determine the set of values covered by others. This choice list is
   --  set in the Others_Discrete_Choices field of the N_Others_Choice node.

   ----------------------
   -- Check_Choice_Set --
   ----------------------

   procedure Check_Choice_Set
     (Choice_Table   : in out Choice_Table_Type;
      Bounds_Type    : Entity_Id;
      Subtyp         : Entity_Id;
      Others_Present : Boolean;
      Case_Node      : Node_Id)
   is
      procedure Check_Against_Predicate
        (Pred    : in out Node_Id;
         Choice  : Choice_Bounds;
         Prev_Lo : in out Uint;
         Prev_Hi : in out Uint;
         Error   : in out Boolean);
      --  Determine whether a choice covers legal values as defined by a static
      --  predicate set. Pred is a static predicate range. Choice is the choice
      --  to be examined. Prev_Lo and Prev_Hi are the bounds of the previous
      --  choice that covered a predicate set. Error denotes whether the check
      --  found an illegal intersection.

      procedure Dup_Choice (Lo, Hi : Uint; C : Node_Id);
      --  Post message "duplication of choice value(s) bla bla at xx". Message
      --  is posted at location C. Caller sets Error_Msg_Sloc for xx.

      procedure Explain_Non_Static_Bound;
      --  Called when we find a non-static bound, requiring the base type to
      --  be covered. Provides where possible a helpful explanation of why the
      --  bounds are non-static, since this is not always obvious.

      function Lt_Choice (C1, C2 : Natural) return Boolean;
      --  Comparison routine for comparing Choice_Table entries. Use the lower
      --  bound of each Choice as the key.

      procedure Missing_Choice (Value1 : Node_Id; Value2 : Node_Id);
      procedure Missing_Choice (Value1 : Node_Id; Value2 : Uint);
      procedure Missing_Choice (Value1 : Uint;    Value2 : Node_Id);
      procedure Missing_Choice (Value1 : Uint;    Value2 : Uint);
      --  Issue an error message indicating that there are missing choices,
      --  followed by the image of the missing choices themselves which lie
      --  between Value1 and Value2 inclusive.

      procedure Missing_Choices (Pred : Node_Id; Prev_Hi : Uint);
      --  Emit an error message for each non-covered static predicate set.
      --  Prev_Hi denotes the upper bound of the last choice covering a set.

      procedure Move_Choice (From : Natural; To : Natural);
      --  Move routine for sorting the Choice_Table

      package Sorting is new GNAT.Heap_Sort_G (Move_Choice, Lt_Choice);

      -----------------------------
      -- Check_Against_Predicate --
      -----------------------------

      procedure Check_Against_Predicate
        (Pred    : in out Node_Id;
         Choice  : Choice_Bounds;
         Prev_Lo : in out Uint;
         Prev_Hi : in out Uint;
         Error   : in out Boolean)
      is
         procedure Illegal_Range
           (Loc : Source_Ptr;
            Lo  : Uint;
            Hi  : Uint);
         --  Emit an error message regarding a choice that clashes with the
         --  legal static predicate sets. Loc is the location of the choice
         --  that introduced the illegal range. Lo .. Hi is the range.

         function Inside_Range
           (Lo  : Uint;
            Hi  : Uint;
            Val : Uint) return Boolean;
         --  Determine whether position Val within a discrete type is within
         --  the range Lo .. Hi inclusive.

         -------------------
         -- Illegal_Range --
         -------------------

         procedure Illegal_Range
           (Loc : Source_Ptr;
            Lo  : Uint;
            Hi  : Uint)
         is
         begin
            Error_Msg_Name_1 := Chars (Bounds_Type);

            --  Single value

            if Lo = Hi then
               if Is_Integer_Type (Bounds_Type) then
                  Error_Msg_Uint_1 := Lo;
                  Error_Msg ("static predicate on % excludes value ^!", Loc);
               else
                  Error_Msg_Name_2 := Choice_Image (Lo, Bounds_Type);
                  Error_Msg ("static predicate on % excludes value %!", Loc);
               end if;

            --  Range

            else
               if Is_Integer_Type (Bounds_Type) then
                  Error_Msg_Uint_1 := Lo;
                  Error_Msg_Uint_2 := Hi;
                  Error_Msg
                    ("static predicate on % excludes range ^ .. ^!", Loc);
               else
                  Error_Msg_Name_2 := Choice_Image (Lo, Bounds_Type);
                  Error_Msg_Name_3 := Choice_Image (Hi, Bounds_Type);
                  Error_Msg
                    ("static predicate on % excludes range % .. %!", Loc);
               end if;
            end if;
         end Illegal_Range;

         ------------------
         -- Inside_Range --
         ------------------

         function Inside_Range
           (Lo  : Uint;
            Hi  : Uint;
            Val : Uint) return Boolean
         is
         begin
            return
              Val = Lo or else Val = Hi or else (Lo < Val and then Val < Hi);
         end Inside_Range;

         --  Local variables

         Choice_Hi : constant Uint := Expr_Value (Choice.Hi);
         Choice_Lo : constant Uint := Expr_Value (Choice.Lo);
         Loc       : Source_Ptr;
         LocN      : Node_Id;
         Next_Hi   : Uint;
         Next_Lo   : Uint;
         Pred_Hi   : Uint;
         Pred_Lo   : Uint;

      --  Start of processing for Check_Against_Predicate

      begin
         --  Find the proper error message location

         if Present (Choice.Node) then
            LocN := Choice.Node;
         else
            LocN := Case_Node;
         end if;

         Loc := Sloc (LocN);

         if Present (Pred) then
            Pred_Lo := Expr_Value (Low_Bound  (Pred));
            Pred_Hi := Expr_Value (High_Bound (Pred));

         --  Previous choices managed to satisfy all static predicate sets

         else
            Illegal_Range (Loc, Choice_Lo, Choice_Hi);
            Error := True;
            return;
         end if;

         --  Step 1: Detect duplicate choices

         if Inside_Range (Choice_Lo, Choice_Hi, Prev_Lo) then
            Dup_Choice (Prev_Lo, UI_Min (Prev_Hi, Choice_Hi), LocN);
            Error := True;

         elsif Inside_Range (Choice_Lo, Choice_Hi, Prev_Hi) then
            Dup_Choice (UI_Max (Choice_Lo, Prev_Lo), Prev_Hi, LocN);
            Error := True;

         --  Step 2: Detect full coverage

         --  Choice_Lo    Choice_Hi
         --  +============+
         --  Pred_Lo      Pred_Hi

         elsif Choice_Lo = Pred_Lo and then Choice_Hi = Pred_Hi then
            Prev_Lo := Choice_Lo;
            Prev_Hi := Choice_Hi;
            Next (Pred);

         --  Step 3: Detect all cases where a choice mentions values that are
         --  not part of the static predicate sets.

         --  Choice_Lo   Choice_Hi   Pred_Lo   Pred_Hi
         --  +-----------+ . . . . . +=========+
         --   ^ illegal ^

         elsif Choice_Lo < Pred_Lo and then Choice_Hi < Pred_Lo then
            Illegal_Range (Loc, Choice_Lo, Choice_Hi);
            Error := True;

         --  Choice_Lo   Pred_Lo   Choice_Hi   Pred_Hi
         --  +-----------+=========+===========+
         --   ^ illegal ^

         elsif Choice_Lo < Pred_Lo
           and then Inside_Range (Pred_Lo, Pred_Hi, Choice_Hi)
         then
            Illegal_Range (Loc, Choice_Lo, Pred_Lo - 1);
            Error := True;

         --  Pred_Lo   Pred_Hi   Choice_Lo   Choice_Hi
         --  +=========+ . . . . +-----------+
         --                       ^ illegal ^

         elsif Pred_Lo < Choice_Lo and then Pred_Hi < Choice_Lo then
            if Others_Present then

               --  Current predicate set is covered by others clause.

               null;

            else
               Missing_Choice (Pred_Lo, Pred_Hi);
               Error := True;
            end if;

            --  There may be several static predicate sets between the current
            --  one and the choice. Inspect the next static predicate set.

            Next (Pred);
            Check_Against_Predicate
              (Pred    => Pred,
               Choice  => Choice,
               Prev_Lo => Prev_Lo,
               Prev_Hi => Prev_Hi,
               Error   => Error);

         --  Pred_Lo   Choice_Lo   Pred_Hi     Choice_Hi
         --  +=========+===========+-----------+
         --                         ^ illegal ^

         elsif Pred_Hi < Choice_Hi
           and then Inside_Range (Pred_Lo, Pred_Hi, Choice_Lo)
         then
            Next (Pred);

            --  The choice may fall in a static predicate set. If this is the
            --  case, avoid mentioning legal values in the error message.

            if Present (Pred) then
               Next_Lo := Expr_Value (Low_Bound  (Pred));
               Next_Hi := Expr_Value (High_Bound (Pred));

               --  The next static predicate set is to the right of the choice

               if Choice_Hi < Next_Lo and then Choice_Hi < Next_Hi then
                  Illegal_Range (Loc, Pred_Hi + 1, Choice_Hi);
               else
                  Illegal_Range (Loc, Pred_Hi + 1, Next_Lo - 1);
               end if;
            else
               Illegal_Range (Loc, Pred_Hi + 1, Choice_Hi);
            end if;

            Error := True;

         --  Choice_Lo   Pred_Lo   Pred_Hi     Choice_Hi
         --  +-----------+=========+-----------+
         --   ^ illegal ^           ^ illegal ^

         --  Emit an error on the low gap, disregard the upper gap

         elsif Choice_Lo < Pred_Lo and then Pred_Hi < Choice_Hi then
            Illegal_Range (Loc, Choice_Lo, Pred_Lo - 1);
            Error := True;

         --  Step 4: Detect all cases of partial or missing coverage

         --  Pred_Lo   Choice_Lo  Choice_Hi   Pred_Hi
         --  +=========+==========+===========+
         --   ^  gap  ^            ^   gap   ^

         else
            --  An "others" choice covers all gaps

            if Others_Present then
               Prev_Lo := Choice_Lo;
               Prev_Hi := Choice_Hi;

               --  Check whether predicate set is fully covered by choice

               if Pred_Hi = Choice_Hi then
                  Next (Pred);
               end if;

            --  Choice_Lo   Choice_Hi   Pred_Hi
            --  +===========+===========+
            --  Pred_Lo      ^   gap   ^

            --  The upper gap may be covered by a subsequent choice

            elsif Pred_Lo = Choice_Lo then
               Prev_Lo := Choice_Lo;
               Prev_Hi := Choice_Hi;

            --  Pred_Lo     Prev_Hi   Choice_Lo   Choice_Hi   Pred_Hi
            --  +===========+=========+===========+===========+
            --   ^ covered ^ ^  gap  ^

            else pragma Assert (Pred_Lo < Choice_Lo);

               --  A previous choice covered the gap up to the current choice

               if Prev_Hi = Choice_Lo - 1 then
                  Prev_Lo := Choice_Lo;
                  Prev_Hi := Choice_Hi;

                  if Choice_Hi = Pred_Hi then
                     Next (Pred);
                  end if;

               --  The previous choice did not intersect with the current
               --  static predicate set.

               elsif Prev_Hi < Pred_Lo then
                  Missing_Choice (Pred_Lo, Choice_Lo - 1);
                  Error := True;

               --  The previous choice covered part of the static predicate set

               else
                  Missing_Choice (Prev_Hi, Choice_Lo - 1);
                  Error := True;
               end if;
            end if;
         end if;
      end Check_Against_Predicate;

      ----------------
      -- Dup_Choice --
      ----------------

      procedure Dup_Choice (Lo, Hi : Uint; C : Node_Id) is
      begin
         --  In some situations, we call this with a null range, and obviously
         --  we don't want to complain in this case.

         if Lo > Hi then
            return;
         end if;

         --  Case of only one value that is missing

         if Lo = Hi then
            if Is_Integer_Type (Bounds_Type) then
               Error_Msg_Uint_1 := Lo;
               Error_Msg_N ("duplication of choice value: ^#!", C);
            else
               Error_Msg_Name_1 := Choice_Image (Lo, Bounds_Type);
               Error_Msg_N ("duplication of choice value: %#!", C);
            end if;

         --  More than one choice value, so print range of values

         else
            if Is_Integer_Type (Bounds_Type) then
               Error_Msg_Uint_1 := Lo;
               Error_Msg_Uint_2 := Hi;
               Error_Msg_N ("duplication of choice values: ^ .. ^#!", C);
            else
               Error_Msg_Name_1 := Choice_Image (Lo, Bounds_Type);
               Error_Msg_Name_2 := Choice_Image (Hi, Bounds_Type);
               Error_Msg_N ("duplication of choice values: % .. %#!", C);
            end if;
         end if;
      end Dup_Choice;

      ------------------------------
      -- Explain_Non_Static_Bound --
      ------------------------------

      procedure Explain_Non_Static_Bound is
         Expr : Node_Id;

      begin
         if Nkind (Case_Node) = N_Variant_Part then
            Expr := Name (Case_Node);
         else
            Expr := Expression (Case_Node);
         end if;

         if Bounds_Type /= Subtyp then

            --  If the case is a variant part, the expression is given by the
            --  discriminant itself, and the bounds are the culprits.

            if Nkind (Case_Node) = N_Variant_Part then
               Error_Msg_NE
                 ("bounds of & are not static, "
                  & "alternatives must cover base type!", Expr, Expr);

            --  If this is a case statement, the expression may be non-static
            --  or else the subtype may be at fault.

            elsif Is_Entity_Name (Expr) then
               Error_Msg_NE
                 ("bounds of & are not static, "
                  & "alternatives must cover base type!", Expr, Expr);

            else
               Error_Msg_N
                 ("subtype of expression is not static, "
                  & "alternatives must cover base type!", Expr);
            end if;

         --  Otherwise the expression is not static, even if the bounds of the
         --  type are, or else there are missing alternatives. If both, the
         --  additional information may be redundant but harmless.

         elsif not Is_Entity_Name (Expr) then
            Error_Msg_N
              ("subtype of expression is not static, "
               & "alternatives must cover base type!", Expr);
         end if;
      end Explain_Non_Static_Bound;

      ---------------
      -- Lt_Choice --
      ---------------

      function Lt_Choice (C1, C2 : Natural) return Boolean is
      begin
         return
           Expr_Value (Choice_Table (Nat (C1)).Lo)
             <
           Expr_Value (Choice_Table (Nat (C2)).Lo);
      end Lt_Choice;

      --------------------
      -- Missing_Choice --
      --------------------

      procedure Missing_Choice (Value1 : Node_Id; Value2 : Node_Id) is
      begin
         Missing_Choice (Expr_Value (Value1), Expr_Value (Value2));
      end Missing_Choice;

      procedure Missing_Choice (Value1 : Node_Id; Value2 : Uint) is
      begin
         Missing_Choice (Expr_Value (Value1), Value2);
      end Missing_Choice;

      procedure Missing_Choice (Value1 : Uint; Value2 : Node_Id) is
      begin
         Missing_Choice (Value1, Expr_Value (Value2));
      end Missing_Choice;

      procedure Missing_Choice (Value1 : Uint; Value2 : Uint) is
         Msg_Sloc : constant Source_Ptr := Sloc (Case_Node);

      begin
         --  AI05-0188 : within an instance the non-others choices do not have
         --  to belong to the actual subtype.

         if Ada_Version >= Ada_2012 and then In_Instance then
            return;

         --  In some situations, we call this with a null range, and obviously
         --  we don't want to complain in this case.

         elsif Value1 > Value2 then
            return;
         end if;

         --  Case of only one value that is missing

         if Value1 = Value2 then
            if Is_Integer_Type (Bounds_Type) then
               Error_Msg_Uint_1 := Value1;
               Error_Msg ("missing case value: ^!", Msg_Sloc);
            else
               Error_Msg_Name_1 := Choice_Image (Value1, Bounds_Type);
               Error_Msg ("missing case value: %!", Msg_Sloc);
            end if;

         --  More than one choice value, so print range of values

         else
            if Is_Integer_Type (Bounds_Type) then
               Error_Msg_Uint_1 := Value1;
               Error_Msg_Uint_2 := Value2;
               Error_Msg ("missing case values: ^ .. ^!", Msg_Sloc);
            else
               Error_Msg_Name_1 := Choice_Image (Value1, Bounds_Type);
               Error_Msg_Name_2 := Choice_Image (Value2, Bounds_Type);
               Error_Msg ("missing case values: % .. %!", Msg_Sloc);
            end if;
         end if;
      end Missing_Choice;

      ---------------------
      -- Missing_Choices --
      ---------------------

      procedure Missing_Choices (Pred : Node_Id; Prev_Hi : Uint) is
         Hi  : Uint;
         Lo  : Uint;
         Set : Node_Id;

      begin
         Set := Pred;
         while Present (Set) loop
            Lo := Expr_Value (Low_Bound (Set));
            Hi := Expr_Value (High_Bound (Set));

            --  A choice covered part of a static predicate set

            if Lo <= Prev_Hi and then Prev_Hi < Hi then
               Missing_Choice (Prev_Hi + 1, Hi);

            else
               Missing_Choice (Lo, Hi);
            end if;

            Next (Set);
         end loop;
      end Missing_Choices;

      -----------------
      -- Move_Choice --
      -----------------

      procedure Move_Choice (From : Natural; To : Natural) is
      begin
         Choice_Table (Nat (To)) := Choice_Table (Nat (From));
      end Move_Choice;

      --  Local variables

      Bounds_Hi     : constant Node_Id := Type_High_Bound (Bounds_Type);
      Bounds_Lo     : constant Node_Id := Type_Low_Bound  (Bounds_Type);
      Has_Predicate : constant Boolean :=
                        Is_Static_Subtype (Bounds_Type)
                          and then Present (Static_Predicate (Bounds_Type));
      Num_Choices   : constant Nat     := Choice_Table'Last;

      Choice      : Node_Id;
      Choice_Hi   : Uint;
      Choice_Lo   : Uint;
      Error       : Boolean;
      Pred        : Node_Id;
      Prev_Choice : Node_Id;
      Prev_Lo     : Uint;
      Prev_Hi     : Uint;

   --  Start of processing for Check_Choice_Set

   begin
      --  Choice_Table must start at 0 which is an unused location used by the
      --  sorting algorithm. However the first valid position for a discrete
      --  choice is 1.

      pragma Assert (Choice_Table'First = 0);

      --  The choices do not cover the base range. Emit an error if "others" is
      --  not available and return as there is no need for further processing.

      if Num_Choices = 0 then
         if not Others_Present then
            Missing_Choice (Bounds_Lo, Bounds_Hi);
         end if;

         return;
      end if;

      Sorting.Sort (Positive (Choice_Table'Last));

      --  The type covered by the list of choices is actually a static subtype
      --  subject to a static predicate. The predicate defines subsets of legal
      --  values and requires finer grained analysis.

      if Has_Predicate then
         Pred    := First (Static_Predicate (Bounds_Type));
         Prev_Lo := Uint_Minus_1;
         Prev_Hi := Uint_Minus_1;
         Error   := False;

         for Index in 1 .. Num_Choices loop
            Check_Against_Predicate
              (Pred    => Pred,
               Choice  => Choice_Table (Index),
               Prev_Lo => Prev_Lo,
               Prev_Hi => Prev_Hi,
               Error   => Error);

            --  The analysis detected an illegal intersection between a choice
            --  and a static predicate set.

            if Error then
               return;
            end if;
         end loop;

         --  The choices may legally cover some of the static predicate sets,
         --  but not all. Emit an error for each non-covered set.

         if not Others_Present then
            Missing_Choices (Pred, Prev_Hi);
         end if;

      --  Default analysis

      else
         Choice_Lo := Expr_Value (Choice_Table (1).Lo);
         Choice_Hi := Expr_Value (Choice_Table (1).Hi);
         Prev_Hi   := Choice_Hi;

         if not Others_Present and then Expr_Value (Bounds_Lo) < Choice_Lo then
            Missing_Choice (Bounds_Lo, Choice_Lo - 1);

            --  If values are missing outside of the subtype, add explanation.
            --  No additional message if only one value is missing.

            if Expr_Value (Bounds_Lo) < Choice_Lo - 1 then
               Explain_Non_Static_Bound;
            end if;
         end if;

         for Outer_Index in 2 .. Num_Choices loop
            Choice_Lo := Expr_Value (Choice_Table (Outer_Index).Lo);
            Choice_Hi := Expr_Value (Choice_Table (Outer_Index).Hi);

            if Choice_Lo <= Prev_Hi then
               Choice := Choice_Table (Outer_Index).Node;

               --  Find first previous choice that overlaps

               for Inner_Index in 1 .. Outer_Index - 1 loop
                  if Choice_Lo <=
                       Expr_Value (Choice_Table (Inner_Index).Hi)
                  then
                     Prev_Choice := Choice_Table (Inner_Index).Node;
                     exit;
                  end if;
               end loop;

               if Sloc (Prev_Choice) <= Sloc (Choice) then
                  Error_Msg_Sloc := Sloc (Prev_Choice);
                  Dup_Choice
                    (Choice_Lo, UI_Min (Choice_Hi, Prev_Hi), Choice);
               else
                  Error_Msg_Sloc := Sloc (Choice);
                  Dup_Choice
                    (Choice_Lo, UI_Min (Choice_Hi, Prev_Hi), Prev_Choice);
               end if;

            elsif not Others_Present and then Choice_Lo /= Prev_Hi + 1 then
               Missing_Choice (Prev_Hi + 1, Choice_Lo - 1);
            end if;

            if Choice_Hi > Prev_Hi then
               Prev_Hi := Choice_Hi;
            end if;
         end loop;

         if not Others_Present and then Expr_Value (Bounds_Hi) > Prev_Hi then
            Missing_Choice (Prev_Hi + 1, Bounds_Hi);

            if Expr_Value (Bounds_Hi) > Prev_Hi + 1 then
               Explain_Non_Static_Bound;
            end if;
         end if;
      end if;
   end Check_Choice_Set;

   ------------------
   -- Choice_Image --
   ------------------

   function Choice_Image (Value : Uint; Ctype : Entity_Id) return Name_Id is
      Rtp : constant Entity_Id := Root_Type (Ctype);
      Lit : Entity_Id;
      C   : Int;

   begin
      --  For character, or wide [wide] character. If 7-bit ASCII graphic
      --  range, then build and return appropriate character literal name

      if Is_Standard_Character_Type (Ctype) then
         C := UI_To_Int (Value);

         if C in 16#20# .. 16#7E# then
            Set_Character_Literal_Name (Char_Code (UI_To_Int (Value)));
            return Name_Find;
         end if;

      --  For user defined enumeration type, find enum/char literal

      else
         Lit := First_Literal (Rtp);

         for J in 1 .. UI_To_Int (Value) loop
            Next_Literal (Lit);
         end loop;

         --  If enumeration literal, just return its value

         if Nkind (Lit) = N_Defining_Identifier then
            return Chars (Lit);

         --  For character literal, get the name and use it if it is
         --  for a 7-bit ASCII graphic character in 16#20#..16#7E#.

         else
            Get_Decoded_Name_String (Chars (Lit));

            if Name_Len = 3
              and then Name_Buffer (2) in
                Character'Val (16#20#) .. Character'Val (16#7E#)
            then
               return Chars (Lit);
            end if;
         end if;
      end if;

      --  If we fall through, we have a character literal which is not in
      --  the 7-bit ASCII graphic set. For such cases, we construct the
      --  name "type'val(nnn)" where type is the choice type, and nnn is
      --  the pos value passed as an argument to Choice_Image.

      Get_Name_String (Chars (First_Subtype (Ctype)));

      Add_Str_To_Name_Buffer ("'val(");
      UI_Image (Value);
      Add_Str_To_Name_Buffer (UI_Image_Buffer (1 .. UI_Image_Length));
      Add_Char_To_Name_Buffer (')');
      return Name_Find;
   end Choice_Image;

   --------------------------
   -- Expand_Others_Choice --
   --------------------------

   procedure Expand_Others_Choice
     (Case_Table    : Choice_Table_Type;
      Others_Choice : Node_Id;
      Choice_Type   : Entity_Id)
   is
      Loc         : constant Source_Ptr := Sloc (Others_Choice);
      Choice_List : constant List_Id    := New_List;
      Choice      : Node_Id;
      Exp_Lo      : Node_Id;
      Exp_Hi      : Node_Id;
      Hi          : Uint;
      Lo          : Uint;
      Previous_Hi : Uint;

      function Build_Choice (Value1, Value2 : Uint) return Node_Id;
      --  Builds a node representing the missing choices given by Value1 and
      --  Value2. A N_Range node is built if there is more than one literal
      --  value missing. Otherwise a single N_Integer_Literal, N_Identifier
      --  or N_Character_Literal is built depending on what Choice_Type is.

      function Lit_Of (Value : Uint) return Node_Id;
      --  Returns the Node_Id for the enumeration literal corresponding to the
      --  position given by Value within the enumeration type Choice_Type.

      ------------------
      -- Build_Choice --
      ------------------

      function Build_Choice (Value1, Value2 : Uint) return Node_Id is
         Lit_Node : Node_Id;
         Lo, Hi   : Node_Id;

      begin
         --  If there is only one choice value missing between Value1 and
         --  Value2, build an integer or enumeration literal to represent it.

         if (Value2 - Value1) = 0 then
            if Is_Integer_Type (Choice_Type) then
               Lit_Node := Make_Integer_Literal (Loc, Value1);
               Set_Etype (Lit_Node, Choice_Type);
            else
               Lit_Node := Lit_Of (Value1);
            end if;

         --  Otherwise is more that one choice value that is missing between
         --  Value1 and Value2, therefore build a N_Range node of either
         --  integer or enumeration literals.

         else
            if Is_Integer_Type (Choice_Type) then
               Lo := Make_Integer_Literal (Loc, Value1);
               Set_Etype (Lo, Choice_Type);
               Hi := Make_Integer_Literal (Loc, Value2);
               Set_Etype (Hi, Choice_Type);
               Lit_Node :=
                 Make_Range (Loc,
                   Low_Bound  => Lo,
                   High_Bound => Hi);

            else
               Lit_Node :=
                 Make_Range (Loc,
                   Low_Bound  => Lit_Of (Value1),
                   High_Bound => Lit_Of (Value2));
            end if;
         end if;

         return Lit_Node;
      end Build_Choice;

      ------------
      -- Lit_Of --
      ------------

      function Lit_Of (Value : Uint) return Node_Id is
         Lit : Entity_Id;

      begin
         --  In the case where the literal is of type Character, there needs
         --  to be some special handling since there is no explicit chain
         --  of literals to search. Instead, a N_Character_Literal node
         --  is created with the appropriate Char_Code and Chars fields.

         if Is_Standard_Character_Type (Choice_Type) then
            Set_Character_Literal_Name (Char_Code (UI_To_Int (Value)));
            Lit := New_Node (N_Character_Literal, Loc);
            Set_Chars (Lit, Name_Find);
            Set_Char_Literal_Value (Lit, Value);
            Set_Etype (Lit, Choice_Type);
            Set_Is_Static_Expression (Lit, True);
            return Lit;

         --  Otherwise, iterate through the literals list of Choice_Type
         --  "Value" number of times until the desired literal is reached
         --  and then return an occurrence of it.

         else
            Lit := First_Literal (Choice_Type);
            for J in 1 .. UI_To_Int (Value) loop
               Next_Literal (Lit);
            end loop;

            return New_Occurrence_Of (Lit, Loc);
         end if;
      end Lit_Of;

   --  Start of processing for Expand_Others_Choice

   begin
      if Case_Table'Last = 0 then

         --  Special case: only an others case is present. The others case
         --  covers the full range of the type.

         if Is_Static_Subtype (Choice_Type) then
            Choice := New_Occurrence_Of (Choice_Type, Loc);
         else
            Choice := New_Occurrence_Of (Base_Type (Choice_Type), Loc);
         end if;

         Set_Others_Discrete_Choices (Others_Choice, New_List (Choice));
         return;
      end if;

      --  Establish the bound values for the choice depending upon whether the
      --  type of the case statement is static or not.

      if Is_OK_Static_Subtype (Choice_Type) then
         Exp_Lo := Type_Low_Bound (Choice_Type);
         Exp_Hi := Type_High_Bound (Choice_Type);
      else
         Exp_Lo := Type_Low_Bound (Base_Type (Choice_Type));
         Exp_Hi := Type_High_Bound (Base_Type (Choice_Type));
      end if;

      Lo := Expr_Value (Case_Table (1).Lo);
      Hi := Expr_Value (Case_Table (1).Hi);
      Previous_Hi := Expr_Value (Case_Table (1).Hi);

      --  Build the node for any missing choices that are smaller than any
      --  explicit choices given in the case.

      if Expr_Value (Exp_Lo) < Lo then
         Append (Build_Choice (Expr_Value (Exp_Lo), Lo - 1), Choice_List);
      end if;

      --  Build the nodes representing any missing choices that lie between
      --  the explicit ones given in the case.

      for J in 2 .. Case_Table'Last loop
         Lo := Expr_Value (Case_Table (J).Lo);
         Hi := Expr_Value (Case_Table (J).Hi);

         if Lo /= (Previous_Hi + 1) then
            Append_To (Choice_List, Build_Choice (Previous_Hi + 1, Lo - 1));
         end if;

         Previous_Hi := Hi;
      end loop;

      --  Build the node for any missing choices that are greater than any
      --  explicit choices given in the case.

      if Expr_Value (Exp_Hi) > Hi then
         Append (Build_Choice (Hi + 1, Expr_Value (Exp_Hi)), Choice_List);
      end if;

      Set_Others_Discrete_Choices (Others_Choice, Choice_List);

      --  Warn on null others list if warning option set

      if Warn_On_Redundant_Constructs
        and then Comes_From_Source (Others_Choice)
        and then Is_Empty_List (Choice_List)
      then
         Error_Msg_N ("?r?OTHERS choice is redundant", Others_Choice);
         Error_Msg_N ("\?r?previous choices cover all values", Others_Choice);
      end if;
   end Expand_Others_Choice;

   -----------
   -- No_OP --
   -----------

   procedure No_OP (C : Node_Id) is
      pragma Warnings (Off, C);
   begin
      null;
   end No_OP;

   -----------------------------
   -- Generic_Analyze_Choices --
   -----------------------------

   package body Generic_Analyze_Choices is

      --  The following type is used to gather the entries for the choice
      --  table, so that we can then allocate the right length.

      type Link;
      type Link_Ptr is access all Link;

      type Link is record
         Val : Choice_Bounds;
         Nxt : Link_Ptr;
      end record;

      ---------------------
      -- Analyze_Choices --
      ---------------------

      procedure Analyze_Choices
        (Alternatives : List_Id;
         Subtyp       : Entity_Id)
      is
         Choice_Type : constant Entity_Id := Base_Type (Subtyp);
         --  The actual type against which the discrete choices are resolved.
         --  Note that this type is always the base type not the subtype of the
         --  ruling expression, index or discriminant.

         Expected_Type : Entity_Id;
         --  The expected type of each choice. Equal to Choice_Type, except if
         --  the expression is universal, in which case the choices can be of
         --  any integer type.

         Alt : Node_Id;
         --  A case statement alternative or a variant in a record type
         --  declaration.

         Choice : Node_Id;
         Kind   : Node_Kind;
         --  The node kind of the current Choice

      begin
         --  Set Expected type (= choice type except for universal integer,
         --  where we accept any integer type as a choice).

         if Choice_Type = Universal_Integer then
            Expected_Type := Any_Integer;
         else
            Expected_Type := Choice_Type;
         end if;

         --  Now loop through the case alternatives or record variants

         Alt := First (Alternatives);
         while Present (Alt) loop

            --  If pragma, just analyze it

            if Nkind (Alt) = N_Pragma then
               Analyze (Alt);

            --  Otherwise we have an alternative. In most cases the semantic
            --  processing leaves the list of choices unchanged

            --  Check each choice against its base type

            else
               Choice := First (Discrete_Choices (Alt));
               while Present (Choice) loop
                  Analyze (Choice);
                  Kind := Nkind (Choice);

                  --  Choice is a Range

                  if Kind = N_Range
                    or else (Kind = N_Attribute_Reference
                              and then Attribute_Name (Choice) = Name_Range)
                  then
                     Resolve (Choice, Expected_Type);

                  --  Choice is a subtype name, nothing further to do now

                  elsif Is_Entity_Name (Choice)
                    and then Is_Type (Entity (Choice))
                  then
                     null;

                  --  Choice is a subtype indication

                  elsif Kind = N_Subtype_Indication then
                     Resolve_Discrete_Subtype_Indication
                       (Choice, Expected_Type);

                  --  Others choice, no analysis needed

                  elsif Kind = N_Others_Choice then
                     null;

                  --  Only other possibility is an expression

                  else
                     Resolve (Choice, Expected_Type);
                  end if;

                  --  Move to next choice

                  Next (Choice);
               end loop;

               Process_Associated_Node (Alt);
            end if;

            Next (Alt);
         end loop;
      end Analyze_Choices;

   end Generic_Analyze_Choices;

   ---------------------------
   -- Generic_Check_Choices --
   ---------------------------

   package body Generic_Check_Choices is

      --  The following type is used to gather the entries for the choice
      --  table, so that we can then allocate the right length.

      type Link;
      type Link_Ptr is access all Link;

      type Link is record
         Val : Choice_Bounds;
         Nxt : Link_Ptr;
      end record;

      procedure Free is new Ada.Unchecked_Deallocation (Link, Link_Ptr);

      -------------------
      -- Check_Choices --
      -------------------

      procedure Check_Choices
        (N                        : Node_Id;
         Alternatives             : List_Id;
         Subtyp                   : Entity_Id;
         Others_Present           : out Boolean)
      is
         E : Entity_Id;

         Raises_CE : Boolean;
         --  Set True if one of the bounds of a choice raises CE

         Enode : Node_Id;
         --  This is where we post error messages for bounds out of range

         Choice_List : Link_Ptr := null;
         --  Gather list of choices

         Num_Choices : Nat := 0;
         --  Number of entries in Choice_List

         Choice_Type : constant Entity_Id := Base_Type (Subtyp);
         --  The actual type against which the discrete choices are resolved.
         --  Note that this type is always the base type not the subtype of the
         --  ruling expression, index or discriminant.

         Bounds_Type : Entity_Id;
         --  The type from which are derived the bounds of the values covered
         --  by the discrete choices (see 3.8.1 (4)). If a discrete choice
         --  specifies a value outside of these bounds we have an error.

         Bounds_Lo : Uint;
         Bounds_Hi : Uint;
         --  The actual bounds of the above type

         Expected_Type : Entity_Id;
         --  The expected type of each choice. Equal to Choice_Type, except if
         --  the expression is universal, in which case the choices can be of
         --  any integer type.

         Alt : Node_Id;
         --  A case statement alternative or a variant in a record type
         --  declaration.

         Choice : Node_Id;
         Kind   : Node_Kind;
         --  The node kind of the current Choice

         Others_Choice : Node_Id := Empty;
         --  Remember others choice if it is present (empty otherwise)

         procedure Check (Choice : Node_Id; Lo, Hi : Node_Id);
         --  Checks the validity of the bounds of a choice. When the bounds
         --  are static and no error occurred the bounds are collected for
         --  later entry into the choices table so that they can be sorted
         --  later on.

         -----------
         -- Check --
         -----------

         procedure Check (Choice : Node_Id; Lo, Hi : Node_Id) is
            Lo_Val : Uint;
            Hi_Val : Uint;

         begin
            --  First check if an error was already detected on either bounds

            if Etype (Lo) = Any_Type or else Etype (Hi) = Any_Type then
               return;

            --  Do not insert non static choices in the table to be sorted

            elsif not Is_Static_Expression (Lo)
                    or else
                  not Is_Static_Expression (Hi)
            then
               Process_Non_Static_Choice (Choice);
               return;

            --  Ignore range which raise constraint error

            elsif Raises_Constraint_Error (Lo)
              or else Raises_Constraint_Error (Hi)
            then
               Raises_CE := True;
               return;

            --  AI05-0188 : Within an instance the non-others choices do not
            --  have to belong to the actual subtype.

            elsif Ada_Version >= Ada_2012 and then In_Instance then
               return;

            --  Otherwise we have an OK static choice

            else
               Lo_Val := Expr_Value (Lo);
               Hi_Val := Expr_Value (Hi);

               --  Do not insert null ranges in the choices table

               if Lo_Val > Hi_Val then
                  Process_Empty_Choice (Choice);
                  return;
               end if;
            end if;

            --  Check for low bound out of range

            if Lo_Val < Bounds_Lo then

               --  If the choice is an entity name, then it is a type, and we
               --  want to post the message on the reference to this entity.
               --  Otherwise post it on the lower bound of the range.

               if Is_Entity_Name (Choice) then
                  Enode := Choice;
               else
                  Enode := Lo;
               end if;

               --  Specialize message for integer/enum type

               if Is_Integer_Type (Bounds_Type) then
                  Error_Msg_Uint_1 := Bounds_Lo;
                  Error_Msg_N ("minimum allowed choice value is^", Enode);
               else
                  Error_Msg_Name_1 := Choice_Image (Bounds_Lo, Bounds_Type);
                  Error_Msg_N ("minimum allowed choice value is%", Enode);
               end if;
            end if;

            --  Check for high bound out of range

            if Hi_Val > Bounds_Hi then

               --  If the choice is an entity name, then it is a type, and we
               --  want to post the message on the reference to this entity.
               --  Otherwise post it on the upper bound of the range.

               if Is_Entity_Name (Choice) then
                  Enode := Choice;
               else
                  Enode := Hi;
               end if;

               --  Specialize message for integer/enum type

               if Is_Integer_Type (Bounds_Type) then
                  Error_Msg_Uint_1 := Bounds_Hi;
                  Error_Msg_N ("maximum allowed choice value is^", Enode);
               else
                  Error_Msg_Name_1 := Choice_Image (Bounds_Hi, Bounds_Type);
                  Error_Msg_N ("maximum allowed choice value is%", Enode);
               end if;
            end if;

            --  Collect bounds in the list

            --  Note: we still store the bounds, even if they are out of range,
            --  since this may prevent unnecessary cascaded errors for values
            --  that are covered by such an excessive range.

            Choice_List :=
              new Link'(Val => (Lo, Hi, Choice), Nxt => Choice_List);
            Num_Choices := Num_Choices + 1;
         end Check;

      --  Start of processing for Check_Choices

      begin
         Raises_CE      := False;
         Others_Present := False;

         --  If Subtyp is not a discrete type or there was some other error,
         --  then don't try any semantic checking on the choices since we have
         --  a complete mess.

         if not Is_Discrete_Type (Subtyp) or else Subtyp = Any_Type then
            return;
         end if;

         --  If Subtyp is not a static subtype Ada 95 requires then we use the
         --  bounds of its base type to determine the values covered by the
         --  discrete choices.

         --  In Ada 2012, if the subtype has a non-static predicate the full
         --  range of the base type must be covered as well.

         if Is_OK_Static_Subtype (Subtyp) then
            if not Has_Predicates (Subtyp)
              or else Present (Static_Predicate (Subtyp))
            then
               Bounds_Type := Subtyp;
            else
               Bounds_Type := Choice_Type;
            end if;

         else
            Bounds_Type := Choice_Type;
         end if;

         --  Obtain static bounds of type, unless this is a generic formal
         --  discrete type for which all choices will be non-static.

         if not Is_Generic_Type (Root_Type (Bounds_Type))
           or else Ekind (Bounds_Type) /= E_Enumeration_Type
         then
            Bounds_Lo := Expr_Value (Type_Low_Bound (Bounds_Type));
            Bounds_Hi := Expr_Value (Type_High_Bound (Bounds_Type));
         end if;

         if Choice_Type = Universal_Integer then
            Expected_Type := Any_Integer;
         else
            Expected_Type := Choice_Type;
         end if;

         --  Now loop through the case alternatives or record variants

         Alt := First (Alternatives);
         while Present (Alt) loop

            --  If pragma, just analyze it

            if Nkind (Alt) = N_Pragma then
               Analyze (Alt);

            --  Otherwise we have an alternative. In most cases the semantic
            --  processing leaves the list of choices unchanged

            --  Check each choice against its base type

            else
               Choice := First (Discrete_Choices (Alt));
               while Present (Choice) loop
                  Kind := Nkind (Choice);

                  --  Choice is a Range

                  if Kind = N_Range
                    or else (Kind = N_Attribute_Reference
                              and then Attribute_Name (Choice) = Name_Range)
                  then
                     Check (Choice, Low_Bound (Choice), High_Bound (Choice));

                  --  Choice is a subtype name

                  elsif Is_Entity_Name (Choice)
                    and then Is_Type (Entity (Choice))
                  then
                     --  Check for inappropriate type

                     if not Covers (Expected_Type, Etype (Choice)) then
                        Wrong_Type (Choice, Choice_Type);

                     --  Type is OK, so check further

                     else
                        E := Entity (Choice);

                        --  Case of predicated subtype

                        if Has_Predicates (E) then

                           --  Use of non-static predicate is an error

                           if not Is_Discrete_Type (E)
                             or else No (Static_Predicate (E))
                           then
                              Bad_Predicated_Subtype_Use
                                ("cannot use subtype& with non-static "
                                 & "predicate as case alternative",
                                 Choice, E, Suggest_Static => True);

                           --  Static predicate case

                           else
                              declare
                                 P : Node_Id;
                                 C : Node_Id;

                              begin
                                 --  Loop through entries in predicate list,
                                 --  checking each entry. Note that if the
                                 --  list is empty, corresponding to a False
                                 --  predicate, then no choices are checked.

                                 P := First (Static_Predicate (E));
                                 while Present (P) loop
                                    C := New_Copy (P);
                                    Set_Sloc (C, Sloc (Choice));
                                    Check (C, Low_Bound (C), High_Bound (C));
                                    Next (P);
                                 end loop;
                              end;

                              Set_Has_SP_Choice (Alt);
                           end if;

                        --  Not predicated subtype case

                        elsif not Is_Static_Subtype (E) then
                           Process_Non_Static_Choice (Choice);
                        else
                           Check
                             (Choice, Type_Low_Bound (E), Type_High_Bound (E));
                        end if;
                     end if;

                  --  Choice is a subtype indication

                  elsif Kind = N_Subtype_Indication then
                     Resolve_Discrete_Subtype_Indication
                       (Choice, Expected_Type);

                     if Etype (Choice) /= Any_Type then
                        declare
                           C : constant Node_Id := Constraint (Choice);
                           R : constant Node_Id := Range_Expression (C);
                           L : constant Node_Id := Low_Bound (R);
                           H : constant Node_Id := High_Bound (R);

                        begin
                           E := Entity (Subtype_Mark (Choice));

                           if not Is_Static_Subtype (E) then
                              Process_Non_Static_Choice (Choice);

                           else
                              if Is_OK_Static_Expression (L)
                                   and then
                                 Is_OK_Static_Expression (H)
                              then
                                 if Expr_Value (L) > Expr_Value (H) then
                                    Process_Empty_Choice (Choice);
                                 else
                                    if Is_Out_Of_Range (L, E) then
                                       Apply_Compile_Time_Constraint_Error
                                         (L, "static value out of range",
                                          CE_Range_Check_Failed);
                                    end if;

                                    if Is_Out_Of_Range (H, E) then
                                       Apply_Compile_Time_Constraint_Error
                                         (H, "static value out of range",
                                          CE_Range_Check_Failed);
                                    end if;
                                 end if;
                              end if;

                              Check (Choice, L, H);
                           end if;
                        end;
                     end if;

                  --  The others choice is only allowed for the last
                  --  alternative and as its only choice.

                  elsif Kind = N_Others_Choice then
                     if not (Choice = First (Discrete_Choices (Alt))
                              and then Choice = Last (Discrete_Choices (Alt))
                              and then Alt = Last (Alternatives))
                     then
                        Error_Msg_N
                          ("the choice OTHERS must appear alone and last",
                           Choice);
                        return;
                     end if;

                     Others_Present := True;
                     Others_Choice  := Choice;

                  --  Only other possibility is an expression

                  else
                     Check (Choice, Choice, Choice);
                  end if;

                  --  Move to next choice

                  Next (Choice);
               end loop;

               Process_Associated_Node (Alt);
            end if;

            Next (Alt);
         end loop;

         --  Now we can create the Choice_Table, since we know how long
         --  it needs to be so we can allocate exactly the right length.

         declare
            Choice_Table : Choice_Table_Type (0 .. Num_Choices);

         begin
            --  Now copy the items we collected in the linked list into this
            --  newly allocated table (leave entry 0 unused for sorting).

            declare
               T : Link_Ptr;
            begin
               for J in 1 .. Num_Choices loop
                  T := Choice_List;
                  Choice_List := T.Nxt;
                  Choice_Table (J) := T.Val;
                  Free (T);
               end loop;
            end;

            Check_Choice_Set
              (Choice_Table,
               Bounds_Type,
               Subtyp,
               Others_Present or else (Choice_Type = Universal_Integer),
               N);

            --  If no others choice we are all done, otherwise we have one more
            --  step, which is to set the Others_Discrete_Choices field of the
            --  others choice (to contain all otherwise unspecified choices).
            --  Skip this if CE is known to be raised.

            if Others_Present and not Raises_CE then
               Expand_Others_Choice
                 (Case_Table    => Choice_Table,
                  Others_Choice => Others_Choice,
                  Choice_Type   => Bounds_Type);
            end if;
         end;
      end Check_Choices;

   end Generic_Check_Choices;

end Sem_Case;